- ORCHECK ;SLC/MKB-Order checking calls ;Jun 19, 2020@09:03:02
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,56,70,94,141,215,243,293,280,346,357,352,345,311,269,382,545,405**;Dec 17, 1997;Build 211
- ;;Per VA Directive 6402, 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,ORDODSG
- S OI=+$G(ORDIALOG(PROMPT,ORI)),ORDODSG=0
- S ORX=1,ORX(1)=OI_"|"_ORNMSP_"|"_$$USID^ORMBLD(OI)
- D EN^ORKCHK(.ORY,+ORVP,.ORX,"SELECT",,.ORDODSG),RETURN:$D(ORY)
- Q
- ;
- ACCEPT(MODE) ; -- ACCEPT event [called from ORCDLG,ORCACT4,ORCMED]
- ; Expects ORVP, ORDIALOG(), ORNMSP
- K ^TMP($J,"ORK XTRA TXT")
- Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
- N ORX,ORY,ORZ,OI,ORSTRT,ORI,ORIT,ORID,ORSP,ORDODSG
- S:'$L($G(MODE)) MODE="ACCEPT"
- S OI=$$PTR^ORCD("OR GTX ORDERABLE ITEM"),ORSTRT=$$START,ORX=0,ORDODSG=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,,.ORDODSG),RETURN:$D(ORY),FDBDOWN(0)
- 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",,.ORDODSG),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,ORDODSG S:'$L($G(MODE)) MODE="NOTIF"
- S ORDODSG=0
- D BLD(+ORIFN),EN^ORKCHK(.ORY,+ORVP,.ORX,MODE,,.ORDODSG) Q:'$D(ORY)
- D RETURN I MODE="NOTIF" S ORCHECK("OK")="Notification sent to provider" D OC^ORCSAVE2 Q ; silent
- 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,ORXSETIV
- S ORXSETIV=0
- 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
- I PKG="PSJ" D
- .N ORITEMS,IDX
- .D MAYBEIV^ORWDXR01(.ORITEMS,ORDER)
- .Q:$G(ORITEMS)=""
- .F IDX=1:1:$L(ORITEMS,U) D
- ..S ORX=+$G(ORX)+1,ORX(ORX)=$P(ORITEMS,U,IDX),$P(ORX(ORX),"|",3)=$$DRUG(+ORX(ORX),$P(ORX(ORX),"|",3),ORDER)
- ..S $P(ORX(ORX),"|",4)=START
- ..S ORXSETIV=1
- Q:ORXSETIV
- 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
- ;
- REMDUPS ;
- N IFN,CDL,I,J,CDL2,OVRIDE,OVRIDE2
- 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 OVRIDE=$P($G(ORCHECK(IFN,CDL,I)),U,7) ;TDP
- ... S CDL2=0 F S CDL2=$O(ORCHECK(IFN,CDL2)) Q:'CDL2 D
- .... S J=I F S J=$O(ORCHECK(IFN,CDL2,J)) Q:'J I $TR($P($G(ORCHECK(IFN,CDL,I)),U,3),";",",")=$TR($P($G(ORCHECK(IFN,CDL2,J)),U,3),";",",") D
- ..... S OVRIDE2=$P($G(ORCHECK(IFN,CDL2,J)),U,7) ;TDP
- ..... I CDL2>=CDL D
- ...... I OVRIDE2'="",OVRIDE="" S $P(ORCHECK(IFN,CDL,I),U,7)=OVRIDE2 ;TDP
- ...... K ORCHECK(IFN,CDL2,J) S ORCHECK=$G(ORCHECK)-1
- ..... I CDL2<CDL D
- ...... I OVRIDE2="",OVRIDE'="" S $P(ORCHECK(IFN,CDL2,J),U,7)=OVRIDE ;TDP
- ...... S $P(ORCHECK(IFN,CDL,I),U,7)="X"
- ... I $P(ORCHECK(IFN,CDL,I),U,7)="X" K ORCHECK(IFN,CDL,I) 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))!(ORDG=+$O(^ORD(100.98,"B","CI 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,DTOUT,DUOUT,DIRUT,DIROUT
- 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
- ;
- SESSION ; -- SESSION event [called from ORCSIGN]
- ; Expects ORVP, ORES()
- K ^TMP($J,"ORK XTRA TXT")
- Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
- N ORX,ORY,ORIFN,I,X,Y,ORGLOB,ORCHKNM
- S ORGLOB=$H
- K ^TMP($J,ORGLOB)
- S ORIFN=0 F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 I +$P(ORIFN,";",2)'>1 D
- . I "^14^13^11^10^"'[(U_$P($G(^OR(100,+ORIFN,3)),U,3)_U) Q ;unreleased
- . D BLD(+ORIFN) K ^TMP($J,"OCDATA") Q:'$$OCAPI^ORCHECK(+ORIFN,"OCDATA")
- . S ORCHECK("IFN")=+$G(ORCHECK("IFN"))+1
- . S I=0 F S I=$O(^TMP($J,"OCDATA",I)) Q:'I D
- . . I $G(^TMP($J,"OCDATA",I,"OC NUMBER"))=32,$$ALGASS(+ORIFN)=1 Q
- . . I $G(^TMP($J,"OCDATA",I,"OC NUMBER"))=3,$G(^TMP($J,"OCDATA",I,"OR REASON"))="",$G(^TMP($J,"OCDATA",I,"OC COMMENT"))="" Q ;TDP
- . . I $G(^TMP($J,"OCDATA",I,"OC TEXT",1,0))["Drug-Drug order checks (Duplicate Therapy, Duplicate Drug, Drug Interaction) were not able to be performed." Q
- . . S ORCHECK=+$G(ORCHECK)+1,ORCHECK(+ORIFN,$S($G(^TMP($J,"OCDATA",I,"OC LEVEL")):^TMP($J,"OCDATA",I,"OC LEVEL"),1:99),ORCHECK)=$G(^TMP($J,"OCDATA",I,"OC NUMBER"))_U_$G(^TMP($J,"OCDATA",I,"OC LEVEL"))_U_$G(^TMP($J,"OCDATA",I,"OC TEXT",1,0))_U_1
- . . ;TDP - Adding "OR REASON" and "OC COMMENT" checks
- . . S ORCHKNM=$NA(ORCHECK(+ORIFN,$S($G(^TMP($J,"OCDATA",I,"OC LEVEL")):^TMP($J,"OCDATA",I,"OC LEVEL"),1:99),ORCHECK))
- . . I $G(^TMP($J,"OCDATA",I,"OC COMMENT"))'="" D
- . . . S $P(@ORCHKNM,U,6)=$G(^TMP($J,"OCDATA",I,"OC COMMENT"))
- . . I $G(^TMP($J,"OCDATA",I,"OR REASON"))'="" D
- . . . S $P(@ORCHKNM,U,7)=$G(^TMP($J,"OCDATA",I,"OR REASON"))
- . . I $O(^TMP($J,"OCDATA",I,"OC TEXT",1)) D
- . . . S ORCHECK(+ORIFN,$S($G(^TMP($J,"OCDATA",I,"OC LEVEL")):^TMP($J,"OCDATA",I,"OC LEVEL"),1:99),ORCHECK)=$G(^TMP($J,"OCDATA",I,"OC NUMBER"))_U_$G(^TMP($J,"OCDATA",I,"OC LEVEL"))_U_"||"_ORGLOB_"&"_$G(^TMP($J,"OCDATA",I,"OC TEXT",1,0))_U_1
- . . . N ORI S ORI=0 F S ORI=$O(^TMP($J,"OCDATA",I,"OC TEXT",ORI)) Q:'ORI S ^TMP($J,"ORK XTRA TXT",ORGLOB,^TMP($J,"OCDATA",I,"OC TEXT",1,0),ORI)=^TMP($J,"OCDATA",I,"OC TEXT",ORI,0)
- . . . I ($G(^TMP($J,"OCDATA",I,"OC NUMBER"))=35)!($G(^TMP($J,"OCDATA",I,"OC NUMBER"))=36) D
- . . . . N ORCROC1,ORCROC2,ORPIECE1,ORPIECE2
- . . . . S ORCROC1=$P($G(^ORD(100.05,^TMP($J,"OCDATA",I,"OC INSTANCE"),12)),U)
- . . . . S ORCROC2=$P($G(^ORD(100.05,^TMP($J,"OCDATA",I,"OC INSTANCE"),12)),U,2)
- . . . . S ORPIECE1=$G(^TMP($J,"OCDATA",I,"OC NUMBER"))
- . . . . S ORPIECE2=$G(^TMP($J,"OCDATA",I,"OC LEVEL"))_U_"||"_ORGLOB_"&"_$G(^TMP($J,"OCDATA",I,"OC TEXT",1,0))_"&"_ORCROC1_"&"_ORCROC2_U_1
- . . . . S ORCHECK(+ORIFN,$S($G(^TMP($J,"OCDATA",I,"OC LEVEL")):^TMP($J,"OCDATA",I,"OC LEVEL"),1:99),ORCHECK)=ORPIECE1_U_ORPIECE2
- . . I $D(^ORD(100.05,^TMP($J,"OCDATA",I,"OC INSTANCE"),16)) D
- . . . N ORMONOI S ORMONOI=$O(^TMP($J,"ORMONOGRAPH",""),-1)+1
- . . . M ^TMP($J,"ORMONOGRAPH",ORMONOI,"DATA")=^ORD(100.05,^TMP($J,"OCDATA",I,"OC INSTANCE"),16)
- . . . S ^TMP($J,"ORMONOGRAPH",ORMONOI,"INT")=^ORD(100.05,^TMP($J,"OCDATA",I,"OC INSTANCE"),17)
- . . . S ^TMP($J,"ORMONOGRAPH",ORMONOI,"OC")=$G(^TMP($J,"OCDATA",I,"OC TEXT",1,0))
- . K ^TMP($J,"OCDATA")
- I $D(ORX) D EN^ORKCHK(.ORY,+ORVP,.ORX,"SESSION"),RETURN:$D(ORY),FDBDOWN(1),REMDUPS
- Q
- ;
- FDBDOWN(ORX) ; -- Checks to see if the FDB was down and if so set appropriate OC
- ; expects ORCHECK array of order checks
- ; if ORX is 1 then this is getting called from SESSION order checks
- Q:'$D(ORCHECK)
- ;look for the "not able to be performed" OCs for each type (DSG and ENH), set flag for each to 1 if found and remove them from ORCHECK
- N I S I="" F S I=$O(ORCHECK(I)) Q:'$L(I) D
- .N ORNEXT,ORDSG,ORENH,ORTHERE
- .S ORDSG=0,ORENH=0,ORTHERE=0,ORNEXT=1
- .N J S J=0 F S J=$O(ORCHECK(I,J)) Q:'J D
- ..N K S K=0 F S K=$O(ORCHECK(I,J,K)) Q:'K D
- ...I (K+1)>ORNEXT S ORNEXT=K+1
- ...I $G(ORCHECK(I,J,K))[$$DSDWNMSG^ORDSGCHK K ORCHECK(I,J,K) S ORDSG=1
- ...I $G(ORCHECK(I,J,K))["Drug-Drug order checks (Duplicate Therapy, Duplicate Drug, Drug Interaction) were not able to be performed." K ORCHECK(I,J,K) S ORENH=1
- ...I $G(ORCHECK(I,J,K))["These checks could not be completed for this patient:" S ORTHERE=1
- .;if DSG or ENH flag is set then add to ORY
- .I ORDSG!(ORENH) D
- ..;look to see if message already exists
- ..I ORTHERE Q
- ..N ORKGLOB S ORKGLOB=$H_","_I
- ..N ORMAIN S ORMAIN="These checks could not be completed for this patient:"
- ..S ORCHECK(I,2,ORNEXT)="25^2^||"_ORKGLOB_"&"_ORMAIN
- ..I $G(ORX) S ^TMP($J,"ORK XTRA TXT",ORKGLOB,ORMAIN,0)=ORMAIN
- ..N ORCNT S ORCNT=1
- ..I ORENH S ORCNT=ORCNT+1,^TMP($J,"ORK XTRA TXT",ORKGLOB,ORMAIN,ORCNT)=" Drug Interactions"
- ..I ORENH S ORCNT=ORCNT+1,^TMP($J,"ORK XTRA TXT",ORKGLOB,ORMAIN,ORCNT)=" Duplicate Therapy"
- ..I '$G(ORX),ORDSG S ORCNT=ORCNT+1,^TMP($J,"ORK XTRA TXT",ORKGLOB,ORMAIN,ORCNT)=" Dosing"
- 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,7)
- Q
- ;
- ALGASS(ORIFN) ;see if patient from order has an allergy assessment
- N ORDFN S ORDFN=+$P(^OR(100,ORIFN,0),U,2)
- K ORARRAY D EN1^GMRAOR1(ORDFN,"ORARRAY")
- I ORARRAY'="" Q 1
- Q 0
- OCAPI(IFN,ORPLACE) ;IA #4859
- ;LOOK AT ROUTINE OROCAPI1 FOR MORE DETAILED APIS
- ;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 NUMBER")="file 100.8 ien"
- ; ,"OC TEXT")="order check text"
- ; ,"OR REASON")="over ride reason text"
- ; ,"OC COMMENT")="remote allergy comment"
- ; ,"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
- N RET,ORN,CNT,I,ORFLAG
- S ORN=+IFN,CNT=0,ORFLAG=0
- ;if the order is not released then show ACCEPTANCE_CPRS ocs
- I "^14^13^11^10^"[(U_$P($G(^OR(100,ORN,3)),U,3)_U) D GETOC5^OROCAPI1(ORN,"ACCEPTANCE_CPRS",.RET) S ORFLAG=1
- ;if it has been signed then show SIGNATURE_CPRS ocs
- I 'ORFLAG D GETOC5^OROCAPI1(ORN,"SIGNATURE_CPRS",.RET)
- I $D(RET) S I=0 F S I=$O(RET(ORN,"DATA",I)) Q:'I S CNT=CNT+1 D
- .S ^TMP($J,ORPLACE,CNT,"OC NUMBER")=$P($P($G(RET(ORN,"DATA",I,1)),U),";",2)
- .S ^TMP($J,ORPLACE,CNT,"OC LEVEL")=$P($G(RET(ORN,"DATA",I,1)),U,2)
- .M ^TMP($J,ORPLACE,CNT,"OC TEXT")=RET(ORN,"DATA",I,"OC")
- .S ^TMP($J,ORPLACE,CNT,"OR REASON")=$G(RET(ORN,"DATA",I,"OR",1,0))
- .S ^TMP($J,ORPLACE,CNT,"OC COMMENT")=$G(RET(ORN,"DATA",I,"CM")) ;TDP
- .S ^TMP($J,ORPLACE,CNT,"OR PROVIDER")=$S($L(^TMP($J,ORPLACE,CNT,"OR REASON")):$P($G(RET(ORN,"DATA",I,0)),U,4),1:"")
- .S ^TMP($J,ORPLACE,CNT,"OR DT")=$S($L(^TMP($J,ORPLACE,CNT,"OR REASON")):$P($G(RET(ORN,"DATA",I,0)),U,5),1:"")
- .S ^TMP($J,ORPLACE,CNT,"OR STATUS")=$P($G(RET(ORN,"DATA",I,0)),U,2)
- .S ^TMP($J,ORPLACE,CNT,"OC INSTANCE")=I
- Q CNT
- ;
- ISMONO(ORY) ;returns 1 if there is monograph data for the orderchecks being presented to the user
- S ORY=0
- Q:'$$PATCH^XPDUTL("OR*3.0*272")
- I $D(^TMP($J,"ORMONOGRAPH")) S ORY=1
- Q
- GETMONOL(ORY) ;returns a list of monographs available for the orderchecks being presented to the user
- Q:'$D(^TMP($J,"ORMONOGRAPH"))
- N I S I=0
- F S I=$O(^TMP($J,"ORMONOGRAPH",I)) Q:'I D
- .S ORY($G(^TMP($J,"ORMONOGRAPH",I,"INT")))=I_U_$G(^TMP($J,"ORMONOGRAPH",I,"INT"))
- Q
- GETMONO(ORY,ORMONO) ;return a monograph
- Q:'$D(^TMP($J,"ORMONOGRAPH",ORMONO))
- K ^TMP($J,"ORMONORPC")
- M ^TMP($J,"ORMONORPC")=^TMP($J,"ORMONOGRAPH",ORMONO,"DATA")
- K ^TMP($J,"ORMONORPC",0)
- S ORY=$NA(^TMP($J,"ORMONORPC")),@ORY=""
- Q
- DELMONO(ORY) ;delete monograph data
- K ^TMP($J,"ORMONOGRAPH"),^TMP($J,"ORMONORPC")
- Q
- GETXTRA(ORY,ORGL,ORRULE) ;get extra text for an order check
- ;^TMP($J,"ORK XTRA TXT") stores the text of order checks that are longer than a single line (reminder order checks)
- Q:'$D(^TMP($J,"ORK XTRA TXT",ORGL,ORRULE))
- M ORY=^TMP($J,"ORK XTRA TXT",ORGL,ORRULE)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCHECK 15534 printed Jan 18, 2025@03:29:35 Page 2
- ORCHECK ;SLC/MKB-Order checking calls ;Jun 19, 2020@09:03:02
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,56,70,94,141,215,243,293,280,346,357,352,345,311,269,382,545,405**;Dec 17, 1997;Build 211
- +2 ;;Per VA Directive 6402, 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,ORDODSG
- +4 SET OI=+$GET(ORDIALOG(PROMPT,ORI))
- SET ORDODSG=0
- +5 SET ORX=1
- SET ORX(1)=OI_"|"_ORNMSP_"|"_$$USID^ORMBLD(OI)
- +6 DO EN^ORKCHK(.ORY,+ORVP,.ORX,"SELECT",,.ORDODSG)
- if $DATA(ORY)
- DO RETURN
- +7 QUIT
- +8 ;
- ACCEPT(MODE) ; -- ACCEPT event [called from ORCDLG,ORCACT4,ORCMED]
- +1 ; Expects ORVP, ORDIALOG(), ORNMSP
- +2 KILL ^TMP($JOB,"ORK XTRA TXT")
- +3 if $$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
- QUIT
- +4 NEW ORX,ORY,ORZ,OI,ORSTRT,ORI,ORIT,ORID,ORSP,ORDODSG
- +5 if '$LENGTH($GET(MODE))
- SET MODE="ACCEPT"
- +6 SET OI=$$PTR^ORCD("OR GTX ORDERABLE ITEM")
- SET ORSTRT=$$START
- SET ORX=0
- SET ORDODSG=0
- +7 SET ORI=0
- FOR
- SET ORI=$ORDER(ORDIALOG(OI,ORI))
- if ORI'>0
- QUIT
- DO STUF
- +8 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
- +9 DO EN^ORKCHK(.ORY,+ORVP,.ORX,MODE,,.ORDODSG)
- if $DATA(ORY)
- DO RETURN
- DO FDBDOWN(0)
- +10 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",,.ORDODSG)
- 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,ORDODSG
- if '$LENGTH($GET(MODE))
- SET MODE="NOTIF"
- +4 SET ORDODSG=0
- +5 DO BLD(+ORIFN)
- DO EN^ORKCHK(.ORY,+ORVP,.ORX,MODE,,.ORDODSG)
- if '$DATA(ORY)
- QUIT
- +6 ; silent
- DO RETURN
- IF MODE="NOTIF"
- SET ORCHECK("OK")="Notification sent to provider"
- DO OC^ORCSAVE2
- QUIT
- +7 QUIT
- +8 ;
- 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,ORXSETIV
- +3 SET ORXSETIV=0
- +4 SET ORDG=$PIECE(^OR(100,ORDER,0),U,11)
- SET PKG=$$GET1^DIQ(9.4,$PIECE(^(0),U,14)_",",1)
- +5 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)
- +6 SET START=$$START(ORDER)
- SET ORI=0
- +7 IF PKG="PSJ"
- Begin DoDot:1
- +8 NEW ORITEMS,IDX
- +9 DO MAYBEIV^ORWDXR01(.ORITEMS,ORDER)
- +10 if $GET(ORITEMS)=""
- QUIT
- +11 FOR IDX=1:1:$LENGTH(ORITEMS,U)
- Begin DoDot:2
- +12 SET ORX=+$GET(ORX)+1
- SET ORX(ORX)=$PIECE(ORITEMS,U,IDX)
- SET $PIECE(ORX(ORX),"|",3)=$$DRUG(+ORX(ORX),$PIECE(ORX(ORX),"|",3),ORDER)
- +13 SET $PIECE(ORX(ORX),"|",4)=START
- +14 SET ORXSETIV=1
- End DoDot:2
- End DoDot:1
- +15 if ORXSETIV
- QUIT
- +16 FOR
- SET ORI=$ORDER(^OR(100,ORDER,4.5,"ID","ORDERABLE",ORI))
- if ORI'>0
- QUIT
- Begin DoDot:1
- +17 SET INST=$PIECE($GET(^OR(100,ORDER,4.5,ORI,0)),U,3)
- SET PTR=$PIECE($GET(^(0)),U,2)
- SET ITEM=+$GET(^(1))
- +18 SET USID=$SELECT(PKG?1"PS".E:$$DRUG(ITEM,PTR,ORDER),1:$$USID^ORMBLD(ITEM))
- +19 SET SPEC=$SELECT(PKG="LR":$$VALUE^ORCSAVE2(ORDER,"SPECIMEN",INST),1:"")
- +20 SET ORX=+$GET(ORX)+1
- SET ORX(ORX)=ITEM_"|"_PKG_"|"_USID_"|"_START_"|"_ORDER_"|"_SPEC
- End DoDot:1
- +21 QUIT
- +22 ;
- REMDUPS ;
- +1 NEW IFN,CDL,I,J,CDL2,OVRIDE,OVRIDE2
- +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 ;TDP
- SET OVRIDE=$PIECE($GET(ORCHECK(IFN,CDL,I)),U,7)
- +6 SET CDL2=0
- FOR
- SET CDL2=$ORDER(ORCHECK(IFN,CDL2))
- if 'CDL2
- QUIT
- Begin DoDot:4
- +7 SET J=I
- FOR
- SET J=$ORDER(ORCHECK(IFN,CDL2,J))
- if 'J
- QUIT
- IF $TRANSLATE($PIECE($GET(ORCHECK(IFN,CDL,I)),U,3),";",",")=$TRANSLATE($PIECE($GET(ORCHECK(IFN,CDL2,J)),U,3),";",",")
- Begin DoDot:5
- +8 ;TDP
- SET OVRIDE2=$PIECE($GET(ORCHECK(IFN,CDL2,J)),U,7)
- +9 IF CDL2>=CDL
- Begin DoDot:6
- +10 ;TDP
- IF OVRIDE2'=""
- IF OVRIDE=""
- SET $PIECE(ORCHECK(IFN,CDL,I),U,7)=OVRIDE2
- +11 KILL ORCHECK(IFN,CDL2,J)
- SET ORCHECK=$GET(ORCHECK)-1
- End DoDot:6
- +12 IF CDL2<CDL
- Begin DoDot:6
- +13 ;TDP
- IF OVRIDE2=""
- IF OVRIDE'=""
- SET $PIECE(ORCHECK(IFN,CDL2,J),U,7)=OVRIDE
- +14 SET $PIECE(ORCHECK(IFN,CDL,I),U,7)="X"
- End DoDot:6
- End DoDot:5
- End DoDot:4
- +15 IF $PIECE(ORCHECK(IFN,CDL,I),U,7)="X"
- KILL ORCHECK(IFN,CDL,I)
- SET ORCHECK=$GET(ORCHECK)-1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- 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))!(ORDG=+$ORDER(^ORD(100.98,"B","CI 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,DTOUT,DUOUT,DIRUT,DIROUT
- +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
- +7 ;
- SESSION ; -- SESSION event [called from ORCSIGN]
- +1 ; Expects ORVP, ORES()
- +2 KILL ^TMP($JOB,"ORK XTRA TXT")
- +3 if $$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E"
- QUIT
- +4 NEW ORX,ORY,ORIFN,I,X,Y,ORGLOB,ORCHKNM
- +5 SET ORGLOB=$HOROLOG
- +6 KILL ^TMP($JOB,ORGLOB)
- +7 SET ORIFN=0
- FOR
- SET ORIFN=$ORDER(ORES(ORIFN))
- if ORIFN'>0
- QUIT
- IF +$PIECE(ORIFN,";",2)'>1
- Begin DoDot:1
- +8 ;unreleased
- IF "^14^13^11^10^"'[(U_$PIECE($GET(^OR(100,+ORIFN,3)),U,3)_U)
- QUIT
- +9 DO BLD(+ORIFN)
- KILL ^TMP($JOB,"OCDATA")
- if '$$OCAPI^ORCHECK(+ORIFN,"OCDATA")
- QUIT
- +10 SET ORCHECK("IFN")=+$GET(ORCHECK("IFN"))+1
- +11 SET I=0
- FOR
- SET I=$ORDER(^TMP($JOB,"OCDATA",I))
- if 'I
- QUIT
- Begin DoDot:2
- +12 IF $GET(^TMP($JOB,"OCDATA",I,"OC NUMBER"))=32
- IF $$ALGASS(+ORIFN)=1
- QUIT
- +13 ;TDP
- IF $GET(^TMP($JOB,"OCDATA",I,"OC NUMBER"))=3
- IF $GET(^TMP($JOB,"OCDATA",I,"OR REASON"))=""
- IF $GET(^TMP($JOB,"OCDATA",I,"OC COMMENT"))=""
- QUIT
- +14 IF $GET(^TMP($JOB,"OCDATA",I,"OC TEXT",1,0))["Drug-Drug order checks (Duplicate Therapy, Duplicate Drug, Drug Interaction) were not able to be performed."
- QUIT
- +15 SET ORCHECK=+$GET(ORCHECK)+1
- SET ORCHECK(+ORIFN,$SELECT($GET(^TMP($JOB,"OCDATA",I,"OC LEVEL")):^TMP($JOB,"OCDATA",I,"OC LEVEL"),1:99),ORCHECK)=$GET(^TMP($JOB,"OCDATA",I,"OC NUMBER"))_U_$GET(^TMP($JOB,"OCDATA",I,"OC LEVEL"))_U_$GET(^TMP($JOB,"OCDATA",I,"
- OC TEXT",1,0))_U_1
- +16 ;TDP - Adding "OR REASON" and "OC COMMENT" checks
- +17 SET ORCHKNM=$NAME(ORCHECK(+ORIFN,$SELECT($GET(^TMP($JOB,"OCDATA",I,"OC LEVEL")):^TMP($JOB,"OCDATA",I,"OC LEVEL"),1:99),ORCHECK))
- +18 IF $GET(^TMP($JOB,"OCDATA",I,"OC COMMENT"))'=""
- Begin DoDot:3
- +19 SET $PIECE(@ORCHKNM,U,6)=$GET(^TMP($JOB,"OCDATA",I,"OC COMMENT"))
- End DoDot:3
- +20 IF $GET(^TMP($JOB,"OCDATA",I,"OR REASON"))'=""
- Begin DoDot:3
- +21 SET $PIECE(@ORCHKNM,U,7)=$GET(^TMP($JOB,"OCDATA",I,"OR REASON"))
- End DoDot:3
- +22 IF $ORDER(^TMP($JOB,"OCDATA",I,"OC TEXT",1))
- Begin DoDot:3
- +23 SET ORCHECK(+ORIFN,$SELECT($GET(^TMP($JOB,"OCDATA",I,"OC LEVEL")):^TMP($JOB,"OCDATA",I,"OC LEVEL"),1:99),ORCHECK)=$GET(^TMP($JOB,"OCDATA",I,"OC NUMBER"))_U_...
- ... $GET(^TMP($JOB,"OCDATA",I,"OC LEVEL"))_U_"||"_ORGLOB_"&"_$GET(^TMP($JOB,"OCDATA",I,"OC TEXT",1,0))_U_1
- +24 NEW ORI
- SET ORI=0
- FOR
- SET ORI=$ORDER(^TMP($JOB,"OCDATA",I,"OC TEXT",ORI))
- if 'ORI
- QUIT
- SET ^TMP($JOB,"ORK XTRA TXT",ORGLOB,^TMP($JOB,"OCDATA",I,"OC TEXT",1,0),ORI)=^TMP($JOB,"OCDATA",I,"OC TEXT",ORI,0)
- +25 IF ($GET(^TMP($JOB,"OCDATA",I,"OC NUMBER"))=35)!($GET(^TMP($JOB,"OCDATA",I,"OC NUMBER"))=36)
- Begin DoDot:4
- +26 NEW ORCROC1,ORCROC2,ORPIECE1,ORPIECE2
- +27 SET ORCROC1=$PIECE($GET(^ORD(100.05,^TMP($JOB,"OCDATA",I,"OC INSTANCE"),12)),U)
- +28 SET ORCROC2=$PIECE($GET(^ORD(100.05,^TMP($JOB,"OCDATA",I,"OC INSTANCE"),12)),U,2)
- +29 SET ORPIECE1=$GET(^TMP($JOB,"OCDATA",I,"OC NUMBER"))
- +30 SET ORPIECE2=$GET(^TMP($JOB,"OCDATA",I,"OC LEVEL"))_U_"||"_ORGLOB_"&"_$GET(^TMP($JOB,"OCDATA",I,"OC TEXT",1,0))_"&"_ORCROC1_"&"_ORCROC2_U_1
- +31 SET ORCHECK(+ORIFN,$SELECT($GET(^TMP($JOB,"OCDATA",I,"OC LEVEL")):^TMP($JOB,"OCDATA",I,"OC LEVEL"),1:99),ORCHECK)=ORPIECE1_U_ORPIECE2
- End DoDot:4
- End DoDot:3
- +32 IF $DATA(^ORD(100.05,^TMP($JOB,"OCDATA",I,"OC INSTANCE"),16))
- Begin DoDot:3
- +33 NEW ORMONOI
- SET ORMONOI=$ORDER(^TMP($JOB,"ORMONOGRAPH",""),-1)+1
- +34 MERGE ^TMP($JOB,"ORMONOGRAPH",ORMONOI,"DATA")=^ORD(100.05,^TMP($JOB,"OCDATA",I,"OC INSTANCE"),16)
- +35 SET ^TMP($JOB,"ORMONOGRAPH",ORMONOI,"INT")=^ORD(100.05,^TMP($JOB,"OCDATA",I,"OC INSTANCE"),17)
- +36 SET ^TMP($JOB,"ORMONOGRAPH",ORMONOI,"OC")=$GET(^TMP($JOB,"OCDATA",I,"OC TEXT",1,0))
- End DoDot:3
- End DoDot:2
- +37 KILL ^TMP($JOB,"OCDATA")
- End DoDot:1
- +38 IF $DATA(ORX)
- DO EN^ORKCHK(.ORY,+ORVP,.ORX,"SESSION")
- if $DATA(ORY)
- DO RETURN
- DO FDBDOWN(1)
- DO REMDUPS
- +39 QUIT
- +40 ;
- FDBDOWN(ORX) ; -- Checks to see if the FDB was down and if so set appropriate OC
- +1 ; expects ORCHECK array of order checks
- +2 ; if ORX is 1 then this is getting called from SESSION order checks
- +3 if '$DATA(ORCHECK)
- QUIT
- +4 ;look for the "not able to be performed" OCs for each type (DSG and ENH), set flag for each to 1 if found and remove them from ORCHECK
- +5 NEW I
- SET I=""
- FOR
- SET I=$ORDER(ORCHECK(I))
- if '$LENGTH(I)
- QUIT
- Begin DoDot:1
- +6 NEW ORNEXT,ORDSG,ORENH,ORTHERE
- +7 SET ORDSG=0
- SET ORENH=0
- SET ORTHERE=0
- SET ORNEXT=1
- +8 NEW J
- SET J=0
- FOR
- SET J=$ORDER(ORCHECK(I,J))
- if 'J
- QUIT
- Begin DoDot:2
- +9 NEW K
- SET K=0
- FOR
- SET K=$ORDER(ORCHECK(I,J,K))
- if 'K
- QUIT
- Begin DoDot:3
- +10 IF (K+1)>ORNEXT
- SET ORNEXT=K+1
- +11 IF $GET(ORCHECK(I,J,K))[$$DSDWNMSG^ORDSGCHK
- KILL ORCHECK(I,J,K)
- SET ORDSG=1
- +12 IF $GET(ORCHECK(I,J,K))["Drug-Drug order checks (Duplicate Therapy, Duplicate Drug, Drug Interaction) were not able to be performed."
- KILL ORCHECK(I,J,K)
- SET ORENH=1
- +13 IF $GET(ORCHECK(I,J,K))["These checks could not be completed for this patient:"
- SET ORTHERE=1
- End DoDot:3
- End DoDot:2
- +14 ;if DSG or ENH flag is set then add to ORY
- +15 IF ORDSG!(ORENH)
- Begin DoDot:2
- +16 ;look to see if message already exists
- +17 IF ORTHERE
- QUIT
- +18 NEW ORKGLOB
- SET ORKGLOB=$HOROLOG_","_I
- +19 NEW ORMAIN
- SET ORMAIN="These checks could not be completed for this patient:"
- +20 SET ORCHECK(I,2,ORNEXT)="25^2^||"_ORKGLOB_"&"_ORMAIN
- +21 IF $GET(ORX)
- SET ^TMP($JOB,"ORK XTRA TXT",ORKGLOB,ORMAIN,0)=ORMAIN
- +22 NEW ORCNT
- SET ORCNT=1
- +23 IF ORENH
- SET ORCNT=ORCNT+1
- SET ^TMP($JOB,"ORK XTRA TXT",ORKGLOB,ORMAIN,ORCNT)=" Drug Interactions"
- +24 IF ORENH
- SET ORCNT=ORCNT+1
- SET ^TMP($JOB,"ORK XTRA TXT",ORKGLOB,ORMAIN,ORCNT)=" Duplicate Therapy"
- +25 IF '$GET(ORX)
- IF ORDSG
- SET ORCNT=ORCNT+1
- SET ^TMP($JOB,"ORK XTRA TXT",ORKGLOB,ORMAIN,ORCNT)=" Dosing"
- End DoDot:2
- End DoDot:1
- +26 QUIT
- +27 ;
- 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,7)
- End DoDot:1
- +6 QUIT
- +7 ;
- ALGASS(ORIFN) ;see if patient from order has an allergy assessment
- +1 NEW ORDFN
- SET ORDFN=+$PIECE(^OR(100,ORIFN,0),U,2)
- +2 KILL ORARRAY
- DO EN1^GMRAOR1(ORDFN,"ORARRAY")
- +3 IF ORARRAY'=""
- QUIT 1
- +4 QUIT 0
- OCAPI(IFN,ORPLACE) ;IA #4859
- +1 ;LOOK AT ROUTINE OROCAPI1 FOR MORE DETAILED APIS
- +2 ;API to get the order checking info for a specific order (IFN)
- +3 ;info is stored in ^TMP($J,ORPLACE)
- +4 ; ^TMP($J,ORPLACE,D0,"OC LEVEL")="order check level"
- +5 ; ,"OC NUMBER")="file 100.8 ien"
- +6 ; ,"OC TEXT")="order check text"
- +7 ; ,"OR REASON")="over ride reason text"
- +8 ; ,"OC COMMENT")="remote allergy comment"
- +9 ; ,"OR PROVIDER")="provider DUZ who entered over ride reason"
- +10 ; ,"OR DT")="date/time over ride reason was entered"
- +11 ; NOTE on OC LEVEL: 1 is HIGH, 2 is MODERATE, 3 is LOW
- +12 NEW RET,ORN,CNT,I,ORFLAG
- +13 SET ORN=+IFN
- SET CNT=0
- SET ORFLAG=0
- +14 ;if the order is not released then show ACCEPTANCE_CPRS ocs
- +15 IF "^14^13^11^10^"[(U_$PIECE($GET(^OR(100,ORN,3)),U,3)_U)
- DO GETOC5^OROCAPI1(ORN,"ACCEPTANCE_CPRS",.RET)
- SET ORFLAG=1
- +16 ;if it has been signed then show SIGNATURE_CPRS ocs
- +17 IF 'ORFLAG
- DO GETOC5^OROCAPI1(ORN,"SIGNATURE_CPRS",.RET)
- +18 IF $DATA(RET)
- SET I=0
- FOR
- SET I=$ORDER(RET(ORN,"DATA",I))
- if 'I
- QUIT
- SET CNT=CNT+1
- Begin DoDot:1
- +19 SET ^TMP($JOB,ORPLACE,CNT,"OC NUMBER")=$PIECE($PIECE($GET(RET(ORN,"DATA",I,1)),U),";",2)
- +20 SET ^TMP($JOB,ORPLACE,CNT,"OC LEVEL")=$PIECE($GET(RET(ORN,"DATA",I,1)),U,2)
- +21 MERGE ^TMP($JOB,ORPLACE,CNT,"OC TEXT")=RET(ORN,"DATA",I,"OC")
- +22 SET ^TMP($JOB,ORPLACE,CNT,"OR REASON")=$GET(RET(ORN,"DATA",I,"OR",1,0))
- +23 ;TDP
- SET ^TMP($JOB,ORPLACE,CNT,"OC COMMENT")=$GET(RET(ORN,"DATA",I,"CM"))
- +24 SET ^TMP($JOB,ORPLACE,CNT,"OR PROVIDER")=$SELECT($LENGTH(^TMP($JOB,ORPLACE,CNT,"OR REASON")):$PIECE($GET(RET(ORN,"DATA",I,0)),U,4),1:"")
- +25 SET ^TMP($JOB,ORPLACE,CNT,"OR DT")=$SELECT($LENGTH(^TMP($JOB,ORPLACE,CNT,"OR REASON")):$PIECE($GET(RET(ORN,"DATA",I,0)),U,5),1:"")
- +26 SET ^TMP($JOB,ORPLACE,CNT,"OR STATUS")=$PIECE($GET(RET(ORN,"DATA",I,0)),U,2)
- +27 SET ^TMP($JOB,ORPLACE,CNT,"OC INSTANCE")=I
- End DoDot:1
- +28 QUIT CNT
- +29 ;
- ISMONO(ORY) ;returns 1 if there is monograph data for the orderchecks being presented to the user
- +1 SET ORY=0
- +2 if '$$PATCH^XPDUTL("OR*3.0*272")
- QUIT
- +3 IF $DATA(^TMP($JOB,"ORMONOGRAPH"))
- SET ORY=1
- +4 QUIT
- GETMONOL(ORY) ;returns a list of monographs available for the orderchecks being presented to the user
- +1 if '$DATA(^TMP($JOB,"ORMONOGRAPH"))
- QUIT
- +2 NEW I
- SET I=0
- +3 FOR
- SET I=$ORDER(^TMP($JOB,"ORMONOGRAPH",I))
- if 'I
- QUIT
- Begin DoDot:1
- +4 SET ORY($GET(^TMP($JOB,"ORMONOGRAPH",I,"INT")))=I_U_$GET(^TMP($JOB,"ORMONOGRAPH",I,"INT"))
- End DoDot:1
- +5 QUIT
- GETMONO(ORY,ORMONO) ;return a monograph
- +1 if '$DATA(^TMP($JOB,"ORMONOGRAPH",ORMONO))
- QUIT
- +2 KILL ^TMP($JOB,"ORMONORPC")
- +3 MERGE ^TMP($JOB,"ORMONORPC")=^TMP($JOB,"ORMONOGRAPH",ORMONO,"DATA")
- +4 KILL ^TMP($JOB,"ORMONORPC",0)
- +5 SET ORY=$NAME(^TMP($JOB,"ORMONORPC"))
- SET @ORY=""
- +6 QUIT
- DELMONO(ORY) ;delete monograph data
- +1 KILL ^TMP($JOB,"ORMONOGRAPH"),^TMP($JOB,"ORMONORPC")
- +2 QUIT
- GETXTRA(ORY,ORGL,ORRULE) ;get extra text for an order check
- +1 ;^TMP($J,"ORK XTRA TXT") stores the text of order checks that are longer than a single line (reminder order checks)
- +2 if '$DATA(^TMP($JOB,"ORK XTRA TXT",ORGL,ORRULE))
- QUIT
- +3 MERGE ORY=^TMP($JOB,"ORK XTRA TXT",ORGL,ORRULE)
- +4 QUIT