- 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/ORCHECK.m
r613 r623 1 ORCHECK ;SLC/MKB-Order checking calls ; 08 May 2002 2:12 PM [8/16/05 5:28am] 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,56,70,94,141,215,243**;Dec 17, 1997;Build 242 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 DISPLAY ; -- DISPLAY event [called from ORCDLG,ORCACT4,ORCMED] 5 ; Expects ORVP, ORNMSP, ORTAB, [ORWARD] 6 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" 7 N ORX,ORY,I 8 I ORNMSP="PS" D ;reset to PSJ, PSJI, or PSO 9 . I $G(ORDG) S I=$P($G(^ORD(100.98,+ORDG,0)),U,3),I=$P(I," ") Q:'$L(I) S ORNMSP="PS"_$S(I="UD":"I",1:I) Q 10 . I $G(ORXFER) S I=$P($P(^TMP("OR",$J,ORTAB,0),U,3),";",3) S:I="" I=$G(ORWARD) S ORNMSP="PS"_$S(I:"O",1:"I") ;opposite of list 11 S ORX(1)="|"_ORNMSP,ORX=1 12 D EN^ORKCHK(.ORY,+ORVP,.ORX,"DISPLAY") Q:'$D(ORY) 13 S I=0 F S I=$O(ORY(I)) Q:I'>0 W !,$P(ORY(I),U,4) ; display only 14 Q 15 ; 16 SELECT ; -- SELECT event 17 ; Expects ORVP, ORDAILOG(PROMPT,ORI), ORNMSP 18 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" 19 N ORX,ORY,OI 20 S OI=+$G(ORDIALOG(PROMPT,ORI)) 21 S ORX=1,ORX(1)=OI_"|"_ORNMSP_"|"_$$USID^ORMBLD(OI) 22 D EN^ORKCHK(.ORY,+ORVP,.ORX,"SELECT"),RETURN:$D(ORY) 23 Q 24 ; 25 ACCEPT(MODE) ; -- ACCEPT event [called from ORCDLG,ORCACT4,ORCMED] 26 ; Expects ORVP, ORDIALOG(), ORNMSP 27 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" 28 N ORX,ORY,ORZ,OI,ORSTRT,ORI,ORIT,ORID,ORSP 29 S:'$L($G(MODE)) MODE="ACCEPT" 30 S OI=$$PTR^ORCD("OR GTX ORDERABLE ITEM"),ORSTRT=$$START,ORX=0 31 S ORI=0 F S ORI=$O(ORDIALOG(OI,ORI)) Q:ORI'>0 D STUF 32 I $G(ORDG)=+$O(^ORD(100.98,"B","IV RX",0)) S OI=$$PTR^ORCD("OR GTX ADDITIVE"),ORI=0 F S ORI=$O(ORDIALOG(OI,ORI)) Q:ORI'>0 D STUF 33 D EN^ORKCHK(.ORY,+ORVP,.ORX,MODE),RETURN:$D(ORY) 34 Q 35 STUF S ORIT=ORDIALOG(OI,ORI),ORSP="" 36 S:ORNMSP="LR" ORSP=+$G(ORDIALOG($$PTR^ORCD("OR GTX SPECIMEN"),ORI)) 37 S ORID=$S($E(ORNMSP,1,2)="PS":$$DRUG(ORIT,OI),1:$$USID^ORMBLD(ORIT)) 38 S ORZ=1,ORZ(1)=ORIT_"|"_ORNMSP_"|"_ORID 39 I MODE'="ALL" D EN^ORKCHK(.ORY,+ORVP,.ORZ,"SELECT"),RETURN:$D(ORY) 40 S ORX=ORX+1,ORX(ORX)=ORZ(1)_"|"_ORSTRT_"||"_ORSP K ORY,ORZ 41 Q 42 ; 43 DELAY(MODE) ; -- Delayed ACCEPT event [called from ORMEVNT] 44 ; Expects ORVP, ORIFN 45 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" 46 N ORX,ORY,ORCHECK S:'$L($G(MODE)) MODE="NOTIF" 47 D BLD(+ORIFN),EN^ORKCHK(.ORY,+ORVP,.ORX,MODE) Q:'$D(ORY) 48 D RETURN I MODE="NOTIF" S ORCHECK("OK")="Notification sent to provider" D OC^ORCSAVE2 Q ; silent 49 Q 50 ; 51 SESSION ; -- SESSION event [called from ORCSIGN] 52 ; Expects ORVP, ORES() 53 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" 54 N ORX,ORY,ORIFN,I,X,Y 55 S ORIFN=0 F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 I +$P(ORIFN,";",2)'>1 D 56 . I "^5^6^10^11^"'[(U_$P($G(^OR(100,+ORIFN,3)),U,3)_U) Q ;unreleased 57 . D BLD(+ORIFN) Q:'$D(^OR(100,+ORIFN,9)) 58 . S ORCHECK("IFN")=+$G(ORCHECK("IFN"))+1 59 . S I=0 F S I=$O(^OR(100,+ORIFN,9,I)) Q:I'>0 S X=$G(^(I,0)),Y=$G(^(1)),ORCHECK=+$G(ORCHECK)+1,ORCHECK(+ORIFN,$S($P(X,U,2):$P(X,U,2),1:99),ORCHECK)=$P(X,U,1,2)_U_Y 60 I $D(ORX) D EN^ORKCHK(.ORY,+ORVP,.ORX,"SESSION"),RETURN:$D(ORY),REMDUPS 61 Q 62 ; 63 BLD(ORDER) ; -- Build new ORX(#) for ORDER 64 Q:'$G(ORDER) Q:'$D(^OR(100,ORDER,0)) ;Q:$P($G(^(3)),U,11) ;edit/renew 65 N PKG,START,ORI,ITEM,USID,SPEC,ORDG,PTR,INST 66 S ORDG=$P(^OR(100,ORDER,0),U,11),PKG=$$GET1^DIQ(9.4,$P(^(0),U,14)_",",1) 67 I PKG="PS",$G(ORDG) S ORI=$P($G(^ORD(100.98,+ORDG,0)),U,3),ORI=$P(ORI," "),PKG=PKG_$S(ORI="UD":"I",1:ORI) 68 S START=$$START(ORDER),ORI=0 69 F S ORI=$O(^OR(100,ORDER,4.5,"ID","ORDERABLE",ORI)) Q:ORI'>0 D 70 . S INST=$P($G(^OR(100,ORDER,4.5,ORI,0)),U,3),PTR=$P($G(^(0)),U,2),ITEM=+$G(^(1)) 71 . S USID=$S(PKG?1"PS".E:$$DRUG(ITEM,PTR,ORDER),1:$$USID^ORMBLD(ITEM)) 72 . S SPEC=$S(PKG="LR":$$VALUE^ORCSAVE2(ORDER,"SPECIMEN",INST),1:"") 73 . S ORX=+$G(ORX)+1,ORX(ORX)=ITEM_"|"_PKG_"|"_USID_"|"_START_"|"_ORDER_"|"_SPEC 74 Q 75 ; 76 RETURN ; -- Return checks in ORCHECK(ORIFN,CDL,#) 77 N I,IFN,CDL S I=0 F S I=$O(ORY(I)) Q:I'>0 D 78 . S IFN=+$P(ORY(I),U) S:'IFN IFN="NEW" 79 . S CDL=+$P(ORY(I),U,3) S:'CDL CDL=99 80 . S:'$D(ORCHECK(IFN)) ORCHECK("IFN")=+$G(ORCHECK("IFN"))+1 ; count 81 . S ORCHECK=+$G(ORCHECK)+1,ORCHECK(IFN,CDL,ORCHECK)=$P(ORY(I),U,2,4) 82 Q 83 ; 84 REMDUPS ; 85 N IFN,CDL,I 86 S IFN=0 F S IFN=$O(ORCHECK(IFN)) Q:'IFN D 87 . S CDL=0 F S CDL=$O(ORCHECK(IFN,CDL)) Q:'CDL D 88 . . S I=0 F S I=$O(ORCHECK(IFN,CDL,I)) Q:'I D 89 . . . S J=I F S J=$O(ORCHECK(IFN,CDL,J)) Q:'J I $G(ORCHECK(IFN,CDL,I))=$G(ORCHECK(IFN,CDL,J)) K ORCHECK(IFN,CDL,J) S ORCHECK=$G(ORCHECK)-1 90 Q 91 START(DA) ; -- Returns start date/time 92 N I,X,Y,%DT S Y="" 93 I $G(DA) S X=$O(^OR(100,DA,4.5,"ID","START",0)),X=$G(^OR(100,DA,4.5,+X,1)) 94 E D ; look in ORDIALOG instead 95 . S I=0 F S I=$O(ORDIALOG(I)) Q:I'>0 Q:$P(ORDIALOG(I),U,2)="START" 96 . S X=$S(I:$G(ORDIALOG(I,1)),1:"") 97 D AM^ORCSAVE2:X="AM",NEXT^ORCSAVE2:X="NEXT" 98 D ADMIN^ORCSAVE2("NEXT"):X="NEXTA",ADMIN^ORCSAVE2("CLOSEST"):X="CLOSEST" 99 I $L(X) S %DT="TX" D ^%DT S:Y'>0 Y="" 100 Q Y 101 ; 102 DRUG(OI,PTR,IFN) ; -- Returns 6 ^-piece identifier for Dispense Drug 103 N ORDD,ORNDF,Y 104 I ORDG=+$O(^ORD(100.98,"B","IV RX",0)) S ORDD=$$IV G D1 105 I $G(IFN) S ORDD=$O(^OR(100,IFN,4.5,"ID","DRUG",0)),ORDD=+$G(^OR(100,IFN,4.5,+ORDD,1)) 106 E S ORDD=+$G(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1)) 107 D1 Q:'ORDD "" S ORNDF=$$ENDCM^PSJORUTL(ORDD) 108 S Y=$P(ORNDF,U,3)_"^^99NDF^"_ORDD_U_$$NAME50^ORPEAPI(ORDD)_"^99PSD" 109 Q Y 110 ; 111 IV() ; -- Get Dispense Drug for IV orderable 112 N PSOI,TYPE,VOL,ORY 113 S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2),VOL="" 114 S TYPE=$S(PTR=$$PTR^ORCD("OR GTX ADDITIVE"):"A",1:"B") 115 S:TYPE="B" VOL=$S($G(IFN):$$VALUE^ORCSAVE2(IFN,"VOLUME"),1:+$G(ORDIALOG($$PTR^ORCD("OR GTX VOLUME"),1))) 116 D ENDDIV^PSJORUTL(PSOI,TYPE,VOL,.ORY) 117 Q +$G(ORY) 118 ; 119 LIST(IFN) ; -- Displays list of ORCHECK(IFN) checks 120 N ORI,ORJ,ORZ,ORMAX,ORTX,ON,OFF 121 S ORZ=0 F S ORZ=$O(ORCHECK(IFN,ORZ)) Q:ORZ'>0 D 122 . S:ORZ=1 ON=IOINHI,OFF=IOINORM S:ORZ'=1 (ON,OFF)="" ; use bold if High 123 . S ORI=0 F S ORI=$O(ORCHECK(IFN,ORZ,ORI)) Q:ORI'>0 D 124 . . S X=$P(ORCHECK(IFN,ORZ,ORI),U,3) I $L(X)<75 W !,ON_">>> "_X_OFF Q 125 . . S ORMAX=74 K ORTX D TXT^ORCHTAB Q:'$G(ORTX) ; wrap 126 . . F ORJ=1:1:ORTX W !,ON_$S(ORJ=1:">>> ",1:" ")_ORTX(ORJ)_OFF 127 W ! 128 Q 129 ; 130 CANCEL() ; -- Returns 1 or 0: Cancel order(s)? 131 N X,Y,DIR,NUM 132 S NUM=+$G(ORCHECK("IFN")),DIR(0)="YA" 133 S DIR("A")="Do you want to cancel "_$S(NUM>1:"any of the new orders? ",1:"the new order? ") 134 S DIR("?",1)="Enter YES to cancel "_$S(NUM>1:"an",1:"the")_" order. If you wish to override these order checks" 135 S DIR("?",2)="and release "_$S(NUM>1:"these orders",1:"this order")_", enter NO; you will be prompted for a justification",DIR("?")="if there are any highlighted critical order checks." 136 D ^DIR 137 Q +Y 138 ; 139 REASON() ; -- Reason for overriding order checks 140 ; I '$D(^XUSEC("ORES",DUZ)),'$D(^XUSEC("ORELSE",DUZ)) Q ?? 141 N X,Y,DIR 142 S DIR(0)="FA^2:80^K:X?1."" "" X",DIR("A")="REASON FOR OVERRIDE: " 143 S DIR("?")="Enter a justification for overriding these order checks, up to 80 characters" 144 D ^DIR I $D(DTOUT)!$D(DUOUT) S Y="^" 145 Q Y 146 OCAPI(IFN,ORPLACE) ;IA #4859 147 ;API to get the order checking info for a specific order (IFN) 148 ;info is stored in ^TMP($J,ORPLACE) 149 ; ^TMP($J,ORPLACE,D0,"OC LEVEL")="order check level" 150 ; ,"OC TEXT")="order check text" 151 ; ,"OR REASON")="over ride reason text" 152 ; ,"OR PROVIDER")="provider DUZ who entered over ride reason" 153 ; ,"OR DT")="date/time over ride reason was entered" 154 ; NOTE on OC LEVEL: 1 is HIGH, 2 is MODERATE, 3 is LOW 155 I '$D(^OR(100,IFN,9)) Q 156 N I 157 S I=0 F S I=$O(^OR(100,IFN,9,I)) Q:'I D 158 .S ^TMP($J,ORPLACE,I,"OC LEVEL")=$P($G(^OR(100,IFN,9,I,0)),U,2) 159 .S ^TMP($J,ORPLACE,I,"OC TEXT")=$G(^OR(100,IFN,9,I,1)) 160 .S ^TMP($J,ORPLACE,I,"OR REASON")=$P($G(^OR(100,IFN,9,I,0)),U,4) 161 .S ^TMP($J,ORPLACE,I,"OR PROVIDER")=$P($G(^OR(100,IFN,9,I,0)),U,5) 162 .S ^TMP($J,ORPLACE,I,"OR DT")=$P($G(^OR(100,IFN,9,I,0)),U,6) 163 Q 1 ORCHECK ;SLC/MKB-Order checking calls ; 08 May 2002 2:12 PM [8/16/05 5:28am] 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,56,70,94,141,215**;Dec 17, 1997 3 DISPLAY ; -- DISPLAY event [called from ORCDLG,ORCACT4,ORCMED] 4 ; Expects ORVP, ORNMSP, ORTAB, [ORWARD] 5 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" 6 N ORX,ORY,I 7 I ORNMSP="PS" D ;reset to PSJ, PSJI, or PSO 8 . I $G(ORDG) S I=$P($G(^ORD(100.98,+ORDG,0)),U,3),I=$P(I," ") Q:'$L(I) S ORNMSP="PS"_$S(I="UD":"I",1:I) Q 9 . I $G(ORXFER) S I=$P($P(^TMP("OR",$J,ORTAB,0),U,3),";",3) S:I="" I=$G(ORWARD) S ORNMSP="PS"_$S(I:"O",1:"I") ;opposite of list 10 S ORX(1)="|"_ORNMSP,ORX=1 11 D EN^ORKCHK(.ORY,+ORVP,.ORX,"DISPLAY") Q:'$D(ORY) 12 S I=0 F S I=$O(ORY(I)) Q:I'>0 W !,$P(ORY(I),U,4) ; display only 13 Q 14 ; 15 SELECT ; -- SELECT event 16 ; Expects ORVP, ORDAILOG(PROMPT,ORI), ORNMSP 17 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" 18 N ORX,ORY,OI 19 S OI=+$G(ORDIALOG(PROMPT,ORI)) 20 S ORX=1,ORX(1)=OI_"|"_ORNMSP_"|"_$$USID^ORMBLD(OI) 21 D EN^ORKCHK(.ORY,+ORVP,.ORX,"SELECT"),RETURN:$D(ORY) 22 Q 23 ; 24 ACCEPT(MODE) ; -- ACCEPT event [called from ORCDLG,ORCACT4,ORCMED] 25 ; Expects ORVP, ORDIALOG(), ORNMSP 26 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" 27 N ORX,ORY,ORZ,OI,ORSTRT,ORI,ORIT,ORID,ORSP 28 S:'$L($G(MODE)) MODE="ACCEPT" 29 S OI=$$PTR^ORCD("OR GTX ORDERABLE ITEM"),ORSTRT=$$START,ORX=0 30 S ORI=0 F S ORI=$O(ORDIALOG(OI,ORI)) Q:ORI'>0 D STUF 31 I $G(ORDG)=+$O(^ORD(100.98,"B","IV RX",0)) S OI=$$PTR^ORCD("OR GTX ADDITIVE"),ORI=0 F S ORI=$O(ORDIALOG(OI,ORI)) Q:ORI'>0 D STUF 32 D EN^ORKCHK(.ORY,+ORVP,.ORX,MODE),RETURN:$D(ORY) 33 Q 34 STUF S ORIT=ORDIALOG(OI,ORI),ORSP="" 35 S:ORNMSP="LR" ORSP=+$G(ORDIALOG($$PTR^ORCD("OR GTX SPECIMEN"),ORI)) 36 S ORID=$S($E(ORNMSP,1,2)="PS":$$DRUG(ORIT,OI),1:$$USID^ORMBLD(ORIT)) 37 S ORZ=1,ORZ(1)=ORIT_"|"_ORNMSP_"|"_ORID 38 I MODE'="ALL" D EN^ORKCHK(.ORY,+ORVP,.ORZ,"SELECT"),RETURN:$D(ORY) 39 S ORX=ORX+1,ORX(ORX)=ORZ(1)_"|"_ORSTRT_"||"_ORSP K ORY,ORZ 40 Q 41 ; 42 DELAY(MODE) ; -- Delayed ACCEPT event [called from ORMEVNT] 43 ; Expects ORVP, ORIFN 44 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" 45 N ORX,ORY,ORCHECK S:'$L($G(MODE)) MODE="NOTIF" 46 D BLD(+ORIFN),EN^ORKCHK(.ORY,+ORVP,.ORX,MODE) Q:'$D(ORY) 47 D RETURN I MODE="NOTIF" S ORCHECK("OK")="Notification sent to provider" D OC^ORCSAVE2 Q ; silent 48 Q 49 ; 50 SESSION ; -- SESSION event [called from ORCSIGN] 51 ; Expects ORVP, ORES() 52 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" 53 N ORX,ORY,ORIFN,I,X,Y 54 S ORIFN=0 F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 I +$P(ORIFN,";",2)'>1 D 55 . I "^5^6^10^11^"'[(U_$P($G(^OR(100,+ORIFN,3)),U,3)_U) Q ;unreleased 56 . D BLD(+ORIFN) Q:'$D(^OR(100,+ORIFN,9)) 57 . S ORCHECK("IFN")=+$G(ORCHECK("IFN"))+1 58 . S I=0 F S I=$O(^OR(100,+ORIFN,9,I)) Q:I'>0 S X=$G(^(I,0)),Y=$G(^(1)),ORCHECK=+$G(ORCHECK)+1,ORCHECK(+ORIFN,$S($P(X,U,2):$P(X,U,2),1:99),ORCHECK)=$P(X,U,1,2)_U_Y 59 I $D(ORX) D EN^ORKCHK(.ORY,+ORVP,.ORX,"SESSION"),RETURN:$D(ORY),REMDUPS 60 Q 61 ; 62 BLD(ORDER) ; -- Build new ORX(#) for ORDER 63 Q:'$G(ORDER) Q:'$D(^OR(100,ORDER,0)) ;Q:$P($G(^(3)),U,11) ;edit/renew 64 N PKG,START,ORI,ITEM,USID,SPEC,ORDG,PTR,INST 65 S ORDG=$P(^OR(100,ORDER,0),U,11),PKG=$$GET1^DIQ(9.4,$P(^(0),U,14)_",",1) 66 I PKG="PS",$G(ORDG) S ORI=$P($G(^ORD(100.98,+ORDG,0)),U,3),ORI=$P(ORI," "),PKG=PKG_$S(ORI="UD":"I",1:ORI) 67 S START=$$START(ORDER),ORI=0 68 F S ORI=$O(^OR(100,ORDER,4.5,"ID","ORDERABLE",ORI)) Q:ORI'>0 D 69 . S INST=$P($G(^OR(100,ORDER,4.5,ORI,0)),U,3),PTR=$P($G(^(0)),U,2),ITEM=+$G(^(1)) 70 . S USID=$S(PKG?1"PS".E:$$DRUG(ITEM,PTR,ORDER),1:$$USID^ORMBLD(ITEM)) 71 . S SPEC=$S(PKG="LR":$$VALUE^ORCSAVE2(ORDER,"SPECIMEN",INST),1:"") 72 . S ORX=+$G(ORX)+1,ORX(ORX)=ITEM_"|"_PKG_"|"_USID_"|"_START_"|"_ORDER_"|"_SPEC 73 Q 74 ; 75 RETURN ; -- Return checks in ORCHECK(ORIFN,CDL,#) 76 N I,IFN,CDL S I=0 F S I=$O(ORY(I)) Q:I'>0 D 77 . S IFN=+$P(ORY(I),U) S:'IFN IFN="NEW" 78 . S CDL=+$P(ORY(I),U,3) S:'CDL CDL=99 79 . S:'$D(ORCHECK(IFN)) ORCHECK("IFN")=+$G(ORCHECK("IFN"))+1 ; count 80 . S ORCHECK=+$G(ORCHECK)+1,ORCHECK(IFN,CDL,ORCHECK)=$P(ORY(I),U,2,4) 81 Q 82 ; 83 REMDUPS ; 84 N IFN,CDL,I 85 S IFN=0 F S IFN=$O(ORCHECK(IFN)) Q:'IFN D 86 . S CDL=0 F S CDL=$O(ORCHECK(IFN,CDL)) Q:'CDL D 87 . . S I=0 F S I=$O(ORCHECK(IFN,CDL,I)) Q:'I D 88 . . . S J=I F S J=$O(ORCHECK(IFN,CDL,J)) Q:'J I $G(ORCHECK(IFN,CDL,I))=$G(ORCHECK(IFN,CDL,J)) K ORCHECK(IFN,CDL,J) S ORCHECK=$G(ORCHECK)-1 89 Q 90 START(DA) ; -- Returns start date/time 91 N I,X,Y,%DT S Y="" 92 I $G(DA) S X=$O(^OR(100,DA,4.5,"ID","START",0)),X=$G(^OR(100,DA,4.5,+X,1)) 93 E D ; look in ORDIALOG instead 94 . S I=0 F S I=$O(ORDIALOG(I)) Q:I'>0 Q:$P(ORDIALOG(I),U,2)="START" 95 . S X=$S(I:$G(ORDIALOG(I,1)),1:"") 96 D AM^ORCSAVE2:X="AM",NEXT^ORCSAVE2:X="NEXT" 97 D ADMIN^ORCSAVE2("NEXT"):X="NEXTA",ADMIN^ORCSAVE2("CLOSEST"):X="CLOSEST" 98 I $L(X) S %DT="TX" D ^%DT S:Y'>0 Y="" 99 Q Y 100 ; 101 DRUG(OI,PTR,IFN) ; -- Returns 6 ^-piece identifier for Dispense Drug 102 N ORDD,ORNDF,Y 103 I ORDG=+$O(^ORD(100.98,"B","IV RX",0)) S ORDD=$$IV G D1 104 I $G(IFN) S ORDD=$O(^OR(100,IFN,4.5,"ID","DRUG",0)),ORDD=+$G(^OR(100,IFN,4.5,+ORDD,1)) 105 E S ORDD=+$G(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1)) 106 D1 Q:'ORDD "" S ORNDF=$$ENDCM^PSJORUTL(ORDD) 107 S Y=$P(ORNDF,U,3)_"^^99NDF^"_ORDD_U_$P($G(^PSDRUG(ORDD,0)),U)_"^99PSD" 108 Q Y 109 ; 110 IV() ; -- Get Dispense Drug for IV orderable 111 N PSOI,TYPE,VOL,ORY 112 S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2),VOL="" 113 S TYPE=$S(PTR=$$PTR^ORCD("OR GTX ADDITIVE"):"A",1:"B") 114 S:TYPE="B" VOL=$S($G(IFN):$$VALUE^ORCSAVE2(IFN,"VOLUME"),1:+$G(ORDIALOG($$PTR^ORCD("OR GTX VOLUME"),1))) 115 D ENDDIV^PSJORUTL(PSOI,TYPE,VOL,.ORY) 116 Q +$G(ORY) 117 ; 118 LIST(IFN) ; -- Displays list of ORCHECK(IFN) checks 119 N ORI,ORJ,ORZ,ORMAX,ORTX,ON,OFF 120 S ORZ=0 F S ORZ=$O(ORCHECK(IFN,ORZ)) Q:ORZ'>0 D 121 . S:ORZ=1 ON=IOINHI,OFF=IOINORM S:ORZ'=1 (ON,OFF)="" ; use bold if High 122 . S ORI=0 F S ORI=$O(ORCHECK(IFN,ORZ,ORI)) Q:ORI'>0 D 123 . . S X=$P(ORCHECK(IFN,ORZ,ORI),U,3) I $L(X)<75 W !,ON_">>> "_X_OFF Q 124 . . S ORMAX=74 K ORTX D TXT^ORCHTAB Q:'$G(ORTX) ; wrap 125 . . F ORJ=1:1:ORTX W !,ON_$S(ORJ=1:">>> ",1:" ")_ORTX(ORJ)_OFF 126 W ! 127 Q 128 ; 129 CANCEL() ; -- Returns 1 or 0: Cancel order(s)? 130 N X,Y,DIR,NUM 131 S NUM=+$G(ORCHECK("IFN")),DIR(0)="YA" 132 S DIR("A")="Do you want to cancel "_$S(NUM>1:"any of the new orders? ",1:"the new order? ") 133 S DIR("?",1)="Enter YES to cancel "_$S(NUM>1:"an",1:"the")_" order. If you wish to override these order checks" 134 S DIR("?",2)="and release "_$S(NUM>1:"these orders",1:"this order")_", enter NO; you will be prompted for a justification",DIR("?")="if there are any highlighted critical order checks." 135 D ^DIR 136 Q +Y 137 ; 138 REASON() ; -- Reason for overriding order checks 139 ; I '$D(^XUSEC("ORES",DUZ)),'$D(^XUSEC("ORELSE",DUZ)) Q ?? 140 N X,Y,DIR 141 S DIR(0)="FA^2:80^K:X?1."" "" X",DIR("A")="REASON FOR OVERRIDE: " 142 S DIR("?")="Enter a justification for overriding these order checks, up to 80 characters" 143 D ^DIR I $D(DTOUT)!$D(DUOUT) S Y="^" 144 Q Y
Note:
See TracChangeset
for help on using the changeset viewer.
