- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXM2.m
r613 r623 1 ORWDXM2 ; SLC/KCM - Quick Orders ;04/25/2007 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,116,132,158,187,195,215,243**;Dec 17, 1997;Build 242 3 ; 4 ADMTIME(ORDLOC,PATLOC,ENCLOC,DELAY,ISIMO) ; 5 N ADMLOC,INST,SCHLOC,SCHTYPE 6 S ADMLOC=+$P($G(ORDIALOG("B","ADMINISTRATION TIMES")),U,2) 7 I ADMLOC>0,ORDLOC>0,PATLOC'=ORDLOC D Q 8 .S INST=0 F S INST=$O(ORDIALOG(ADMLOC,INST)) Q:+INST'>0 D 9 ..S ORDIALOG(ADMLOC,INST)="" 10 I ADMLOC>0,$S(ENCLOC'=PATLOC:1,ISIMO:1,DELAY:1,1:0) D Q 11 .S INST=0 F S INST=$O(ORDIALOG(ADMLOC,INST)) Q:+INST'>0 D 12 ..S ORDIALOG(ADMLOC,INST)="" 13 S SCHLOC=+$P($G(ORDIALOG("B","SCHEDULE TYPE")),U,2) Q:SCHLOC'>0 14 S INST=0 F S INST=$O(ORDIALOG(SCHLOC,INST)) Q:+INST'>0 D 15 .S SCHTYP=$G(ORDIALOG(SCHLOC,INST)) Q:SCHTYP="" 16 .I $S(SCHTYP="P":1,SCHTYP="O":1,SCHTYP="OC":1,1:0),ADMLOC>0 S ORDIALOG(ADMLOC,INST)="" 17 Q 18 ; 19 CLRRCL(OK) ; clear ORECALL 20 S OK=1 21 K ^TMP("ORECALL",$J),^TMP("ORWDXMQ",$J) 22 Q 23 VERTXT ; set verify text for order 24 N SEQ,DA,X,PROMPT,MULT,CHILD,INST,TITLE,TEMP,ILST,SPACES 25 N ISADMIN 26 S ILST=0,$P(SPACES," ",31)="" 27 S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0 D 28 . S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D 29 . . S X0=$G(^ORD(101.41,+ORDIALOG,10,DA,0)) 30 . . S ISADMIN=$S(+OREVENT>0:0,ISIMO=1:0,$P($G(^ORD(101.41,$P(X0,U,2),0)),U)="OR GTX ADMIN TIMES":1,1:0) 31 . . I ISADMIN=1,ORDLOC>0,ORDLOC'=PATLOC Q 32 . . I $P(X0,U,9)["*",ISADMIN=0 Q 33 . . S PROMPT=$P(X0,U,2),MULT=$P(X0,U,7),CHILD=$P(X0,U,11) I CHILD,ISADMIN=0 Q 34 . . Q:'PROMPT S INST=$O(ORDIALOG(PROMPT,0)) Q:'INST ; no values 35 . . S TITLE=$S($L($G(ORDIALOG(PROMPT,"TTL"))):ORDIALOG(PROMPT,"TTL"),1:ORDIALOG(PROMPT,"A")) 36 . . I $E(ORDIALOG(PROMPT,0))="W" D 37 . . . N IWP,WP,CNT 38 . . . S IWP=0,CNT=0 39 . . . F S IWP=$O(^TMP("ORWORD",$J,PROMPT,INST,IWP)) Q:'IWP D 40 . . . . S CNT=CNT+1,WP(CNT)=^TMP("ORWORD",$J,PROMPT,INST,IWP,0) 41 . . . I CNT=1 S ILST=ILST+1,LST(ILST)=$J(TITLE,30)_WP(1) 42 . . . I CNT>1 D 43 . . . . S ILST=ILST+1,LST(ILST)=TITLE,IWP=0 44 . . . . F S IWP=$O(WP(IWP)) Q:'IWP S ILST=ILST+1,LST(ILST)=WP(IWP) 45 . . E D 46 . . . S TEMP=$$ITEM^ORCDLG(PROMPT,INST) I TEMP="" Q 47 . . . S ILST=ILST+1,LST(ILST)=$J(TITLE,30) 48 . . . ;S LST(ILST)=LST(ILST)_$$ITEM^ORCDLG(PROMPT,INST) 49 . . . S LST(ILST)=LST(ILST)_TEMP 50 . . Q:'MULT Q:'$O(ORDIALOG(PROMPT,INST)) ; done 51 . . F S INST=$O(ORDIALOG(PROMPT,INST)) Q:INST'>0 S ILST=ILST+1,LST(ILST)=SPACES_$$ITEM^ORCDLG(PROMPT,INST) 52 D DISPLAY^ORWDBA3 ;for display of Billing Aware data from orig order 53 Q 54 RA ; setup environment for radiology 55 ; -- get imaging types based on display group of quick order and 56 ; setup list of imaging locations based on imaging type 57 N ORY,ITYPE,IFN,CNT,ORIMLOC,PROMPT 58 S ORDIV=$$DIV^ORCDRA1,ITYPE=$P($G(^ORD(100.98,+ORDG,0)),U,3) 59 S ORIMTYPE=$O(^RA(79.2,"C",ITYPE,0)) 60 D EN4^RAO7PC1(ITYPE,"ORY") 61 S (IFN,CNT)=0 F S IFN=$O(ORY(IFN)) Q:IFN'>0 D 62 . S CNT=CNT+1,ORIMLOC(CNT)=ORY(IFN),ORIMLOC("B",$P(ORY(IFN),U,2))=IFN 63 I '$$GET^XPAR("ALL","RA SUBMIT PROMPT",1,"Q"),CNT>1 K ORIMLOC 64 E S ORIMLOC=CNT_"^1" 65 S PROMPT=$O(^ORD(101.41,"B","OR GTX IMAGING LOCATION",0)) 66 I $G(ORIMLOC) M ORDIALOG(PROMPT,"LIST")=ORIMLOC 67 Q 68 LR ; setup environment for lab 69 ; -- setup ORTIME, ORIMTIME & ORTEST arrays 70 ; setup ORMAX, ORDG, & ORCOLLCT variables 71 N PROMPT,INST,EDITONLY 72 D GETIMES^ORCDLR1 ; sets up ORTIME and ORIMTIME arrays 73 S ORMAX=$$GET^XPAR("ALL^LOC.`"_+ORL,"LR MAX DAYS CONTINUOUS",1,"Q") 74 S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0)),INST=1 75 D LRTEST ; sets up ORTEST array and ORDG 76 S PROMPT=$O(^ORD(101.41,"B","OR GTX COLLECTION TYPE",0)) 77 I $D(ORDIALOG(PROMPT,1)) S ORCOLLCT=ORDIALOG(PROMPT,1) I 1 78 E S EDITONLY=0,ORCOLLCT=$$COLLTYPE^ORCDLR1 79 I ORCOLLCT="I" D 80 . S PROMPT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0)) 81 . D LRICTMOK 82 S PROMPT=$O(^ORD(101.41,"B","OR GTX ADMIN SCHEDULE",0)) 83 I $D(ORDIALOG(PROMPT,1)) S ORSCH=ORDIALOG(PROMPT,1) 84 Q 85 LRTEST ; -- Setup ORTEST() array of ordering parameters (copied from ORCDLR) 86 N OI,TST,DG 87 S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI 88 I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST 89 S DG=$P($G(^ORD(101.43,+OI,"LR")),U,6) S:'$L(DG) DG="LAB" 90 S DG=$O(^ORD(100.98,"B",DG,0)) S:DG ORDG=DG 91 Q 92 LRRQCM() ; return true if lab test has required comments 93 I $O(^TMP("ORWORD",$J,PROMPT,INST,0)) Q 1 ; edit via WP 94 N LRTEST,LRSAMP,LRSPEC,LRTSTN,LRTCOM,LRCCOM,DA,CNT,I,REQDCOMM,OI,TST 95 S LRSAMP=$$VAL^ORCD("COLLECTION SAMPLE"),LRSPEC=$$VAL^ORCD("SPECIMEN") 96 S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI 0 97 I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST 98 S LRTSTN=1,LRTEST(1)=+ORTEST,DA=$O(^LAB(60,LRTEST(1),3,"B",+LRSAMP,0)) 99 S REQDCOMM=$P($G(^LAB(60,LRTEST(1),3,+DA,0)),U,6) 100 S:'REQDCOMM REQDCOMM=+$P($G(^LAB(60,LRTEST(1),0)),U,19) 101 Q REQDCOMM 102 LRASMP() ; return true to ask collection sample (from ASKSAMP^ORCDLR) 103 N DEFSAMP,SAMP0 104 S DEFSAMP=$G(ORDIALOG(PROMPT,INST)),SAMP0=$G(^LAB(62,+DEFSAMP,0)) 105 I (ORCOLLCT="LC")!(ORCOLLCT="I"),$G(ORTEST("Lab CollSamp")) Q 0 106 I $G(ORTEST("Unique CollSamp")),DEFSAMP Q 0 ; unique -> don't ask 107 I 'DEFSAMP!('FIRST) Q 1 ; no default or edit -> ask 108 I $G(ORDIALOG(PROMPT,"LIST"))="1^1" Q 0 ; only one choice 109 Q 1 110 LRICTMOK ; 111 Q:'$D(ORDIALOG(PROMPT,1)) 112 N ORY 113 D VALDT^ORWU(.ORY,ORDIALOG(PROMPT,1)) 114 I +$$VALID^LR7OV4(DUZ(2),ORY)=0 S ORDIALOG(PROMPT,1)="" 115 Q 116 DO ; setup environment for diet order 117 ; partially copied from EN^ORCDFH 118 I ORCAT'="I" D Q 119 . S ORQUIT=1 120 . S LST(0)="8^0" 121 . S LST(.5)="This type of diet may be entered for inpatients only." 122 D EN^FHWOR8(+ORVP,.ORPARAM) ; set FH ordering parameters 123 S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now 124 N PROMPT,OI ; set NPO flag if NPO diet 125 S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0)) 126 S OI=+$G(ORDIALOG(PROMPT,1)) 127 S ORNPO=($P($G(^ORD(101.43,OI,0)),U)="NPO") 128 S PROMPT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0)) 129 S X=$G(ORDIALOG(PROMPT,1)) I $L(X) D CNV^ORCDFH1 S ORDIALOG(PROMPT,1)=$G(X) 130 Q 131 EL ; setup environment for early/late tray 132 D EN^FHWOR8(+ORVP,.ORPARAM) ; set FH ordering parameters 133 S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now 134 D EN2^ORCDFH ; setup ORTIME array 135 N PROMPT ; set ORMEAL,ORTRAY 136 S PROMPT=$O(^ORD(101.41,"B","OR GTX MEAL",0)) 137 I $D(ORDIALOG(PROMPT,1)) S ORMEAL=ORDIALOG(PROMPT,1) 138 S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0)) 139 I $D(ORDIALOG(PROMPT,1)) S ORTRAY=ORDIALOG(PROMPT,1) 140 Q 141 UD ; setup environment for unit dose med 142 I $G(ORWP94) G PS^ORWDPS3 ; if patch 94 installed 143 ; 144 D AUTHMED Q:$G(ORQUIT) ; checks authorized to write meds 145 N PROMPT,OI 146 S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0)) 147 I $D(ORDIALOG(PROMPT,1)) S OI=ORDIALOG(PROMPT,1) D MEDACTV(1) Q:$G(ORQUIT) 148 D INSTR^ORCDPS(OI) ; sets up instructions, routes, etc. 149 D CHOICES^ORCDPS("U") ; gets list of dispense drugs 150 Q 151 IV ; setup environment for IV fluid 152 D AUTHMED Q:$G(ORQUIT) ; checks authorized to write meds 153 ; sets up list of volumes if only one solution 154 ; otherwise, let the dialog go interactive 155 N PROMPT,INST,CNT,OI 156 S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0)) 157 S (CNT,INST)=0 158 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST D Q:$G(ORQUIT) 159 . S CNT=CNT+1 160 . S OI=ORDIALOG(PROMPT,INST) D MEDACTV(3) ; check active solutions 161 I CNT=1 S INST=1 D VOLUME^ORCDPSIV 162 S PROMPT=$O(^ORD(101.41,"B","OR GTX ADDITIVE",0)) 163 S INST=0 164 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST D Q:$G(ORQUIT) 165 . S OI=ORDIALOG(PROMPT,INST) D MEDACTV(4) ; check active additives 166 Q 167 OP ; setup environment for outpatient pharmacy 168 I $G(ORWP94) G PS^ORWDPS3 ; if patch 94 installed 169 ; 170 D AUTHMED Q:$G(ORQUIT) ; checks authorized to write meds 171 N PROMPT,INST,CNT,OI 172 S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0)),OI=0 173 I $D(ORDIALOG(PROMPT,1)) S OI=$G(ORDIALOG(PROMPT,1)) D MEDACTV(2) Q:$G(ORQUIT) 174 D:+OI INSTR^ORCDPS(OI) ; sets up instructions, routes, etc. 175 D CHOICES^ORCDPS("O") ; gets list of dispense drugs 176 ; get defaults for drug, refills if only one dispense drug 177 S PROMPT=$O(^ORD(101.41,"B","OR GTX DISPENSE DRUG",0)) 178 S (CNT,INST)=0 179 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST S CNT=CNT+1 180 I CNT=1 D 181 . S ORDRUG=+$G(ORDIALOG(PROMPT,1)),ORCOMPLX=0 182 . S OREFILLS=$P($G(ORDIALOG(PROMPT,"LIST","D",ORDRUG)),U,3) 183 . S:'$L(OREFILLS) OREFILLS=11 184 E S ORCOMPLX=1,OREFILLS=11 ; force interactive on complex order 185 S ORCOPAY=1 ; ask SC if can't determine copay 186 I $G(ORDRUG),$L($T(ASKSC^ORCDPS)) S ORCOPAY=$$ASKSC^ORCDPS 187 Q 188 AUTHMED ; sets ORQUIT if not authorized to write meds 189 N NOAUTH,NAME 190 D AUTH^ORWDPS32(.NOAUTH,ORNP) 191 I +NOAUTH D 192 . S ORQUIT=1 193 . S LST(0)="8^0" 194 . S NAME=$P($G(^VA(200,+ORNP,20)),U,2) 195 . I '$L(NAME) S NAME=$P($G(^VA(200,+ORNP,0)),U,1) 196 . S LST(.5)=NAME_" is not authorized to write med orders." 197 Q 198 MEDACTV(USAGE) ; sets ORQUIT if the orderable item is not active for a med 199 Q:'$G(OI) S USAGE=+$G(USAGE) 200 I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D Q 201 . S ORQUIT=1,LST(0)="8^0" 202 . S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" has been inactivated and may not be ordered anymore." 203 I USAGE,'$P($G(^ORD(101.43,OI,"PS")),U,USAGE) D Q 204 . S ORQUIT=1,LST(0)="8^0" 205 . S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" may not be ordered as an "_$S(USAGE=1:"inpatient medication",USAGE=2:"outpatient medication",USAGE=3:"IV solution",1:"IV additive")_" anymore." 206 Q 207 SCHEDULD() ; Is patient scheduled for PREOP (Imaging) 208 I $G(ORDIALOG(PROMPT,1)) Q 1 ; don't ask - already have date 209 E Q 0 210 Q 1 ORWDXM2 ; SLC/KCM - Quick Orders ;11/25/02 09:49 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,116,132,158,187,195,215**;Dec 17, 1997 3 ; 4 CLRRCL(OK) ; clear ORECALL 5 S OK=1 6 K ^TMP("ORECALL",$J),^TMP("ORWDXMQ",$J) 7 Q 8 VERTXT ; set verify text for order 9 N SEQ,DA,X,PROMPT,MULT,CHILD,INST,TITLE,ILST,SPACES 10 S ILST=0,$P(SPACES," ",31)="" 11 S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0 D 12 . S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D 13 . . S X0=$G(^ORD(101.41,+ORDIALOG,10,DA,0)) 14 . . Q:$P(X0,U,9)["*" ; hidden prompt 15 . . S PROMPT=$P(X0,U,2),MULT=$P(X0,U,7),CHILD=$P(X0,U,11) Q:CHILD 16 . . Q:'PROMPT S INST=$O(ORDIALOG(PROMPT,0)) Q:'INST ; no values 17 . . S TITLE=$S($L($G(ORDIALOG(PROMPT,"TTL"))):ORDIALOG(PROMPT,"TTL"),1:ORDIALOG(PROMPT,"A")) 18 . . I $E(ORDIALOG(PROMPT,0))="W" D 19 . . . N IWP,WP,CNT 20 . . . S IWP=0,CNT=0 21 . . . F S IWP=$O(^TMP("ORWORD",$J,PROMPT,INST,IWP)) Q:'IWP D 22 . . . . S CNT=CNT+1,WP(CNT)=^TMP("ORWORD",$J,PROMPT,INST,IWP,0) 23 . . . I CNT=1 S ILST=ILST+1,LST(ILST)=$J(TITLE,30)_WP(1) 24 . . . I CNT>1 D 25 . . . . S ILST=ILST+1,LST(ILST)=TITLE,IWP=0 26 . . . . F S IWP=$O(WP(IWP)) Q:'IWP S ILST=ILST+1,LST(ILST)=WP(IWP) 27 . . E D 28 . . . S ILST=ILST+1,LST(ILST)=$J(TITLE,30) 29 . . . S LST(ILST)=LST(ILST)_$$ITEM^ORCDLG(PROMPT,INST) 30 . . Q:'MULT Q:'$O(ORDIALOG(PROMPT,INST)) ; done 31 . . F S INST=$O(ORDIALOG(PROMPT,INST)) Q:INST'>0 S ILST=ILST+1,LST(ILST)=SPACES_$$ITEM^ORCDLG(PROMPT,INST) 32 D DISPLAY^ORWDBA3 ;for display of Billing Aware data from orig order 33 Q 34 RA ; setup environment for radiology 35 ; -- get imaging types based on display group of quick order and 36 ; setup list of imaging locations based on imaging type 37 N ORY,ITYPE,IFN,CNT,ORIMLOC,PROMPT 38 S ORDIV=$$DIV^ORCDRA1,ITYPE=$P($G(^ORD(100.98,+ORDG,0)),U,3) 39 S ORIMTYPE=$O(^RA(79.2,"C",ITYPE,0)) 40 D EN4^RAO7PC1(ITYPE,"ORY") 41 S (IFN,CNT)=0 F S IFN=$O(ORY(IFN)) Q:IFN'>0 D 42 . S CNT=CNT+1,ORIMLOC(CNT)=ORY(IFN),ORIMLOC("B",$P(ORY(IFN),U,2))=IFN 43 I '$$GET^XPAR("ALL","RA SUBMIT PROMPT",1,"Q"),CNT>1 K ORIMLOC 44 E S ORIMLOC=CNT_"^1" 45 S PROMPT=$O(^ORD(101.41,"AB","OR GTX IMAGING LOCATION",0)) 46 I $G(ORIMLOC) M ORDIALOG(PROMPT,"LIST")=ORIMLOC 47 Q 48 LR ; setup environment for lab 49 ; -- setup ORTIME, ORIMTIME & ORTEST arrays 50 ; setup ORMAX, ORDG, & ORCOLLCT variables 51 N PROMPT,INST,EDITONLY 52 D GETIMES^ORCDLR1 ; sets up ORTIME and ORIMTIME arrays 53 S ORMAX=$$GET^XPAR("ALL^LOC.`"_+ORL,"LR MAX DAYS CONTINUOUS",1,"Q") 54 S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0)),INST=1 55 D LRTEST ; sets up ORTEST array and ORDG 56 S PROMPT=$O(^ORD(101.41,"AB","OR GTX COLLECTION TYPE",0)) 57 I $D(ORDIALOG(PROMPT,1)) S ORCOLLCT=ORDIALOG(PROMPT,1) I 1 58 E S EDITONLY=0,ORCOLLCT=$$COLLTYPE^ORCDLR1 59 I ORCOLLCT="I" D 60 . S PROMPT=$O(^ORD(101.41,"AB","OR GTX START DATE/TIME",0)) 61 . D LRICTMOK 62 S PROMPT=$O(^ORD(101.41,"AB","OR GTX ADMIN SCHEDULE",0)) 63 I $D(ORDIALOG(PROMPT,1)) S ORSCH=ORDIALOG(PROMPT,1) 64 Q 65 LRTEST ; -- Setup ORTEST() array of ordering parameters (copied from ORCDLR) 66 N OI,TST,DG 67 S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI 68 I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST 69 S DG=$P($G(^ORD(101.43,+OI,"LR")),U,6) S:'$L(DG) DG="LAB" 70 S DG=$O(^ORD(100.98,"B",DG,0)) S:DG ORDG=DG 71 Q 72 LRRQCM() ; return true if lab test has required comments 73 I $O(^TMP("ORWORD",$J,PROMPT,INST,0)) Q 1 ; edit via WP 74 N LRTEST,LRSAMP,LRSPEC,LRTSTN,LRTCOM,LRCCOM,DA,CNT,I,REQDCOMM,OI,TST 75 S LRSAMP=$$VAL^ORCD("COLLECTION SAMPLE"),LRSPEC=$$VAL^ORCD("SPECIMEN") 76 S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI 0 77 I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST 78 S LRTSTN=1,LRTEST(1)=+ORTEST,DA=$O(^LAB(60,LRTEST(1),3,"B",+LRSAMP,0)) 79 S REQDCOMM=$P($G(^LAB(60,LRTEST(1),3,+DA,0)),U,6) 80 S:'REQDCOMM REQDCOMM=+$P($G(^LAB(60,LRTEST(1),0)),U,19) 81 Q REQDCOMM 82 LRASMP() ; return true to ask collection sample (from ASKSAMP^ORCDLR) 83 N DEFSAMP,SAMP0 84 S DEFSAMP=$G(ORDIALOG(PROMPT,INST)),SAMP0=$G(^LAB(62,+DEFSAMP,0)) 85 I (ORCOLLCT="LC")!(ORCOLLCT="I"),$G(ORTEST("Lab CollSamp")) Q 0 86 I $G(ORTEST("Unique CollSamp")),DEFSAMP Q 0 ; unique -> don't ask 87 I 'DEFSAMP!('FIRST) Q 1 ; no default or edit -> ask 88 I $G(ORDIALOG(PROMPT,"LIST"))="1^1" Q 0 ; only one choice 89 Q 1 90 LRICTMOK ; 91 Q:'$D(ORDIALOG(PROMPT,1)) 92 N ORY 93 D VALDT^ORWU(.ORY,ORDIALOG(PROMPT,1)) 94 I +$$VALID^LR7OV4(DUZ(2),ORY)=0 S ORDIALOG(PROMPT,1)="" 95 Q 96 DO ; setup environment for diet order 97 ; partially copied from EN^ORCDFH 98 I ORCAT'="I" D Q 99 . S ORQUIT=1 100 . S LST(0)="8^0" 101 . S LST(.5)="This type of diet may be entered for inpatients only." 102 D EN^FHWOR8(+ORVP,.ORPARAM) ; set FH ordering parameters 103 S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now 104 N PROMPT,OI ; set NPO flag if NPO diet 105 S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0)) 106 S OI=+$G(ORDIALOG(PROMPT,1)) 107 S ORNPO=($P($G(^ORD(101.43,OI,0)),U)="NPO") 108 Q 109 EL ; setup environment for early/late tray 110 D EN^FHWOR8(+ORVP,.ORPARAM) ; set FH ordering parameters 111 S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now 112 D EN2^ORCDFH ; setup ORTIME array 113 N PROMPT ; set ORMEAL,ORTRAY 114 S PROMPT=$O(^ORD(101.41,"AB","OR GTX MEAL",0)) 115 I $D(ORDIALOG(PROMPT,1)) S ORMEAL=ORDIALOG(PROMPT,1) 116 S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0)) 117 I $D(ORDIALOG(PROMPT,1)) S ORTRAY=ORDIALOG(PROMPT,1) 118 Q 119 UD ; setup environment for unit dose med 120 I $G(ORWP94) G PS^ORWDPS3 ; if patch 94 installed 121 ; 122 D AUTHMED Q:$G(ORQUIT) ; checks authorized to write meds 123 N PROMPT,OI 124 S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0)) 125 I $D(ORDIALOG(PROMPT,1)) S OI=ORDIALOG(PROMPT,1) D MEDACTV(1) Q:$G(ORQUIT) 126 D INSTR^ORCDPS(OI) ; sets up instructions, routes, etc. 127 D CHOICES^ORCDPS("U") ; gets list of dispense drugs 128 Q 129 IV ; setup environment for IV fluid 130 D AUTHMED Q:$G(ORQUIT) ; checks authorized to write meds 131 ; sets up list of volumes if only one solution 132 ; otherwise, let the dialog go interactive 133 N PROMPT,INST,CNT,OI 134 S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0)) 135 S (CNT,INST)=0 136 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST D Q:$G(ORQUIT) 137 . S CNT=CNT+1 138 . S OI=ORDIALOG(PROMPT,INST) D MEDACTV(3) ; check active solutions 139 I CNT=1 S INST=1 D VOLUME^ORCDPSIV 140 S PROMPT=$O(^ORD(101.41,"AB","OR GTX ADDITIVE",0)) 141 S INST=0 142 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST D Q:$G(ORQUIT) 143 . S OI=ORDIALOG(PROMPT,INST) D MEDACTV(4) ; check active additives 144 Q 145 OP ; setup environment for outpatient pharmacy 146 I $G(ORWP94) G PS^ORWDPS3 ; if patch 94 installed 147 ; 148 D AUTHMED Q:$G(ORQUIT) ; checks authorized to write meds 149 N PROMPT,INST,CNT,OI 150 S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0)),OI=0 151 I $D(ORDIALOG(PROMPT,1)) S OI=$G(ORDIALOG(PROMPT,1)) D MEDACTV(2) Q:$G(ORQUIT) 152 D:+OI INSTR^ORCDPS(OI) ; sets up instructions, routes, etc. 153 D CHOICES^ORCDPS("O") ; gets list of dispense drugs 154 ; get defaults for drug, refills if only one dispense drug 155 S PROMPT=$O(^ORD(101.41,"AB","OR GTX DISPENSE DRUG",0)) 156 S (CNT,INST)=0 157 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST S CNT=CNT+1 158 I CNT=1 D 159 . S ORDRUG=+$G(ORDIALOG(PROMPT,1)),ORCOMPLX=0 160 . S OREFILLS=$P($G(ORDIALOG(PROMPT,"LIST","D",ORDRUG)),U,3) 161 . S:'$L(OREFILLS) OREFILLS=11 162 E S ORCOMPLX=1,OREFILLS=11 ; force interactive on complex order 163 S ORCOPAY=1 ; ask SC if can't determine copay 164 I $G(ORDRUG),$L($T(ASKSC^ORCDPS)) S ORCOPAY=$$ASKSC^ORCDPS 165 Q 166 AUTHMED ; sets ORQUIT if not authorized to write meds 167 N NOAUTH,NAME 168 D AUTH^ORWDPS32(.NOAUTH,ORNP) 169 I +NOAUTH D 170 . S ORQUIT=1 171 . S LST(0)="8^0" 172 . S NAME=$P($G(^VA(200,+ORNP,20)),U,2) 173 . I '$L(NAME) S NAME=$P($G(^VA(200,+ORNP,0)),U,1) 174 . S LST(.5)=NAME_" is not authorized to write med orders." 175 Q 176 MEDACTV(USAGE) ; sets ORQUIT if the orderable item is not active for a med 177 Q:'$G(OI) S USAGE=+$G(USAGE) 178 I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D Q 179 . S ORQUIT=1,LST(0)="8^0" 180 . S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" has been inactivated and may not be ordered anymore." 181 I USAGE,'$P($G(^ORD(101.43,OI,"PS")),U,USAGE) D Q 182 . S ORQUIT=1,LST(0)="8^0" 183 . S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" may not be ordered as an "_$S(USAGE=1:"inpatient medication",USAGE=2:"outpatient medication",USAGE=3:"IV solution",1:"IV additive")_" anymore." 184 Q 185 SCHEDULD() ; Is patient scheduled for PREOP (Imaging) 186 I $G(ORDIALOG(PROMPT,1)) Q 1 ; don't ask - already have date 187 E Q 0 188 Q
Note:
See TracChangeset
for help on using the changeset viewer.
