| Code |
K ^TMP($J,"ORWDX LOADRSP","QO SAVE")
K ^TMP("ORWDXMQ",$J)
N ORWMODE ; 0:Dlg,Quick 1:copy 2:change
N TEMPCAT ; pt cat from DPT
N ISXFER ; Trnsfr order?
N ORIMO ;If IMO(inpt med on opt)
N TEMPORIT
N ADMLOC,PATLOC,ORDLOC,LEVEL,DELAY,SCHLOC,SCHTYP
S PATLOC=$P(FLDS,U,2)
S ORDLOC=$S(ORIT["C":+$P($G(^OR(100,+$P(ORIT,"C",2),0)),U,10),1:0)
S ORIMO=$G(ISIMO)
S ORWMODE=0,ISXFER=""
S:$E(ORIT)="C" ORWMODE=1 S:$E(ORIT)="T" ORWMODE=1,ISXFER=";T" ;treat xfer as copy
S:$E(ORIT)="X" ORWMODE=2
S TEMPORIT=ORIT
I ORWMODE S ORIT=$E(ORIT,2,999)
S LST(0)=""
D CHKDSBL^ORWDXM3(.LST,ORIT,ORWMODE) Q:+LST(0)=8
D CHKVACT^ORWDXM3(.LST,ORIT,ORWMODE,$P(FLDS,U,3)) Q:+LST(0)=8
I ORWMODE=1 D CHKCOPY^ORWDXM3(.LST,ORIT,FLDS) Q:+LST(0)=8
I ORWMODE=2 D BLD4CHG^ORWDXM3(.LST,ORIT,FLDS) Q
I 'ORWMODE,($P(^ORD(101.41,+ORIT,0),U,4)="D"),'($O(^DIC(9.4,"C","OR",0))[$P(^ORD(101.41,+ORIT,0),U,7)) S LST(0)="0^0^"_$$DLGINFO^ORWDXM3(ORIT,ORWMODE_ISXFER) Q
N ORIMTYPE,ORCOMP,ORTAS,LRFZX,LRFSAMP,LRFSPEC,LRFDATE,LRFURG,LRFSCH
N ORTIME,ORCOLLCT,ORMAX,ORTEST,ORIMTIME,ORSMAX,ORSTMS,ORSCH
N PSJNOPC,ORMORE,ORINPT,ORXNP,ORSCHED,ORQTY,ORNOUNS,ORXNP,OREFILLS
N ORCOMPLX,ORQTY,ORCOPAY,ORDRUG,ORWPSPIK,ORWPSWRG,ORSD,ORDSUP,ORWP94
N ORPARAM,ORNPO,ORTIME,ORMEAL,ORTRAY,ORDATE,GMRCNOPD,GMRCNOAT,GMRCREAF
N ORTYPE,ORVP,ORL,ORNP,ORSEX,ORAGE,ORWARD,OREVENT,ORDIV,ORSC,KEYVAR
N ORDG,ORDIALOG,ORCAT,FIRST,ORQUIT,X,ORTRAIL,ORLEAD,RSPREF,AUTOACK
N OREVNTYP
S ORWP94=$O(^ORD(101.41,"AB","PS MEDS",0))>0
S ORVP=$P(FLDS,U,1)_";DPT(",ORNP=+$P(FLDS,U,3),ORSC=$P(FLDS,U,8)
S ORL=$P(FLDS,U,2)_";SC(",ORL(2)=ORL
S ORSEX=$P(FLDS,U,5),ORAGE=$P(FLDS,U,6),ORTYPE="Q",FIRST=1
I $P(FLDS,U,4),$G(^SC(+ORL,42)) S ORWARD=+^SC(+ORL,42)
I $L($P(FLDS,U,7)) D
. S OREVENT=$P(FLDS,U,7)
. S OREVNTYP=$P(OREVENT,";",2)
. S OREVENT("TS")=$P(OREVENT,";",3)
. S OREVENT("EFFECTIVE")=$P(OREVENT,";",4)
. S OREVENT=+$P(OREVENT,";",1)
I 'ORWMODE D
. D SETKEYV^ORWDXM3($P(FLDS,U,11,20)) ; from menu path
. S KEYVAR=$$KEYVAR^ORWDXM3(ORIT) ; from entry action
. D SETKEYV^ORWDXM3(KEYVAR)
K ^TMP("ORWORD",$J)
I ORWMODE S LST(0)="2^"_ORIT ;verify on copy
E S LST(0)=+$P($G(^ORD(101.41,ORIT,5)),U,8)_U_ORIT
S TEMPCAT=$S($L($P($G(^DPT(+ORVP,.1)),U)):"I",1:"O")
I TEMPCAT="I",+$P(FLDS,U,4)=1,$E(TEMPORIT)="C",$P($G(^ORD(100.98,$P($G(^OR(100,+ORIT,0)),U,11),0)),U)="OUTPATIENT MEDICATIONS" S TEMPCAT="O"
I $L($G(OREVNTYP)) D
. S ORCAT=$S(OREVNTYP="A":"I",OREVNTYP="T":"I",OREVNTYP="O":TEMPCAT,OREVNTYP="M":TEMPCAT,OREVNTYP="C":TEMPCAT,1:"O") I $G(OREVENT) D
.. N X S X=$$EVT^OREVNTX(OREVENT),X=$P($G(^ORD(100.5,+X,0)),U,7)
.. I OREVNTYP="T",X,X<4 S ORCAT="O" ;To pass=outpt
.. I OREVNTYP="D",X=41 S ORCAT="I" ;From ASIH=inpt
E S ORCAT=TEMPCAT
D SETUP^ORWDXM4 Q:+LST(0)=8
S X="OR GTX START DATE"_$S($G(ORWP94):"/TIME",1:"")
I ORWMODE,(ORDG=+$O(^ORD(100.98,"B","O RX",0))) D ;remove old values
. K ORDIALOG($$PTR^ORCD(X),1)
. I ORWMODE=2,$$DRAFT^ORWDX2(ORIT) Q ;keep comments
. K:ISXFER'["T" ORDIALOG($$PTR^ORCD("OR GTX WORD PROCESSING 1"),1)
D SETUPS^ORWDXM4 ;moved to save space, expects X
Q:+LST(0)=8
I $G(ORQUIT) S LST(0)="0^0^"_$$DLGINFO^ORWDXM3(ORIT,ORWMODE_ISXFER)_"^"_$G(KEYVAR) Q
N SEQ,DA,XCODE,MUSTASK,PROMPT,INST,KEY,IVFID,CLIVFID
S IVFID=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE",0))
S CLIVFID=$O(^ORD(101.41,"B","CLINIC OR PAT FLUID OE",0))
S AUTOACK=$S($D(ORWPSWRG):0,1:1)
I ORWMODE=1 D ;
. I $L($$VAL^ORCD("START DATE")) D ;
. . S X=$$VAL^ORCD("START DATE"),%DT="TX" D ^%DT
. . I Y'<$$DT^XLFDT,(($L($$VAL^ORCD("STOP DATE"))=0)!('$$FTDCOMP^ORCD("START DATE","STOP DATE",">"))) Q ;quit if valid dates: start not in the past or stop after start
. . K ORDIALOG($$PTR("START DATE"),1),ORDIALOG($$PTR("START DATE/TIME"),1) ;erase bad start and stop dates.
. . K ORDIALOG($$PTR("STOP DATE"),1),ORDIALOG($$PTR("STOP DATE/TIME"),1)
. ; check start and stop dates found in diet orders
. I $L($$VAL^ORCD("EFFECTIVE DATE/TIME")) D ;
. . S X=$$VAL^ORCD("EFFECTIVE DATE/TIME"),%DT="TX" D ^%DT
. . I Y'<$$DT^XLFDT,(($L($$VAL^ORCD("EXPIRATION DATE/TIME"))=0)!('$$FTDCOMP^ORCD("EFFECTIVE DATE/TIME","EXPIRATION DATE/TIME",">"))) Q ;quit if valid dates: start not in the past or stop after start
. . K ORDIALOG($P(ORDIALOG("B","EFFECTIVE DATE/TIME"),U,2),1) ;erase bad start and stop dates.
. . K ORDIALOG($P(ORDIALOG("B","EXPIRATION DATE/TIME"),U,2),1)
. ; check date desired field found in imaging orders
. I $L($$VAL^ORCD("DATE DESIRED")) D ;
. . S X=$$VAL^ORCD("DATE DESIRED"),%DT="TX" D ^%DT
. . I Y'<$$DT^XLFDT Q ;quit if not a past date
. . K ORDIALOG($P(ORDIALOG("B","DATE DESIRED"),U,2),1) ;erase bad date
. ; check collection date field found in lab orders
. I $L($$VAL^ORCD("COLLECTION DATE/TIME")) D ;
. . S X=$$VAL^ORCD("COLLECTION DATE/TIME")
. . I X="NEXT" Q ;No need to check this.
. . S %DT="TX" D ^%DT
. . I $P(Y,".",2),Y'<$E($$NOW^XLFDT,1,12) Q ;quit if not a past date and time (lab is more precise than other dates)
. . I $P(Y,".",2)="",Y'<$$DT^XLFDT Q ;
. . K ORDIALOG($P(ORDIALOG("B","COLLECTION DATE/TIME"),U,2),1) ;erase bad date
S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:'SEQ D
. S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D
. . ; skip if child prmpt
. . I $P(^ORD(101.41,+ORDIALOG,10,DA,0),U,11) Q
. . ; set dflt for prmpt, chk if interactive
. . S PROMPT=$P(^ORD(101.41,+ORDIALOG,10,DA,0),U,2)
. . D SETITEM(DA,PROMPT,1,.MUSTASK)
. . I MUSTASK S AUTOACK=0 Q
. . ; iterate through child items if parent & edit only
. . Q:'$D(^ORD(101.41,+ORDIALOG,10,"DAD",PROMPT))
. . N CSEQ,CDA,CPROMPT,INST,ORQUIT
. . S CSEQ=0 F S CSEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PROMPT,CSEQ)) Q:'CSEQ D Q:$G(ORQUIT)
. . . S CDA=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PROMPT,CSEQ,0))
. . . S CPROMPT=$P(^ORD(101.41,+ORDIALOG,10,CDA,0),U,2)
. . . ; if req & no instances then need interaction
. . . I $P(^ORD(101.41,+ORDIALOG,10,CDA,0),U,6) D
. . . . I ORDIALOG=IVFID!(ORDIALOG=CLIVFID) Q
. . . . I '$O(ORDIALOG(CPROMPT,0)) S AUTOACK=0
. . . S INST=0 F S INST=$O(ORDIALOG(CPROMPT,INST)) Q:'INST D
. . . . N ORASK D VBASK^ORWDXM4(INST) ; set ORASK for VBECS
. . . . ; set dflt for each child prmpt
. . . . D SETITEM(CDA,CPROMPT,INST,.MUSTASK)
. . . . ; if no val & child prmpt req'd then need interaction
. . . . I MUSTASK,$P(^ORD(101.41,+ORDIALOG,10,CDA,0),U,6) S AUTOACK=0
N IVDLG,CLINFDLG,SPLYDLG
S IVDLG=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
S CLINFDLG=$O(^ORD(101.41,"AB","CLINIC OR PAT FLUID OE",0))
S SPLYDLG=$O(^ORD(101.41,"AB","PSO SUPPLY",0))
I $$ISMED(ORIT),(ORDIALOG'=IVDLG),(ORDIALOG'=CLINFDLG),(ORDIALOG'=SPLYDLG),(ORCAT="I") D
. F P="PATIENT INSTRUCTIONS","DAYS SUPPLY","QUANTITY","REFILLS","ROUTING","SERVICE CONNECTED" K ORDIALOG($$PTR(P),1)
. I '$$ISQO(ORIT) K ORDIALOG($$PTR("START DATE/TIME"),1) ; kill if not a non-VA med quick order. p388
S KEY=$S(ORWMODE:"C",1:"")_ORIT_"-"_$P($H,",",2),SEQ=0
I $$ISINPMED(ORIT) D
.S LEVEL=$P(LST(0),U),DELAY=$S($P($G(OREVENT),";")>0:1,1:0)
.I LEVEL=2!(ISIMO) D ADMTIME^ORWDXM2(ORDLOC,PATLOC,ENCLOC,DELAY,ISIMO)
I ($$ISMED(ORIT)),'($$VALQO^ORWDXM3(ORIT)) S AUTOACK=0
S PROMPT=0 F S PROMPT=$O(ORDIALOG(PROMPT)) Q:'PROMPT D
. I '$D(^ORD(101.41,ORDIALOG,10,"D",PROMPT)) K ORDIALOG(PROMPT) Q
. S INST=0 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST D
. . S SEQ=SEQ+1,^TMP("ORWDXMQ",$J,KEY,SEQ,0)=U_PROMPT_U_INST
. . ; save word proc val
. . I $E(ORDIALOG(PROMPT,0))="W",$L(ORDIALOG(PROMPT,INST)) D
. . . M ^TMP("ORWDXMQ",$J,KEY,SEQ,2)=@ORDIALOG(PROMPT,INST)
. . ; save other val types
. . E S ^TMP("ORWDXMQ",$J,KEY,SEQ,1)=ORDIALOG(PROMPT,INST)
I AUTOACK D
. I ORWMODE S AUTOACK=2
. I 'ORWMODE,($P(^ORD(101.41,ORIT,0),U,8)!'LST(0)) S AUTOACK=2
I ORIMO,ORWMODE S AUTOACK=2
I $L($G(^ORD(101.41,+ORIT,0))),($P(^ORD(100.98,$P(^ORD(101.41,+ORIT,0),U,5),0),U,3)="NV RX"),($P($G(^ORD(101.41,+ORIT,5)),U,8)) S AUTOACK=1
I AUTOACK=2,$$ISMED(ORIT),$$VERORD^ORWDXM3(ORIT)=0 S AUTOACK=0
I AUTOACK=2 D VERTXT^ORWDXM2
S LST(0)=AUTOACK_U_KEY_U_$$DLGINFO^ORWDXM3(ORIT,ORWMODE_ISXFER)_"^"_$G(KEYVAR)
I $P(LST(0),U,4)="D" S $P(LST(0),U,4)="Q"
I ORWMODE=1 S $P(LST(0),U,4)="C"
K ^TMP("ORWORD",$J)
K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J)
|