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
|
---|