ORCHECK ;SLC/MKB-Order checking calls ;23-Nov-2011 11:55;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,56,70,94,141,1005,215,243,1010**;Dec 17, 1997;Build 47
;;Per VHA Directive 2004-038, this routine should not be modified.
DISPLAY ; -- DISPLAY event [called from ORCDLG,ORCACT4,ORCMED]
; Expects ORVP, ORNMSP, ORTAB, [ORWARD]
Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
N ORX,ORY,I
I ORNMSP="PS" D ;reset to PSJ, PSJI, or PSO
. 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
. 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
S ORX(1)="|"_ORNMSP,ORX=1
D EN^ORKCHK(.ORY,+ORVP,.ORX,"DISPLAY") Q:'$D(ORY)
S I=0 F S I=$O(ORY(I)) Q:I'>0 W !,$P(ORY(I),U,4) ; display only
Q
;
SELECT ; -- SELECT event
; Expects ORVP, ORDAILOG(PROMPT,ORI), ORNMSP
Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
N ORX,ORY,OI
S OI=+$G(ORDIALOG(PROMPT,ORI))
S ORX=1,ORX(1)=OI_"|"_ORNMSP_"|"_$$USID^ORMBLD(OI)
D EN^ORKCHK(.ORY,+ORVP,.ORX,"SELECT"),RETURN:$D(ORY)
Q
;
ACCEPT(MODE) ; -- ACCEPT event [called from ORCDLG,ORCACT4,ORCMED]
; Expects ORVP, ORDIALOG(), ORNMSP
Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
N ORX,ORY,ORZ,OI,ORSTRT,ORI,ORIT,ORID,ORSP
S:'$L($G(MODE)) MODE="ACCEPT"
S OI=$$PTR^ORCD("OR GTX ORDERABLE ITEM"),ORSTRT=$$START,ORX=0
S ORI=0 F S ORI=$O(ORDIALOG(OI,ORI)) Q:ORI'>0 D STUF
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
D EN^ORKCHK(.ORY,+ORVP,.ORX,MODE),RETURN:$D(ORY)
Q
STUF S ORIT=ORDIALOG(OI,ORI),ORSP=""
S:ORNMSP="LR" ORSP=+$G(ORDIALOG($$PTR^ORCD("OR GTX SPECIMEN"),ORI))
S ORID=$S($E(ORNMSP,1,2)="PS":$$DRUG(ORIT,OI),1:$$USID^ORMBLD(ORIT))
S ORZ=1,ORZ(1)=ORIT_"|"_ORNMSP_"|"_ORID
I MODE'="ALL" D EN^ORKCHK(.ORY,+ORVP,.ORZ,"SELECT"),RETURN:$D(ORY)
S ORX=ORX+1,ORX(ORX)=ORZ(1)_"|"_ORSTRT_"||"_ORSP K ORY,ORZ
Q
;
DELAY(MODE) ; -- Delayed ACCEPT event [called from ORMEVNT]
; Expects ORVP, ORIFN
Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
N ORX,ORY,ORCHECK S:'$L($G(MODE)) MODE="NOTIF"
D BLD(+ORIFN),EN^ORKCHK(.ORY,+ORVP,.ORX,MODE) Q:'$D(ORY)
D RETURN I MODE="NOTIF" S ORCHECK("OK")="Notification sent to provider" D OC^ORCSAVE2 Q ; silent
Q
;
SESSION ; -- SESSION event [called from ORCSIGN]
; Expects ORVP, ORES()
Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
N ORX,ORY,ORIFN,I,X,Y
S ORIFN=0 F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 I +$P(ORIFN,";",2)'>1 D
. I "^5^6^10^11^"'[(U_$P($G(^OR(100,+ORIFN,3)),U,3)_U) Q ;unreleased
. D BLD(+ORIFN) Q:'$D(^OR(100,+ORIFN,9))
. S ORCHECK("IFN")=+$G(ORCHECK("IFN"))+1
. 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
I $D(ORX) D EN^ORKCHK(.ORY,+ORVP,.ORX,"SESSION"),RETURN:$D(ORY),REMDUPS
Q
; IHS/MSC/DKM - Added following subroutine
MANUAL ; -- MANUAL event
; Expects ORVP, ORES()
Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
N ORX,ORY,ORIFN,I,X,Y
S ORIFN=0 F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 D
. D BLD(+ORIFN) ;Q:'$D(^OR(100,+ORIFN,9))
. S ORCHECK("IFN")=+$G(ORCHECK("IFN"))+1
I $D(ORX) D EN^ORKCHK(.ORY,+ORVP,.ORX,"MANUAL"),RETURN:$D(ORY)
Q
;
BLD(ORDER) ; -- Build new ORX(#) for ORDER
Q:'$G(ORDER) Q:'$D(^OR(100,ORDER,0)) ;Q:$P($G(^(3)),U,11) ;edit/renew
N PKG,START,ORI,ITEM,USID,SPEC,ORDG,PTR,INST
S ORDG=$P(^OR(100,ORDER,0),U,11),PKG=$$GET1^DIQ(9.4,$P(^(0),U,14)_",",1)
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)
S START=$$START(ORDER),ORI=0
F S ORI=$O(^OR(100,ORDER,4.5,"ID","ORDERABLE",ORI)) Q:ORI'>0 D
. S INST=$P($G(^OR(100,ORDER,4.5,ORI,0)),U,3),PTR=$P($G(^(0)),U,2),ITEM=+$G(^(1))
. S USID=$S(PKG?1"PS".E:$$DRUG(ITEM,PTR,ORDER),1:$$USID^ORMBLD(ITEM))
. S SPEC=$S(PKG="LR":$$VALUE^ORCSAVE2(ORDER,"SPECIMEN",INST),1:"")
. S ORX=+$G(ORX)+1,ORX(ORX)=ITEM_"|"_PKG_"|"_USID_"|"_START_"|"_ORDER_"|"_SPEC
Q
;
RETURN ; -- Return checks in ORCHECK(ORIFN,CDL,#)
N I,IFN,CDL S I=0 F S I=$O(ORY(I)) Q:I'>0 D
. S IFN=+$P(ORY(I),U) S:'IFN IFN="NEW"
. S CDL=+$P(ORY(I),U,3) S:'CDL CDL=99
. S:'$D(ORCHECK(IFN)) ORCHECK("IFN")=+$G(ORCHECK("IFN"))+1 ; count
. S ORCHECK=+$G(ORCHECK)+1,ORCHECK(IFN,CDL,ORCHECK)=$P(ORY(I),U,2,4)
Q
;
REMDUPS ;
N IFN,CDL,I
S IFN=0 F S IFN=$O(ORCHECK(IFN)) Q:'IFN D
. S CDL=0 F S CDL=$O(ORCHECK(IFN,CDL)) Q:'CDL D
. . S I=0 F S I=$O(ORCHECK(IFN,CDL,I)) Q:'I D
. . . 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
Q
START(DA) ; -- Returns start date/time
N I,X,Y,%DT S Y=""
I $G(DA) S X=$O(^OR(100,DA,4.5,"ID","START",0)),X=$G(^OR(100,DA,4.5,+X,1))
E D ; look in ORDIALOG instead
. S I=0 F S I=$O(ORDIALOG(I)) Q:I'>0 Q:$P(ORDIALOG(I),U,2)="START"
. S X=$S(I:$G(ORDIALOG(I,1)),1:"")
D AM^ORCSAVE2:X="AM",NEXT^ORCSAVE2:X="NEXT"
D ADMIN^ORCSAVE2("NEXT"):X="NEXTA",ADMIN^ORCSAVE2("CLOSEST"):X="CLOSEST"
I $L(X) S %DT="TX" D ^%DT S:Y'>0 Y=""
Q Y
;
DRUG(OI,PTR,IFN) ; -- Returns 6 ^-piece identifier for Dispense Drug
N ORDD,ORNDF,Y
I ORDG=+$O(^ORD(100.98,"B","IV RX",0)) S ORDD=$$IV G D1
I $G(IFN) S ORDD=$O(^OR(100,IFN,4.5,"ID","DRUG",0)),ORDD=+$G(^OR(100,IFN,4.5,+ORDD,1))
E S ORDD=+$G(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1))
D1 Q:'ORDD "" S ORNDF=$$ENDCM^PSJORUTL(ORDD)
S Y=$P(ORNDF,U,3)_"^^99NDF^"_ORDD_U_$$NAME50^ORPEAPI(ORDD)_"^99PSD"
Q Y
;
IV() ; -- Get Dispense Drug for IV orderable
N PSOI,TYPE,VOL,ORY
S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2),VOL=""
S TYPE=$S(PTR=$$PTR^ORCD("OR GTX ADDITIVE"):"A",1:"B")
S:TYPE="B" VOL=$S($G(IFN):$$VALUE^ORCSAVE2(IFN,"VOLUME"),1:+$G(ORDIALOG($$PTR^ORCD("OR GTX VOLUME"),1)))
D ENDDIV^PSJORUTL(PSOI,TYPE,VOL,.ORY)
Q +$G(ORY)
;
LIST(IFN) ; -- Displays list of ORCHECK(IFN) checks
N ORI,ORJ,ORZ,ORMAX,ORTX,ON,OFF
S ORZ=0 F S ORZ=$O(ORCHECK(IFN,ORZ)) Q:ORZ'>0 D
. S:ORZ=1 ON=IOINHI,OFF=IOINORM S:ORZ'=1 (ON,OFF)="" ; use bold if High
. S ORI=0 F S ORI=$O(ORCHECK(IFN,ORZ,ORI)) Q:ORI'>0 D
. . S X=$P(ORCHECK(IFN,ORZ,ORI),U,3) I $L(X)<75 W !,ON_">>> "_X_OFF Q
. . S ORMAX=74 K ORTX D TXT^ORCHTAB Q:'$G(ORTX) ; wrap
. . F ORJ=1:1:ORTX W !,ON_$S(ORJ=1:">>> ",1:" ")_ORTX(ORJ)_OFF
W !
Q
;
CANCEL() ; -- Returns 1 or 0: Cancel order(s)?
N X,Y,DIR,NUM
S NUM=+$G(ORCHECK("IFN")),DIR(0)="YA"
S DIR("A")="Do you want to cancel "_$S(NUM>1:"any of the new orders? ",1:"the new order? ")
S DIR("?",1)="Enter YES to cancel "_$S(NUM>1:"an",1:"the")_" order. If you wish to override these order checks"
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."
D ^DIR
Q +Y
;
REASON() ; -- Reason for overriding order checks
; I '$D(^XUSEC("ORES",DUZ)),'$D(^XUSEC("ORELSE",DUZ)) Q ??
N X,Y,DIR
S DIR(0)="FA^2:80^K:X?1."" "" X",DIR("A")="REASON FOR OVERRIDE: "
S DIR("?")="Enter a justification for overriding these order checks, up to 80 characters"
D ^DIR I $D(DTOUT)!$D(DUOUT) S Y="^"
Q Y
OCAPI(IFN,ORPLACE) ;IA #4859
;API to get the order checking info for a specific order (IFN)
;info is stored in ^TMP($J,ORPLACE)
; ^TMP($J,ORPLACE,D0,"OC LEVEL")="order check level"
; ,"OC TEXT")="order check text"
; ,"OR REASON")="over ride reason text"
; ,"OR PROVIDER")="provider DUZ who entered over ride reason"
; ,"OR DT")="date/time over ride reason was entered"
; NOTE on OC LEVEL: 1 is HIGH, 2 is MODERATE, 3 is LOW
I '$D(^OR(100,IFN,9)) Q
N I
S I=0 F S I=$O(^OR(100,IFN,9,I)) Q:'I D
.S ^TMP($J,ORPLACE,I,"OC LEVEL")=$P($G(^OR(100,IFN,9,I,0)),U,2)
.S ^TMP($J,ORPLACE,I,"OC TEXT")=$G(^OR(100,IFN,9,I,1))
.S ^TMP($J,ORPLACE,I,"OR REASON")=$P($G(^OR(100,IFN,9,I,0)),U,4)
.S ^TMP($J,ORPLACE,I,"OR PROVIDER")=$P($G(^OR(100,IFN,9,I,0)),U,5)
.S ^TMP($J,ORPLACE,I,"OR DT")=$P($G(^OR(100,IFN,9,I,0)),U,6)
Q
ORCHECK ;SLC/MKB-Order checking calls ;23-Nov-2011 11:55;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,56,70,94,141,1005,215,243,1010**;Dec 17, 1997;Build 47
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
DISPLAY ; -- DISPLAY event [called from ORCDLG,ORCACT4,ORCMED]
+1 ; Expects ORVP, ORNMSP, ORTAB, [ORWARD]
+2 IF $$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
QUIT
+3 NEW ORX,ORY,I
+4 ;reset to PSJ, PSJI, or PSO
IF ORNMSP="PS"
Begin DoDot:1
+5 IF $GET(ORDG)
SET I=$PIECE($GET(^ORD(100.98,+ORDG,0)),U,3)
SET I=$PIECE(I," ")
IF '$LENGTH(I)
QUIT
SET ORNMSP="PS"_$SELECT(I="UD":"I",1:I)
QUIT
+6 ;opposite of list
IF $GET(ORXFER)
SET I=$PIECE($PIECE(^TMP("OR",$JOB,ORTAB,0),U,3),";",3)
IF I=""
SET I=$GET(ORWARD)
SET ORNMSP="PS"_$SELECT(I:"O",1:"I")
End DoDot:1
+7 SET ORX(1)="|"_ORNMSP
SET ORX=1
+8 DO EN^ORKCHK(.ORY,+ORVP,.ORX,"DISPLAY")
IF '$DATA(ORY)
QUIT
+9 ; display only
SET I=0
FOR
SET I=$ORDER(ORY(I))
IF I'>0
QUIT
WRITE !,$PIECE(ORY(I),U,4)
+10 QUIT
+11 ;
SELECT ; -- SELECT event
+1 ; Expects ORVP, ORDAILOG(PROMPT,ORI), ORNMSP
+2 IF $$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
QUIT
+3 NEW ORX,ORY,OI
+4 SET OI=+$GET(ORDIALOG(PROMPT,ORI))
+5 SET ORX=1
SET ORX(1)=OI_"|"_ORNMSP_"|"_$$USID^ORMBLD(OI)
+6 DO EN^ORKCHK(.ORY,+ORVP,.ORX,"SELECT")
IF $DATA(ORY)
DO RETURN
+7 QUIT
+8 ;
ACCEPT(MODE) ; -- ACCEPT event [called from ORCDLG,ORCACT4,ORCMED]
+1 ; Expects ORVP, ORDIALOG(), ORNMSP
+2 IF $$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
QUIT
+3 NEW ORX,ORY,ORZ,OI,ORSTRT,ORI,ORIT,ORID,ORSP
+4 IF '$LENGTH($GET(MODE))
SET MODE="ACCEPT"
+5 SET OI=$$PTR^ORCD("OR GTX ORDERABLE ITEM")
SET ORSTRT=$$START
SET ORX=0
+6 SET ORI=0
FOR
SET ORI=$ORDER(ORDIALOG(OI,ORI))
IF ORI'>0
QUIT
DO STUF
+7 IF $GET(ORDG)=+$ORDER(^ORD(100.98,"B","IV RX",0))
SET OI=$$PTR^ORCD("OR GTX ADDITIVE")
SET ORI=0
FOR
SET ORI=$ORDER(ORDIALOG(OI,ORI))
IF ORI'>0
QUIT
DO STUF
+8 DO EN^ORKCHK(.ORY,+ORVP,.ORX,MODE)
IF $DATA(ORY)
DO RETURN
+9 QUIT
STUF SET ORIT=ORDIALOG(OI,ORI)
SET ORSP=""
+1 IF ORNMSP="LR"
SET ORSP=+$GET(ORDIALOG($$PTR^ORCD("OR GTX SPECIMEN"),ORI))
+2 SET ORID=$SELECT($EXTRACT(ORNMSP,1,2)="PS":$$DRUG(ORIT,OI),1:$$USID^ORMBLD(ORIT))
+3 SET ORZ=1
SET ORZ(1)=ORIT_"|"_ORNMSP_"|"_ORID
+4 IF MODE'="ALL"
DO EN^ORKCHK(.ORY,+ORVP,.ORZ,"SELECT")
IF $DATA(ORY)
DO RETURN
+5 SET ORX=ORX+1
SET ORX(ORX)=ORZ(1)_"|"_ORSTRT_"||"_ORSP
KILL ORY,ORZ
+6 QUIT
+7 ;
DELAY(MODE) ; -- Delayed ACCEPT event [called from ORMEVNT]
+1 ; Expects ORVP, ORIFN
+2 IF $$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
QUIT
+3 NEW ORX,ORY,ORCHECK
IF '$LENGTH($GET(MODE))
SET MODE="NOTIF"
+4 DO BLD(+ORIFN)
DO EN^ORKCHK(.ORY,+ORVP,.ORX,MODE)
IF '$DATA(ORY)
QUIT
+5 ; silent
DO RETURN
IF MODE="NOTIF"
SET ORCHECK("OK")="Notification sent to provider"
DO OC^ORCSAVE2
QUIT
+6 QUIT
+7 ;
SESSION ; -- SESSION event [called from ORCSIGN]
+1 ; Expects ORVP, ORES()
+2 IF $$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
QUIT
+3 NEW ORX,ORY,ORIFN,I,X,Y
+4 SET ORIFN=0
FOR
SET ORIFN=$ORDER(ORES(ORIFN))
IF ORIFN'>0
QUIT
IF +$PIECE(ORIFN,";",2)'>1
Begin DoDot:1
+5 ;unreleased
IF "^5^6^10^11^"'[(U_$PIECE($GET(^OR(100,+ORIFN,3)),U,3)_U)
QUIT
+6 DO BLD(+ORIFN)
IF '$DATA(^OR(100,+ORIFN,9))
QUIT
+7 SET ORCHECK("IFN")=+$GET(ORCHECK("IFN"))+1
+8 SET I=0
FOR
SET I=$ORDER(^OR(100,+ORIFN,9,I))
IF I'>0
QUIT
SET X=$GET(^(I,0))
SET Y=$GET(^(1))
SET ORCHECK=+$GET(ORCHECK)+1
SET ORCHECK(+ORIFN,$SELECT($PIECE(X,U,2):$PIECE(X,U,2),1:99),ORCHECK)=$PIECE(X,U,1,2)_U_Y
End DoDot:1
+9 IF $DATA(ORX)
DO EN^ORKCHK(.ORY,+ORVP,.ORX,"SESSION")
IF $DATA(ORY)
DO RETURN
DO REMDUPS
+10 QUIT
+11 ; IHS/MSC/DKM - Added following subroutine
MANUAL ; -- MANUAL event
+1 ; Expects ORVP, ORES()
+2 IF $$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
QUIT
+3 NEW ORX,ORY,ORIFN,I,X,Y
+4 SET ORIFN=0
FOR
SET ORIFN=$ORDER(ORES(ORIFN))
IF ORIFN'>0
QUIT
Begin DoDot:1
+5 ;Q:'$D(^OR(100,+ORIFN,9))
DO BLD(+ORIFN)
+6 SET ORCHECK("IFN")=+$GET(ORCHECK("IFN"))+1
End DoDot:1
+7 IF $DATA(ORX)
DO EN^ORKCHK(.ORY,+ORVP,.ORX,"MANUAL")
IF $DATA(ORY)
DO RETURN
+8 QUIT
+9 ;
BLD(ORDER) ; -- Build new ORX(#) for ORDER
+1 ;Q:$P($G(^(3)),U,11) ;edit/renew
IF '$GET(ORDER)
QUIT
IF '$DATA(^OR(100,ORDER,0))
QUIT
+2 NEW PKG,START,ORI,ITEM,USID,SPEC,ORDG,PTR,INST
+3 SET ORDG=$PIECE(^OR(100,ORDER,0),U,11)
SET PKG=$$GET1^DIQ(9.4,$PIECE(^(0),U,14)_",",1)
+4 IF PKG="PS"
IF $GET(ORDG)
SET ORI=$PIECE($GET(^ORD(100.98,+ORDG,0)),U,3)
SET ORI=$PIECE(ORI," ")
SET PKG=PKG_$SELECT(ORI="UD":"I",1:ORI)
+5 SET START=$$START(ORDER)
SET ORI=0
+6 FOR
SET ORI=$ORDER(^OR(100,ORDER,4.5,"ID","ORDERABLE",ORI))
IF ORI'>0
QUIT
Begin DoDot:1
+7 SET INST=$PIECE($GET(^OR(100,ORDER,4.5,ORI,0)),U,3)
SET PTR=$PIECE($GET(^(0)),U,2)
SET ITEM=+$GET(^(1))
+8 SET USID=$SELECT(PKG?1"PS".E:$$DRUG(ITEM,PTR,ORDER),1:$$USID^ORMBLD(ITEM))
+9 SET SPEC=$SELECT(PKG="LR":$$VALUE^ORCSAVE2(ORDER,"SPECIMEN",INST),1:"")
+10 SET ORX=+$GET(ORX)+1
SET ORX(ORX)=ITEM_"|"_PKG_"|"_USID_"|"_START_"|"_ORDER_"|"_SPEC
End DoDot:1
+11 QUIT
+12 ;
RETURN ; -- Return checks in ORCHECK(ORIFN,CDL,#)
+1 NEW I,IFN,CDL
SET I=0
FOR
SET I=$ORDER(ORY(I))
IF I'>0
QUIT
Begin DoDot:1
+2 SET IFN=+$PIECE(ORY(I),U)
IF 'IFN
SET IFN="NEW"
+3 SET CDL=+$PIECE(ORY(I),U,3)
IF 'CDL
SET CDL=99
+4 ; count
IF '$DATA(ORCHECK(IFN))
SET ORCHECK("IFN")=+$GET(ORCHECK("IFN"))+1
+5 SET ORCHECK=+$GET(ORCHECK)+1
SET ORCHECK(IFN,CDL,ORCHECK)=$PIECE(ORY(I),U,2,4)
End DoDot:1
+6 QUIT
+7 ;
REMDUPS ;
+1 NEW IFN,CDL,I
+2 SET IFN=0
FOR
SET IFN=$ORDER(ORCHECK(IFN))
IF 'IFN
QUIT
Begin DoDot:1
+3 SET CDL=0
FOR
SET CDL=$ORDER(ORCHECK(IFN,CDL))
IF 'CDL
QUIT
Begin DoDot:2
+4 SET I=0
FOR
SET I=$ORDER(ORCHECK(IFN,CDL,I))
IF 'I
QUIT
Begin DoDot:3
+5 SET J=I
FOR
SET J=$ORDER(ORCHECK(IFN,CDL,J))
IF 'J
QUIT
IF $GET(ORCHECK(IFN,CDL,I))=$GET(ORCHECK(IFN,CDL,J))
KILL ORCHECK(IFN,CDL,J)
SET ORCHECK=$GET(ORCHECK)-1
End DoDot:3
End DoDot:2
End DoDot:1
+6 QUIT
START(DA) ; -- Returns start date/time
+1 NEW I,X,Y,%DT
SET Y=""
+2 IF $GET(DA)
SET X=$ORDER(^OR(100,DA,4.5,"ID","START",0))
SET X=$GET(^OR(100,DA,4.5,+X,1))
+3 ; look in ORDIALOG instead
IF '$TEST
Begin DoDot:1
+4 SET I=0
FOR
SET I=$ORDER(ORDIALOG(I))
IF I'>0
QUIT
IF $PIECE(ORDIALOG(I),U,2)="START"
QUIT
+5 SET X=$SELECT(I:$GET(ORDIALOG(I,1)),1:"")
End DoDot:1
+6 IF X="AM"
DO AM^ORCSAVE2
IF X="NEXT"
DO NEXT^ORCSAVE2
+7 IF X="NEXTA"
DO ADMIN^ORCSAVE2("NEXT")
IF X="CLOSEST"
DO ADMIN^ORCSAVE2("CLOSEST")
+8 IF $LENGTH(X)
SET %DT="TX"
DO ^%DT
IF Y'>0
SET Y=""
+9 QUIT Y
+10 ;
DRUG(OI,PTR,IFN) ; -- Returns 6 ^-piece identifier for Dispense Drug
+1 NEW ORDD,ORNDF,Y
+2 IF ORDG=+$ORDER(^ORD(100.98,"B","IV RX",0))
SET ORDD=$$IV
GOTO D1
+3 IF $GET(IFN)
SET ORDD=$ORDER(^OR(100,IFN,4.5,"ID","DRUG",0))
SET ORDD=+$GET(^OR(100,IFN,4.5,+ORDD,1))
+4 IF '$TEST
SET ORDD=+$GET(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1))
D1 IF 'ORDD
QUIT ""
SET ORNDF=$$ENDCM^PSJORUTL(ORDD)
+1 SET Y=$PIECE(ORNDF,U,3)_"^^99NDF^"_ORDD_U_$$NAME50^ORPEAPI(ORDD)_"^99PSD"
+2 QUIT Y
+3 ;
IV() ; -- Get Dispense Drug for IV orderable
+1 NEW PSOI,TYPE,VOL,ORY
+2 SET PSOI=+$PIECE($GET(^ORD(101.43,+OI,0)),U,2)
SET VOL=""
+3 SET TYPE=$SELECT(PTR=$$PTR^ORCD("OR GTX ADDITIVE"):"A",1:"B")
+4 IF TYPE="B"
SET VOL=$SELECT($GET(IFN):$$VALUE^ORCSAVE2(IFN,"VOLUME"),1:+$GET(ORDIALOG($$PTR^ORCD("OR GTX VOLUME"),1)))
+5 DO ENDDIV^PSJORUTL(PSOI,TYPE,VOL,.ORY)
+6 QUIT +$GET(ORY)
+7 ;
LIST(IFN) ; -- Displays list of ORCHECK(IFN) checks
+1 NEW ORI,ORJ,ORZ,ORMAX,ORTX,ON,OFF
+2 SET ORZ=0
FOR
SET ORZ=$ORDER(ORCHECK(IFN,ORZ))
IF ORZ'>0
QUIT
Begin DoDot:1
+3 ; use bold if High
IF ORZ=1
SET ON=IOINHI
SET OFF=IOINORM
IF ORZ'=1
SET (ON,OFF)=""
+4 SET ORI=0
FOR
SET ORI=$ORDER(ORCHECK(IFN,ORZ,ORI))
IF ORI'>0
QUIT
Begin DoDot:2
+5 SET X=$PIECE(ORCHECK(IFN,ORZ,ORI),U,3)
IF $LENGTH(X)<75
WRITE !,ON_">>> "_X_OFF
QUIT
+6 ; wrap
SET ORMAX=74
KILL ORTX
DO TXT^ORCHTAB
IF '$GET(ORTX)
QUIT
+7 FOR ORJ=1:1:ORTX
WRITE !,ON_$SELECT(ORJ=1:">>> ",1:" ")_ORTX(ORJ)_OFF
End DoDot:2
End DoDot:1
+8 WRITE !
+9 QUIT
+10 ;
CANCEL() ; -- Returns 1 or 0: Cancel order(s)?
+1 NEW X,Y,DIR,NUM
+2 SET NUM=+$GET(ORCHECK("IFN"))
SET DIR(0)="YA"
+3 SET DIR("A")="Do you want to cancel "_$SELECT(NUM>1:"any of the new orders? ",1:"the new order? ")
+4 SET DIR("?",1)="Enter YES to cancel "_$SELECT(NUM>1:"an",1:"the")_" order. If you wish to override these order checks"
+5 SET DIR("?",2)="and release "_$SELECT(NUM>1:"these orders",1:"this order")_", enter NO; you will be prompted for a justification"
SET DIR("?")="if there are any highlighted critical order checks."
+6 DO ^DIR
+7 QUIT +Y
+8 ;
REASON() ; -- Reason for overriding order checks
+1 ; I '$D(^XUSEC("ORES",DUZ)),'$D(^XUSEC("ORELSE",DUZ)) Q ??
+2 NEW X,Y,DIR
+3 SET DIR(0)="FA^2:80^K:X?1."" "" X"
SET DIR("A")="REASON FOR OVERRIDE: "
+4 SET DIR("?")="Enter a justification for overriding these order checks, up to 80 characters"
+5 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET Y="^"
+6 QUIT Y
OCAPI(IFN,ORPLACE) ;IA #4859
+1 ;API to get the order checking info for a specific order (IFN)
+2 ;info is stored in ^TMP($J,ORPLACE)
+3 ; ^TMP($J,ORPLACE,D0,"OC LEVEL")="order check level"
+4 ; ,"OC TEXT")="order check text"
+5 ; ,"OR REASON")="over ride reason text"
+6 ; ,"OR PROVIDER")="provider DUZ who entered over ride reason"
+7 ; ,"OR DT")="date/time over ride reason was entered"
+8 ; NOTE on OC LEVEL: 1 is HIGH, 2 is MODERATE, 3 is LOW
+9 IF '$DATA(^OR(100,IFN,9))
QUIT
+10 NEW I
+11 SET I=0
FOR
SET I=$ORDER(^OR(100,IFN,9,I))
IF 'I
QUIT
Begin DoDot:1
+12 SET ^TMP($JOB,ORPLACE,I,"OC LEVEL")=$PIECE($GET(^OR(100,IFN,9,I,0)),U,2)
+13 SET ^TMP($JOB,ORPLACE,I,"OC TEXT")=$GET(^OR(100,IFN,9,I,1))
+14 SET ^TMP($JOB,ORPLACE,I,"OR REASON")=$PIECE($GET(^OR(100,IFN,9,I,0)),U,4)
+15 SET ^TMP($JOB,ORPLACE,I,"OR PROVIDER")=$PIECE($GET(^OR(100,IFN,9,I,0)),U,5)
+16 SET ^TMP($JOB,ORPLACE,I,"OR DT")=$PIECE($GET(^OR(100,IFN,9,I,0)),U,6)
End DoDot:1
+17 QUIT
