- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXM1.m
r613 r623 1 ORWDXM1 ; SLC/KCM - Order Dialogs, Menus;2/19/03 ;5/27/2008 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,131,132,141,178,185,187,215,243**;Dec 17, 1997;Build 242 3 BLDQRSP(LST,ORIT,FLDS,ISIMO,ENCLOC) ; Build responses for an order 4 ; LST=QuickLevel^ResponseID(ORIT;$H)^Dialog^Type^FormID^DGrp 5 ; LST(n)=verify text or reject text 6 ; ORIT= ptr to 101.41 for quick order, 100 for copy 7 ; 1 2 3 4 5 6 7 8 11-20 8 ; FLDS=DFN^LOC^ORNP^INPT^SEX^AGE^EVENT^SC%^^^Key Variables... 9 ; ORIT=+ORIT: ptr to 101.41, $E(ORIT)=C: copy $E(ORIT)=X: change 10 ; !! SHOULD CHECK for PRE-CPRS ORDERS (treat as text?) 11 K ^TMP("ORWDXMQ",$J) 12 N ORWMODE ; 0:Dialog,Quick 1:copy order 2:change order 13 N TEMPCAT ; patient category from DPT file 14 N ISXFER ; Transfer order? 15 N ORIMO ;If IMO(inpatient medication on outpatient) 16 N TEMPORIT 17 N ADMLOC,PATLOC,ORDLOC,LEVEL,DELAY,SCHLOC,SCHTYP 18 S PATLOC=$P(FLDS,U,2) 19 S ORDLOC=$S(ORIT["C":+$P($G(^OR(100,+$P(ORIT,"C",2),0)),U,10),1:0) 20 S ORIMO=$G(ISIMO) 21 S ORWMODE=0,ISXFER="" 22 S:$E(ORIT)="C" ORWMODE=1 S:$E(ORIT)="T" ORWMODE=1,ISXFER=";T" ;treat xfer as copy for now 23 S:$E(ORIT)="X" ORWMODE=2 24 S TEMPORIT=ORIT 25 I ORWMODE S ORIT=$E(ORIT,2,999) 26 S LST(0)="" 27 D CHKDSBL^ORWDXM3(.LST,ORIT,ORWMODE) Q:+LST(0)=8 ;disable 28 D CHKVACT^ORWDXM3(.LST,ORIT,ORWMODE,$P(FLDS,U,3)) Q:+LST(0)=8 ;action 29 I ORWMODE=1 D CHKCOPY^ORWDXM3(.LST,ORIT,FLDS) Q:+LST(0)=8 ;no copy 30 I ORWMODE=2 D BLD4CHG^ORWDXM3(.LST,ORIT,FLDS) Q ;change 31 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 32 ;radilogy vars 33 N ORIMTYPE 34 ;blood bank vars 35 N ORCOMP,ORTAS 36 ;lab vars 37 N LRFZX,LRFSAMP,LRFSPEC,LRFDATE,LRFURG,LRFSCH 38 N ORTIME,ORCOLLCT,ORMAX,ORTEST,ORIMTIME,ORSMAX,ORSTMS,ORSCH 39 ;pharmacy vars 40 N PSJNOPC,ORMORE,ORINPT,ORXNP,ORSCHED,ORQTY,ORNOUNS,ORXNP,OREFILLS 41 N ORCOMPLX,ORQTY,ORCOPAY,ORDRUG,ORWPSPIK,ORWPSWRG,ORSD,ORDSUP,ORWP94 42 ;dietetics vars 43 N ORPARAM,ORNPO,ORTIME,ORMEAL,ORTRAY,ORDATE 44 ;consults vars 45 N GMRCNOPD,GMRCNOAT,GMRCREAF 46 ; setup general env 47 N ORTYPE,ORVP,ORL,ORNP,ORSEX,ORAGE,ORWARD,OREVENT,ORDIV,ORSC,KEYVAR 48 N ORDG,ORDIALOG,ORCAT,FIRST,ORQUIT,X,ORTRAIL,ORLEAD,RSPREF,AUTOACK 49 N OREVNTYP 50 S ORWP94=$O(^ORD(101.41,"AB","PS MEDS",0))>0 51 S ORVP=$P(FLDS,U,1)_";DPT(",ORNP=+$P(FLDS,U,3),ORSC=$P(FLDS,U,8) 52 S ORL=$P(FLDS,U,2)_";SC(",ORL(2)=ORL 53 S ORSEX=$P(FLDS,U,5),ORAGE=$P(FLDS,U,6),ORTYPE="Q",FIRST=1 54 I $P(FLDS,U,4),$G(^SC(+ORL,42)) S ORWARD=+^SC(+ORL,42) 55 I $L($P(FLDS,U,7)) D 56 . S OREVENT=$P(FLDS,U,7) 57 . S OREVNTYP=$P(OREVENT,";",2) 58 . S OREVENT("TS")=$P(OREVENT,";",3) 59 . S OREVENT("EFFECTIVE")=$P(OREVENT,";",4) 60 . S OREVENT=+$P(OREVENT,";",1) 61 I 'ORWMODE D 62 . D SETKEYV^ORWDXM3($P(FLDS,U,11,20)) ; from menu path 63 . S KEYVAR=$$KEYVAR^ORWDXM3(ORIT) ; from entry action 64 . D SETKEYV^ORWDXM3(KEYVAR) 65 K ^TMP("ORWORD",$J) 66 ; init return record based on auto-accept 67 I ORWMODE S LST(0)="2^"_ORIT ;verify on copy 68 E S LST(0)=+$P($G(^ORD(101.41,ORIT,5)),U,8)_U_ORIT 69 S TEMPCAT=$S($L($P($G(^DPT(+ORVP,.1)),U)):"I",1:"O") 70 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" 71 I $L($G(OREVNTYP)) D 72 . S ORCAT=$S(OREVNTYP="A":"I",OREVNTYP="T":"I",OREVNTYP="O":TEMPCAT,OREVNTYP="M":TEMPCAT,OREVNTYP="C":TEMPCAT,1:"O") I $G(OREVENT) D 73 .. N X S X=$$EVT^OREVNTX(OREVENT),X=$P($G(^ORD(100.5,+X,0)),U,7) 74 .. I OREVNTYP="T",X,X<4 S ORCAT="O" ;To pass=outpt 75 .. I OREVNTYP="D",X=41 S ORCAT="I" ;From ASIH=inpt 76 E S ORCAT=TEMPCAT 77 D SETUP^ORWDXM4 Q:+LST(0)=8 78 S X="OR GTX START DATE"_$S($G(ORWP94):"/TIME",1:"") 79 I ORWMODE,(ORDG=+$O(^ORD(100.98,"B","O RX",0))) D ;remove old values 80 . K ORDIALOG($$PTR^ORCD(X),1) 81 . I ORWMODE=2,$$DRAFT^ORWDX2(ORIT) Q ;keep comments 82 . K:ISXFER'["T" ORDIALOG($$PTR^ORCD("OR GTX WORD PROCESSING 1"),1) 83 D SETUPS^ORWDXM4 ;moved to save space, expects X 84 Q:+LST(0)=8 85 I $G(ORQUIT) S LST(0)="0^0^"_$$DLGINFO^ORWDXM3(ORIT,ORWMODE_ISXFER)_"^"_$G(KEYVAR) Q 86 N SEQ,DA,XCODE,MUSTASK,PROMPT,INST,KEY,IVFID 87 S IVFID=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE",0)) 88 S AUTOACK=$S($D(ORWPSWRG):0,1:1) 89 S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:'SEQ D 90 . S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D 91 . . ; skip if this is a child prompt 92 . . I $P(^ORD(101.41,+ORDIALOG,10,DA,0),U,11) Q 93 . . ; set default for prompt, see if needs to be interactive 94 . . S PROMPT=$P(^ORD(101.41,+ORDIALOG,10,DA,0),U,2) 95 . . D SETITEM(DA,PROMPT,1,.MUSTASK) 96 . . I MUSTASK S AUTOACK=0 Q 97 . . ; iterate through the child items if parent and edit only 98 . . Q:'$D(^ORD(101.41,+ORDIALOG,10,"DAD",PROMPT)) 99 . . N CSEQ,CDA,CPROMPT,INST,ORQUIT 100 . . S CSEQ=0 F S CSEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PROMPT,CSEQ)) Q:'CSEQ D Q:$G(ORQUIT) 101 . . . S CDA=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PROMPT,CSEQ,0)) 102 . . . S CPROMPT=$P(^ORD(101.41,+ORDIALOG,10,CDA,0),U,2) 103 . . . ; if req & no instances then need interaction 104 . . . I $P(^ORD(101.41,+ORDIALOG,10,CDA,0),U,6),ORDIALOG'=IVFID,'$O(ORDIALOG(CPROMPT,0)) S AUTOACK=0 105 . . . S INST=0 F S INST=$O(ORDIALOG(CPROMPT,INST)) Q:'INST D 106 . . . . N ORASK D VBASK^ORWDXM4(INST) ; set ORASK for VBECS 107 . . . . ; set default for each child prompt, if necessary 108 . . . . D SETITEM(CDA,CPROMPT,INST,.MUSTASK) 109 . . . . ; if no val & child prmpt required then need interaction 110 . . . . I MUSTASK,$P(^ORD(101.41,+ORDIALOG,10,CDA,0),U,6) S AUTOACK=0 111 N IVDLG 112 S IVDLG=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0)) 113 I $$ISMED(ORIT),(ORDIALOG'=IVDLG),(ORCAT="I") D 114 . F P="PATIENT INSTRUCTIONS","START DATE/TIME","DAYS SUPPLY","QUANTITY","REFILLS","ROUTING","SERVICE CONNECTED" K ORDIALOG($$PTR(P),1) 115 S KEY=$S(ORWMODE:"C",1:"")_ORIT_"-"_$P($H,",",2),SEQ=0 116 I $$ISINPMED(ORIT) D 117 .S LEVEL=$P(LST(0),U),DELAY=$S($P($G(OREVENT),";")>0:1,1:0) 118 .I LEVEL=2!(ISIMO) D ADMTIME^ORWDXM2(ORDLOC,PATLOC,ENCLOC,DELAY,ISIMO) 119 I ($$ISMED(ORIT)),'($$VALQO^ORWDXM3(ORIT)) S AUTOACK=0 120 S PROMPT=0 F S PROMPT=$O(ORDIALOG(PROMPT)) Q:'PROMPT D 121 . I '$D(^ORD(101.41,ORDIALOG,10,"D",PROMPT)) K ORDIALOG(PROMPT) Q 122 . S INST=0 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST D 123 . . S SEQ=SEQ+1,^TMP("ORWDXMQ",$J,KEY,SEQ,0)=U_PROMPT_U_INST 124 . . ; save word processing value 125 . . I $E(ORDIALOG(PROMPT,0))="W",$L(ORDIALOG(PROMPT,INST)) D 126 . . . M ^TMP("ORWDXMQ",$J,KEY,SEQ,2)=@ORDIALOG(PROMPT,INST) 127 . . ; save other value types 128 . . E S ^TMP("ORWDXMQ",$J,KEY,SEQ,1)=ORDIALOG(PROMPT,INST) 129 I AUTOACK D 130 . I ORWMODE S AUTOACK=2 131 . I 'ORWMODE,($P(^ORD(101.41,ORIT,0),U,8)!'LST(0)) S AUTOACK=2 132 ;I ($$ISMED(ORIT)),'($$VALQO^ORWDXM3(ORIT)) S AUTOACK=0 133 I ORIMO,ORWMODE S AUTOACK=2 134 ; added to accept Herbal/OTC/NonVA Med quick orders 135 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 136 ;I $G(^OR(100,+ORIT,0)),$P($G(^ORD(101.41,+$P(^OR(100,+ORIT,0),U,5),0)),U,8),$D(ORDIALOG("B","HERBAL/OTC/NON VA MEDICATION")) S AUTOACK=1 137 I AUTOACK=2,$$ISMED(ORIT),(ORDIALOG=IVDLG),$$VERORD^ORWDXM3=0 S AUTOACK=0 138 I AUTOACK=2 D VERTXT^ORWDXM2 139 S LST(0)=AUTOACK_U_KEY_U_$$DLGINFO^ORWDXM3(ORIT,ORWMODE_ISXFER)_"^"_$G(KEYVAR) 140 I $P(LST(0),U,4)="D" S $P(LST(0),U,4)="Q" 141 I ORWMODE=1 S $P(LST(0),U,4)="C" 142 K ^TMP("ORWORD",$J) 143 K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J) 144 Q 145 SETITEM(DA,PROMPT,INST,MUSTASK) ; set default value & return if must prompt 146 N EDITONLY,Y,VALIV,XCODE 147 S MUSTASK=0,EDITONLY=0,VALIV=0 148 I $D(^TMP("ORWDHTM",$J,ORDIALOG,PROMPT)) D 149 . I $E(ORDIALOG(PROMPT,0))="W" D 150 . . S ^TMP("ORWORD",$J,PROMPT,INST,1,0)=^TMP("ORWDHTM",$J,ORDIALOG,PROMPT) 151 . . S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")" 152 . E S ORDIALOG(PROMPT,INST)=^TMP("ORWDHTM",$J,ORDIALOG,PROMPT) 153 I $D(^TMP("ORWDHTM",$J,ORIT,PROMPT)) D 154 . S ORDIALOG(PROMPT,INST)=^TMP("ORWDHTM",$J,ORIT,PROMPT) 155 . ; NEED TO CLEAN UP ^TMP("ORWDHTM") after process order set!!! 156 ; 157 ; skip if a value already exists for this prompt and not WP 158 Q:$D(ORDIALOG(PROMPT,INST))&($E(ORDIALOG(PROMPT,0))'="W") 159 ; execute default action if no value in QO, checking EDITONLY afterwards 160 I '$D(ORDIALOG(PROMPT,INST)) D 161 . ; 162 . ;Intermittent IV orders do not require a solution or an infusion rate 163 . I PROMPT=$$PTR("INFUSION RATE"),$$GETIVTYP^ORWDXM3="I" S VALIV=1 Q 164 . I PROMPT=$$PTR("ORDERABLE ITEM"),$$GETIVTYP^ORWDXM3="I" S VALIV=1 Q 165 . I $E(ORDIALOG(PROMPT,0))="W",$D(^ORD(101.41,+ORDIALOG,10,DA,8))>9 D 166 . . M ^TMP("ORWORD",$J,PROMPT,INST)=^ORD(101.41,+ORDIALOG,10,DA,8) 167 . . S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")" 168 . E D 169 . . S XCODE=$$SUBCODE($G(^ORD(101.41,+ORDIALOG,10,DA,7))) 170 . . I $L(XCODE) X XCODE S:$D(Y) ORDIALOG(PROMPT,INST)=Y 171 Q:VALIV=1 172 Q:$G(EDITONLY) 173 I 'ORWMODE,$P($G(^ORD(101.41,+ORDIALOG,10,DA,0)),U,8) Q 174 I ORWMODE,($P($G(^ORD(101.41,+ORDIALOG,10,DA,0)),U,9)'["W"),'$P($G(^ORD(101.41,+ORDIALOG,10,DA,0)),U,6)!$D(ORDIALOG(PROMPT,INST)) Q 175 I 'ORWMODE,LST(0),$D(ORDIALOG(PROMPT,INST)),($E(ORDIALOG(PROMPT,0))="W") Q 176 I 'ORWMODE,LST(0),'$P($G(^ORD(101.41,+ORDIALOG,10,DA,0)),U,6) Q 177 S XCODE=$$SUBCODE($G(^ORD(101.41,+ORDIALOG,10,DA,3))) 178 I $L(XCODE) X XCODE Q:'$T 179 S MUSTASK=1 180 Q 181 SUBCODE(X) ; substitute code 182 I X["$$REQDCOMM^ORCDLR" Q "I $$LRRQCM^ORWDXM2" 183 I X["$$ASKSAMP^ORCDLR" Q "I $$LRASMP^ORWDXM2" 184 I X["$$SCHEDULD^ORCDRA1" Q "I $$SCHEDULD^ORWDXM2" 185 I X["(^PSX(550,""C"")" Q "S Y=$E($$DEFPICK^ORWDPS32) K:'$L(Y) Y" 186 I X["I $$ASKURG^ORCDVBEC" Q "I 1" 187 I X["K:$G(ORASK)" Q "I $G(ORASK)" 188 Q X 189 PTR(NAME) ; -- Returns pointer to OR GTX NAME 190 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0)) 191 ; 192 ISINPMED(IFN) ; 193 N PKG,RESULT,Y 194 I 'ORWMODE S PKG=$P($G(^ORD(101.41,IFN,0)),U,7) 195 E S PKG=$P($G(^OR(100,+IFN,0)),U,14) 196 S Y=$$GET1^DIQ(9.4,+PKG_",",1) 197 S RESULT=$S($E(Y,1,3)="PSJ":1,1:0) 198 Q RESULT 199 ; 200 ISMED(IFN) ; return 1 if pharmacy order dlg used 201 N PKG 202 I 'ORWMODE S PKG=$P($G(^ORD(101.41,IFN,0)),U,7) 203 E S PKG=$P($G(^OR(100,+IFN,0)),U,14) 204 Q $$NMSP^ORCD(PKG)="PS" 205 SITEVAL() ;return 1 if site does want the reason for study to carry through from past orders of this ordering session 206 I $$GET^XPAR("ALL","OR RA RFS CARRY ON")=0 Q 0 207 Q 1 208 SVRPC(RET,X) ;RPC FOR SITEVAL 209 S RET=$$SITEVAL 210 Q 1 ORWDXM1 ; SLC/KCM - Order Dialogs, Menus;2/19/03 ;11/15/2005 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,131,132,141,178,185,187,215**;Dec 17, 1997 3 BLDQRSP(LST,ORIT,FLDS,ISIMO) ; Build responses for an order 4 ; LST=QuickLevel^ResponseID(ORIT;$H)^Dialog^Type^FormID^DGrp 5 ; LST(n)=verify text or reject text 6 ; ORIT= ptr to 101.41 for quick order, 100 for copy 7 ; 1 2 3 4 5 6 7 8 11-20 8 ; FLDS=DFN^LOC^ORNP^INPT^SEX^AGE^EVENT^SC%^^^Key Variables... 9 ; ORIT=+ORIT: ptr to 101.41, $E(ORIT)=C: copy $E(ORIT)=X: change 10 ; !! SHOULD CHECK for PRE-CPRS ORDERS (treat as text?) 11 K ^TMP("ORWDXMQ",$J) 12 N ORWMODE ; 0:Dialog,Quick 1:copy order 2:change order 13 N TEMPCAT ; patient category from DPT file 14 N ISXFER ; Transfer order? 15 N ORIMO ;If IMO(inpatient medication on outpatient) 16 N TEMPORIT 17 S ORIMO=$G(ISIMO) 18 S ORWMODE=0,ISXFER="" 19 S:$E(ORIT)="C" ORWMODE=1 S:$E(ORIT)="T" ORWMODE=1,ISXFER=";T" ;treat xfer as copy for now 20 S:$E(ORIT)="X" ORWMODE=2 21 S TEMPORIT=ORIT 22 I ORWMODE S ORIT=$E(ORIT,2,999) 23 S LST(0)="" 24 D CHKDSBL^ORWDXM3(.LST,ORIT,ORWMODE) Q:+LST(0)=8 ;disable 25 D CHKVACT^ORWDXM3(.LST,ORIT,ORWMODE,$P(FLDS,U,3)) Q:+LST(0)=8 ;action 26 I ORWMODE=1 D CHKCOPY^ORWDXM3(.LST,ORIT,FLDS) Q:+LST(0)=8 ;no copy 27 I ORWMODE=2 D BLD4CHG^ORWDXM3(.LST,ORIT,FLDS) Q ;change 28 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 29 ;radilogy vars 30 N ORIMTYPE 31 ;blood bank vars 32 N ORCOMP,ORTAS 33 ;lab vars 34 N LRFZX,LRFSAMP,LRFSPEC,LRFDATE,LRFURG,LRFSCH 35 N ORTIME,ORCOLLCT,ORMAX,ORTEST,ORIMTIME,ORSMAX,ORSTMS,ORSCH 36 ;pharmacy vars 37 N PSJNOPC,ORMORE,ORINPT,ORXNP,ORSCHED,ORQTY,ORNOUNS,ORXNP,OREFILLS 38 N ORCOMPLX,ORQTY,ORCOPAY,ORDRUG,ORWPSPIK,ORWPSWRG,ORSD,ORDSUP,ORWP94 39 ;dietetics vars 40 N ORPARAM,ORNPO,ORTIME,ORMEAL,ORTRAY,ORDATE 41 ;consults vars 42 N GMRCNOPD,GMRCNOAT,GMRCREAF 43 ; setup general env 44 N ORTYPE,ORVP,ORL,ORNP,ORSEX,ORAGE,ORWARD,OREVENT,ORDIV,ORSC,KEYVAR 45 N ORDG,ORDIALOG,ORCAT,FIRST,ORQUIT,X,ORTRAIL,ORLEAD,RSPREF,AUTOACK 46 N OREVNTYP 47 S ORWP94=$O(^ORD(101.41,"AB","PS MEDS",0))>0 48 S ORVP=$P(FLDS,U,1)_";DPT(",ORNP=+$P(FLDS,U,3),ORSC=$P(FLDS,U,8) 49 S ORL=$P(FLDS,U,2)_";SC(",ORL(2)=ORL 50 S ORSEX=$P(FLDS,U,5),ORAGE=$P(FLDS,U,6),ORTYPE="Q",FIRST=1 51 I $P(FLDS,U,4),$G(^SC(+ORL,42)) S ORWARD=+^SC(+ORL,42) 52 I $L($P(FLDS,U,7)) D 53 . S OREVENT=$P(FLDS,U,7) 54 . S OREVNTYP=$P(OREVENT,";",2) 55 . S OREVENT("TS")=$P(OREVENT,";",3) 56 . S OREVENT("EFFECTIVE")=$P(OREVENT,";",4) 57 . S OREVENT=+$P(OREVENT,";",1) 58 I 'ORWMODE D 59 . D SETKEYV^ORWDXM3($P(FLDS,U,11,20)) ; from menu path 60 . S KEYVAR=$$KEYVAR^ORWDXM3(ORIT) ; from entry action 61 . D SETKEYV^ORWDXM3(KEYVAR) 62 K ^TMP("ORWORD",$J) 63 ; init return record based on auto-accept 64 I ORWMODE S LST(0)="2^"_ORIT ;verify on copy 65 E S LST(0)=+$P($G(^ORD(101.41,ORIT,5)),U,8)_U_ORIT 66 S TEMPCAT=$S($L($P($G(^DPT(+ORVP,.1)),U)):"I",1:"O") 67 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" 68 I $L($G(OREVNTYP)) D 69 . S ORCAT=$S(OREVNTYP="A":"I",OREVNTYP="T":"I",OREVNTYP="O":TEMPCAT,OREVNTYP="M":TEMPCAT,OREVNTYP="C":TEMPCAT,1:"O") I $G(OREVENT) D 70 .. N X S X=$$EVT^OREVNTX(OREVENT),X=$P($G(^ORD(100.5,+X,0)),U,7) 71 .. I OREVNTYP="T",X,X<4 S ORCAT="O" ;To pass=outpt 72 .. I OREVNTYP="D",X=41 S ORCAT="I" ;From ASIH=inpt 73 E S ORCAT=TEMPCAT 74 D SETUP^ORWDXM4 Q:+LST(0)=8 75 S X=$S($G(ORWP94):"OR GTX START DATE/TIME",1:"OR GTX START DATE") 76 I ORWMODE,(ORDG=+$O(^ORD(100.98,"B","O RX",0))) K ORDIALOG($$PTR^ORCD(X),1) 77 D SETUPS^ORWDXM4 ; moved to save space 78 Q:+LST(0)=8 79 I $G(ORQUIT) S LST(0)="0^0^"_$$DLGINFO^ORWDXM3(ORIT,ORWMODE_ISXFER)_"^"_$G(KEYVAR) Q 80 N SEQ,DA,XCODE,MUSTASK,PROMPT,INST,KEY,IVFID 81 S IVFID=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE",0)) 82 S AUTOACK=$S($D(ORWPSWRG):0,1:1) 83 S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:'SEQ D 84 . S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D 85 . . ; skip if this is a child prompt 86 . . I $P(^ORD(101.41,+ORDIALOG,10,DA,0),U,11) Q 87 . . ; set default for prompt, see if needs to be interactive 88 . . S PROMPT=$P(^ORD(101.41,+ORDIALOG,10,DA,0),U,2) 89 . . D SETITEM(DA,PROMPT,1,.MUSTASK) 90 . . I MUSTASK S AUTOACK=0 Q 91 . . ; iterate through the child items if parent and edit only 92 . . Q:'$D(^ORD(101.41,+ORDIALOG,10,"DAD",PROMPT)) 93 . . N CSEQ,CDA,CPROMPT,INST,ORQUIT 94 . . S CSEQ=0 F S CSEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PROMPT,CSEQ)) Q:'CSEQ D Q:$G(ORQUIT) 95 . . . S CDA=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PROMPT,CSEQ,0)) 96 . . . S CPROMPT=$P(^ORD(101.41,+ORDIALOG,10,CDA,0),U,2) 97 . . . ; if req & no instances then need interaction 98 . . . I $P(^ORD(101.41,+ORDIALOG,10,CDA,0),U,6),ORDIALOG'=IVFID,'$O(ORDIALOG(CPROMPT,0)) S AUTOACK=0 99 . . . S INST=0 F S INST=$O(ORDIALOG(CPROMPT,INST)) Q:'INST D 100 . . . . N ORASK D VBASK^ORWDXM4(INST) ; set ORASK for VBECS 101 . . . . ; set default for each child prompt, if necessary 102 . . . . D SETITEM(CDA,CPROMPT,INST,.MUSTASK) 103 . . . . ; if no val & child prmpt required then need interaction 104 . . . . I MUSTASK,$P(^ORD(101.41,+ORDIALOG,10,CDA,0),U,6) S AUTOACK=0 105 N IVDLG 106 S IVDLG=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0)) 107 I $$ISMED(ORIT),(ORDIALOG'=IVDLG),(ORCAT="I") D 108 . F P="PATIENT INSTRUCTIONS","START DATE/TIME","DAYS SUPPLY","QUANTITY","REFILLS","ROUTING","SERVICE CONNECTED" K ORDIALOG($$PTR(P),1) 109 S KEY=$S(ORWMODE:"C",1:"")_ORIT_"-"_$P($H,",",2),SEQ=0 110 S PROMPT=0 F S PROMPT=$O(ORDIALOG(PROMPT)) Q:'PROMPT D 111 . I '$D(^ORD(101.41,ORDIALOG,10,"D",PROMPT)) K ORDIALOG(PROMPT) Q 112 . S INST=0 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST D 113 . . S SEQ=SEQ+1,^TMP("ORWDXMQ",$J,KEY,SEQ,0)=U_PROMPT_U_INST 114 . . ; save word processing value 115 . . I $E(ORDIALOG(PROMPT,0))="W",$L(ORDIALOG(PROMPT,INST)) D 116 . . . M ^TMP("ORWDXMQ",$J,KEY,SEQ,2)=@ORDIALOG(PROMPT,INST) 117 . . ; save other value types 118 . . E S ^TMP("ORWDXMQ",$J,KEY,SEQ,1)=ORDIALOG(PROMPT,INST) 119 I AUTOACK D 120 . I ORWMODE S AUTOACK=2 121 . I 'ORWMODE,($P(^ORD(101.41,ORIT,0),U,8)!'LST(0)) S AUTOACK=2 122 I ($$ISMED(ORIT)),'($$VALQO^ORWDXM3(ORIT)) S AUTOACK=0 123 I ORIMO,ORWMODE S AUTOACK=2 124 ; added to accept Herbal/OTC/NonVA Med quick orders 125 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 126 ;I $G(^OR(100,+ORIT,0)),$P($G(^ORD(101.41,+$P(^OR(100,+ORIT,0),U,5),0)),U,8),$D(ORDIALOG("B","HERBAL/OTC/NON VA MEDICATION")) S AUTOACK=1 127 I AUTOACK=2 D VERTXT^ORWDXM2 128 S LST(0)=AUTOACK_U_KEY_U_$$DLGINFO^ORWDXM3(ORIT,ORWMODE_ISXFER)_"^"_$G(KEYVAR) 129 I $P(LST(0),U,4)="D" S $P(LST(0),U,4)="Q" 130 I ORWMODE=1 S $P(LST(0),U,4)="C" 131 K ^TMP("ORWORD",$J) 132 K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J) 133 Q 134 SETITEM(DA,PROMPT,INST,MUSTASK) ; set default value & return if must prompt 135 N EDITONLY,Y,XCODE 136 S MUSTASK=0,EDITONLY=0 137 I $D(^TMP("ORWDHTM",$J,ORDIALOG,PROMPT)) D 138 . I $E(ORDIALOG(PROMPT,0))="W" D 139 . . S ^TMP("ORWORD",$J,PROMPT,INST,1,0)=^TMP("ORWDHTM",$J,ORDIALOG,PROMPT) 140 . . S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")" 141 . E S ORDIALOG(PROMPT,INST)=^TMP("ORWDHTM",$J,ORDIALOG,PROMPT) 142 I $D(^TMP("ORWDHTM",$J,ORIT,PROMPT)) D 143 . S ORDIALOG(PROMPT,INST)=^TMP("ORWDHTM",$J,ORIT,PROMPT) 144 . ; NEED TO CLEAN UP ^TMP("ORWDHTM") after process order set!!! 145 ; 146 ; skip if a value already exists for this prompt and not WP 147 Q:$D(ORDIALOG(PROMPT,INST))&($E(ORDIALOG(PROMPT,0))'="W") 148 ; execute default action if no value in QO, checking EDITONLY afterwards 149 I '$D(ORDIALOG(PROMPT,INST)) D 150 . I $E(ORDIALOG(PROMPT,0))="W",$D(^ORD(101.41,+ORDIALOG,10,DA,8))>9 D 151 . . M ^TMP("ORWORD",$J,PROMPT,INST)=^ORD(101.41,+ORDIALOG,10,DA,8) 152 . . S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")" 153 . E D 154 . . S XCODE=$$SUBCODE($G(^ORD(101.41,+ORDIALOG,10,DA,7))) 155 . . I $L(XCODE) X XCODE S:$D(Y) ORDIALOG(PROMPT,INST)=Y 156 Q:$G(EDITONLY) 157 I 'ORWMODE,$P($G(^ORD(101.41,+ORDIALOG,10,DA,0)),U,8) Q 158 I ORWMODE,($P($G(^ORD(101.41,+ORDIALOG,10,DA,0)),U,9)'["W"),'$P($G(^ORD(101.41,+ORDIALOG,10,DA,0)),U,6)!$D(ORDIALOG(PROMPT,INST)) Q 159 I 'ORWMODE,LST(0),$D(ORDIALOG(PROMPT,INST)),($E(ORDIALOG(PROMPT,0))="W") Q 160 I 'ORWMODE,LST(0),'$P($G(^ORD(101.41,+ORDIALOG,10,DA,0)),U,6) Q 161 S XCODE=$$SUBCODE($G(^ORD(101.41,+ORDIALOG,10,DA,3))) 162 I $L(XCODE) X XCODE Q:'$T 163 S MUSTASK=1 164 Q 165 SUBCODE(X) ; substitute code 166 I X["$$REQDCOMM^ORCDLR" Q "I $$LRRQCM^ORWDXM2" 167 I X["$$ASKSAMP^ORCDLR" Q "I $$LRASMP^ORWDXM2" 168 I X["$$SCHEDULD^ORCDRA1" Q "I $$SCHEDULD^ORWDXM2" 169 I X["(^PSX(550,""C"")" Q "S Y=$E($$DEFPICK^ORWDPS32) K:'$L(Y) Y" 170 I X["I $$ASKURG^ORCDVBEC" Q "I 1" 171 I X["K:$G(ORASK)" Q "I $G(ORASK)" 172 Q X 173 PTR(NAME) ; -- Returns pointer to OR GTX NAME 174 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0)) 175 ; 176 ISMED(IFN) ; return 1 if pharmacy order dlg used 177 N PKG 178 I 'ORWMODE S PKG=$P($G(^ORD(101.41,IFN,0)),U,7) 179 E S PKG=$P($G(^OR(100,+IFN,0)),U,14) 180 Q $$NMSP^ORCD(PKG)="PS"
Note:
See TracChangeset
for help on using the changeset viewer.
