Released OR*3*352 SEQ #313 Extracted from mail message **KIDS**:OR*3.0*352^ **INSTALL NAME** OR*3.0*352 "BLD",8293,0) OR*3.0*352^ORDER ENTRY/RESULTS REPORTING^0^3120608^y "BLD",8293,1,0) ^^5^5^3120406^ "BLD",8293,1,1,0) This is a companion patch to the Medication Order Check Healthcare "BLD",8293,1,2,0) Application (MOCHA) version 1.0 Enhancements 1 group of patches that will "BLD",8293,1,3,0) resolve a number of issues with the Computerized Patient Record System "BLD",8293,1,4,0) (CPRS) version 3.0 order checking functionality. See the patch message for "BLD",8293,1,5,0) a full listing of issues addressed and installation instructions. "BLD",8293,4,0) ^9.64PA^100.05^1 "BLD",8293,4,100.05,0) 100.05 "BLD",8293,4,100.05,222) y^y^f^^^^n "BLD",8293,4,"B",100.05,100.05) "BLD",8293,6.3) 18 "BLD",8293,"ABPKG") n "BLD",8293,"INI") PRE^ORY352 "BLD",8293,"INID") ^n^n "BLD",8293,"INIT") QUEUE^ORY352 "BLD",8293,"KRN",0) ^9.67PA^779.2^20 "BLD",8293,"KRN",.4,0) .4 "BLD",8293,"KRN",.401,0) .401 "BLD",8293,"KRN",.402,0) .402 "BLD",8293,"KRN",.403,0) .403 "BLD",8293,"KRN",.5,0) .5 "BLD",8293,"KRN",.84,0) .84 "BLD",8293,"KRN",3.6,0) 3.6 "BLD",8293,"KRN",3.8,0) 3.8 "BLD",8293,"KRN",9.2,0) 9.2 "BLD",8293,"KRN",9.8,0) 9.8 "BLD",8293,"KRN",9.8,"NM",0) ^9.68A^4^3 "BLD",8293,"KRN",9.8,"NM",2,0) ORKPS1^^0^B76491746 "BLD",8293,"KRN",9.8,"NM",3,0) ORDSGCHK^^0^B90665074 "BLD",8293,"KRN",9.8,"NM",4,0) ORCHECK^^0^B109213586 "BLD",8293,"KRN",9.8,"NM","B","ORCHECK",4) "BLD",8293,"KRN",9.8,"NM","B","ORDSGCHK",3) "BLD",8293,"KRN",9.8,"NM","B","ORKPS1",2) "BLD",8293,"KRN",19,0) 19 "BLD",8293,"KRN",19.1,0) 19.1 "BLD",8293,"KRN",101,0) 101 "BLD",8293,"KRN",409.61,0) 409.61 "BLD",8293,"KRN",771,0) 771 "BLD",8293,"KRN",779.2,0) 779.2 "BLD",8293,"KRN",870,0) 870 "BLD",8293,"KRN",8989.51,0) 8989.51 "BLD",8293,"KRN",8989.52,0) 8989.52 "BLD",8293,"KRN",8994,0) 8994 "BLD",8293,"KRN","B",.4,.4) "BLD",8293,"KRN","B",.401,.401) "BLD",8293,"KRN","B",.402,.402) "BLD",8293,"KRN","B",.403,.403) "BLD",8293,"KRN","B",.5,.5) "BLD",8293,"KRN","B",.84,.84) "BLD",8293,"KRN","B",3.6,3.6) "BLD",8293,"KRN","B",3.8,3.8) "BLD",8293,"KRN","B",9.2,9.2) "BLD",8293,"KRN","B",9.8,9.8) "BLD",8293,"KRN","B",19,19) "BLD",8293,"KRN","B",19.1,19.1) "BLD",8293,"KRN","B",101,101) "BLD",8293,"KRN","B",409.61,409.61) "BLD",8293,"KRN","B",771,771) "BLD",8293,"KRN","B",779.2,779.2) "BLD",8293,"KRN","B",870,870) "BLD",8293,"KRN","B",8989.51,8989.51) "BLD",8293,"KRN","B",8989.52,8989.52) "BLD",8293,"KRN","B",8994,8994) "BLD",8293,"QUES",0) ^9.62^^ "BLD",8293,"REQB",0) ^9.611^3^2 "BLD",8293,"REQB",2,0) OR*3.0*346^2 "BLD",8293,"REQB",3,0) OR*3.0*357^2 "BLD",8293,"REQB","B","OR*3.0*346",2) "BLD",8293,"REQB","B","OR*3.0*357",3) "FIA",100.05) ORDER CHECK INSTANCES "FIA",100.05,0) ^ORD(100.05, "FIA",100.05,0,0) 100.05P "FIA",100.05,0,1) y^y^f^^^^n "FIA",100.05,0,10) "FIA",100.05,0,11) "FIA",100.05,0,"RLRO") "FIA",100.05,0,"VR") 3.0^OR "FIA",100.05,100.05) 0 "FIA",100.05,100.515) 0 "FIA",100.05,100.517) 0 "FIA",100.05,100.5173) 0 "FIA",100.05,100.5174) 0 "FIA",100.05,100.5175) 0 "FIA",100.05,100.57) 0 "FIA",100.05,100.58) 0 "INI") PRE^ORY352 "INIT") QUEUE^ORY352 "IX",100.05,100.05,"C",0) 100.05^C^USED FOR FINDING ORDER CHECKS BASED ON OCCURENCE^R^^R^IR^I^100.05^^^^^LS "IX",100.05,100.05,"C",.1,0) ^^2^2^3090121^ "IX",100.05,100.05,"C",.1,1,0) This Index is used to increase the performance of the lookup of order "IX",100.05,100.05,"C",.1,2,0) check instances based on the Occurrence descriptor and the Order number. "IX",100.05,100.05,"C",1) S ^ORD(100.05,"C",X(1),$E(X(2),1,30),DA)="" "IX",100.05,100.05,"C",2) K ^ORD(100.05,"C",X(1),$E(X(2),1,30),DA) "IX",100.05,100.05,"C",2.5) K ^ORD(100.05,"C") "IX",100.05,100.05,"C",11.1,0) ^.114IA^2^2 "IX",100.05,100.05,"C",11.1,1,0) 1^F^100.05^.01^^1^F "IX",100.05,100.05,"C",11.1,2,0) 2^F^100.05^2^30^2^F "IX",100.05,100.05,"D",0) 100.05^D^USED FOR FINDING ORDER CHECKS BASED ON OC TYPE^R^^F^IR^I^100.05^^^^^LS "IX",100.05,100.05,"D",1) S ^ORD(100.05,"D",X,DA)="" "IX",100.05,100.05,"D",2) K ^ORD(100.05,"D",X,DA) "IX",100.05,100.05,"D",2.5) K ^ORD(100.05,"D") "IX",100.05,100.05,"D",11.1,0) ^.114IA^2^1 "IX",100.05,100.05,"D",11.1,2,0) 1^F^100.05^5^^1^F "IX",100.05,100.05,"D",11.1,2,3) "MBREQ") 0 "PKG",170,-1) 1^1 "PKG",170,0) ORDER ENTRY/RESULTS REPORTING^OR^Order Entry/Results Reporting "PKG",170,20,0) ^9.402P^^ "PKG",170,22,0) ^9.49I^1^1 "PKG",170,22,1,0) 3.0^2971217^2980917^11712 "PKG",170,22,1,"PAH",1,0) 352^3120608^48 "PKG",170,22,1,"PAH",1,1,0) ^^5^5^3120608 "PKG",170,22,1,"PAH",1,1,1,0) This is a companion patch to the Medication Order Check Healthcare "PKG",170,22,1,"PAH",1,1,2,0) Application (MOCHA) version 1.0 Enhancements 1 group of patches that will "PKG",170,22,1,"PAH",1,1,3,0) resolve a number of issues with the Computerized Patient Record System "PKG",170,22,1,"PAH",1,1,4,0) (CPRS) version 3.0 order checking functionality. See the patch message for "PKG",170,22,1,"PAH",1,1,5,0) a full listing of issues addressed and installation instructions. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 4 "RTN","ORCHECK") 0^4^B109213586^B109458729 "RTN","ORCHECK",1,0) ORCHECK ;SLC/MKB-Order checking calls ;06/08/12 07:16 "RTN","ORCHECK",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,56,70,94,141,215,243,293,280,346,357,352**;Dec 17, 1997;Build 18 "RTN","ORCHECK",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","ORCHECK",4,0) DISPLAY ; -- DISPLAY event [called from ORCDLG,ORCACT4,ORCMED] "RTN","ORCHECK",5,0) ; Expects ORVP, ORNMSP, ORTAB, [ORWARD] "RTN","ORCHECK",6,0) Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" "RTN","ORCHECK",7,0) N ORX,ORY,I "RTN","ORCHECK",8,0) I ORNMSP="PS" D ;reset to PSJ, PSJI, or PSO "RTN","ORCHECK",9,0) . 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 "RTN","ORCHECK",10,0) . 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 "RTN","ORCHECK",11,0) S ORX(1)="|"_ORNMSP,ORX=1 "RTN","ORCHECK",12,0) D EN^ORKCHK(.ORY,+ORVP,.ORX,"DISPLAY") Q:'$D(ORY) "RTN","ORCHECK",13,0) S I=0 F S I=$O(ORY(I)) Q:I'>0 W !,$P(ORY(I),U,4) ; display only "RTN","ORCHECK",14,0) Q "RTN","ORCHECK",15,0) ; "RTN","ORCHECK",16,0) SELECT ; -- SELECT event "RTN","ORCHECK",17,0) ; Expects ORVP, ORDAILOG(PROMPT,ORI), ORNMSP "RTN","ORCHECK",18,0) Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" "RTN","ORCHECK",19,0) N ORX,ORY,OI "RTN","ORCHECK",20,0) S OI=+$G(ORDIALOG(PROMPT,ORI)) "RTN","ORCHECK",21,0) S ORX=1,ORX(1)=OI_"|"_ORNMSP_"|"_$$USID^ORMBLD(OI) "RTN","ORCHECK",22,0) D EN^ORKCHK(.ORY,+ORVP,.ORX,"SELECT"),RETURN:$D(ORY) "RTN","ORCHECK",23,0) Q "RTN","ORCHECK",24,0) ; "RTN","ORCHECK",25,0) ACCEPT(MODE) ; -- ACCEPT event [called from ORCDLG,ORCACT4,ORCMED] "RTN","ORCHECK",26,0) ; Expects ORVP, ORDIALOG(), ORNMSP "RTN","ORCHECK",27,0) K ^TMP($J,"ORK XTRA TXT") "RTN","ORCHECK",28,0) Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" "RTN","ORCHECK",29,0) N ORX,ORY,ORZ,OI,ORSTRT,ORI,ORIT,ORID,ORSP "RTN","ORCHECK",30,0) S:'$L($G(MODE)) MODE="ACCEPT" "RTN","ORCHECK",31,0) S OI=$$PTR^ORCD("OR GTX ORDERABLE ITEM"),ORSTRT=$$START,ORX=0 "RTN","ORCHECK",32,0) S ORI=0 F S ORI=$O(ORDIALOG(OI,ORI)) Q:ORI'>0 D STUF "RTN","ORCHECK",33,0) 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 "RTN","ORCHECK",34,0) D EN^ORKCHK(.ORY,+ORVP,.ORX,MODE),RETURN:$D(ORY),FDBDOWN(0) "RTN","ORCHECK",35,0) Q "RTN","ORCHECK",36,0) STUF S ORIT=ORDIALOG(OI,ORI),ORSP="" "RTN","ORCHECK",37,0) S:ORNMSP="LR" ORSP=+$G(ORDIALOG($$PTR^ORCD("OR GTX SPECIMEN"),ORI)) "RTN","ORCHECK",38,0) S ORID=$S($E(ORNMSP,1,2)="PS":$$DRUG(ORIT,OI),1:$$USID^ORMBLD(ORIT)) "RTN","ORCHECK",39,0) S ORZ=1,ORZ(1)=ORIT_"|"_ORNMSP_"|"_ORID "RTN","ORCHECK",40,0) I MODE'="ALL" D EN^ORKCHK(.ORY,+ORVP,.ORZ,"SELECT"),RETURN:$D(ORY) "RTN","ORCHECK",41,0) S ORX=ORX+1,ORX(ORX)=ORZ(1)_"|"_ORSTRT_"||"_ORSP K ORY,ORZ "RTN","ORCHECK",42,0) Q "RTN","ORCHECK",43,0) ; "RTN","ORCHECK",44,0) DELAY(MODE) ; -- Delayed ACCEPT event [called from ORMEVNT] "RTN","ORCHECK",45,0) ; Expects ORVP, ORIFN "RTN","ORCHECK",46,0) Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" "RTN","ORCHECK",47,0) N ORX,ORY,ORCHECK S:'$L($G(MODE)) MODE="NOTIF" "RTN","ORCHECK",48,0) D BLD(+ORIFN),EN^ORKCHK(.ORY,+ORVP,.ORX,MODE) Q:'$D(ORY) "RTN","ORCHECK",49,0) D RETURN I MODE="NOTIF" S ORCHECK("OK")="Notification sent to provider" D OC^ORCSAVE2 Q ; silent "RTN","ORCHECK",50,0) Q "RTN","ORCHECK",51,0) ; "RTN","ORCHECK",52,0) BLD(ORDER) ; -- Build new ORX(#) for ORDER "RTN","ORCHECK",53,0) Q:'$G(ORDER) Q:'$D(^OR(100,ORDER,0)) ;Q:$P($G(^(3)),U,11) ;edit/renew "RTN","ORCHECK",54,0) N PKG,START,ORI,ITEM,USID,SPEC,ORDG,PTR,INST "RTN","ORCHECK",55,0) S ORDG=$P(^OR(100,ORDER,0),U,11),PKG=$$GET1^DIQ(9.4,$P(^(0),U,14)_",",1) "RTN","ORCHECK",56,0) 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) "RTN","ORCHECK",57,0) S START=$$START(ORDER),ORI=0 "RTN","ORCHECK",58,0) F S ORI=$O(^OR(100,ORDER,4.5,"ID","ORDERABLE",ORI)) Q:ORI'>0 D "RTN","ORCHECK",59,0) . S INST=$P($G(^OR(100,ORDER,4.5,ORI,0)),U,3),PTR=$P($G(^(0)),U,2),ITEM=+$G(^(1)) "RTN","ORCHECK",60,0) . S USID=$S(PKG?1"PS".E:$$DRUG(ITEM,PTR,ORDER),1:$$USID^ORMBLD(ITEM)) "RTN","ORCHECK",61,0) . S SPEC=$S(PKG="LR":$$VALUE^ORCSAVE2(ORDER,"SPECIMEN",INST),1:"") "RTN","ORCHECK",62,0) . S ORX=+$G(ORX)+1,ORX(ORX)=ITEM_"|"_PKG_"|"_USID_"|"_START_"|"_ORDER_"|"_SPEC "RTN","ORCHECK",63,0) Q "RTN","ORCHECK",64,0) ; "RTN","ORCHECK",65,0) REMDUPS ; "RTN","ORCHECK",66,0) N IFN,CDL,I "RTN","ORCHECK",67,0) S IFN=0 F S IFN=$O(ORCHECK(IFN)) Q:'IFN D "RTN","ORCHECK",68,0) . S CDL=0 F S CDL=$O(ORCHECK(IFN,CDL)) Q:'CDL D "RTN","ORCHECK",69,0) . . S I=0 F S I=$O(ORCHECK(IFN,CDL,I)) Q:'I D "RTN","ORCHECK",70,0) . . . S J=I F S J=$O(ORCHECK(IFN,CDL,J)) Q:'J I $TR($P($G(ORCHECK(IFN,CDL,I)),U,3),";",",")=$TR($P($G(ORCHECK(IFN,CDL,J)),U,3),";",",") K ORCHECK(IFN,CDL,J) S ORCHECK=$G(ORCHECK)-1 "RTN","ORCHECK",71,0) Q "RTN","ORCHECK",72,0) START(DA) ; -- Returns start date/time "RTN","ORCHECK",73,0) N I,X,Y,%DT S Y="" "RTN","ORCHECK",74,0) I $G(DA) S X=$O(^OR(100,DA,4.5,"ID","START",0)),X=$G(^OR(100,DA,4.5,+X,1)) "RTN","ORCHECK",75,0) E D ; look in ORDIALOG instead "RTN","ORCHECK",76,0) . S I=0 F S I=$O(ORDIALOG(I)) Q:I'>0 Q:$P(ORDIALOG(I),U,2)="START" "RTN","ORCHECK",77,0) . S X=$S(I:$G(ORDIALOG(I,1)),1:"") "RTN","ORCHECK",78,0) D AM^ORCSAVE2:X="AM",NEXT^ORCSAVE2:X="NEXT" "RTN","ORCHECK",79,0) D ADMIN^ORCSAVE2("NEXT"):X="NEXTA",ADMIN^ORCSAVE2("CLOSEST"):X="CLOSEST" "RTN","ORCHECK",80,0) I $L(X) S %DT="TX" D ^%DT S:Y'>0 Y="" "RTN","ORCHECK",81,0) Q Y "RTN","ORCHECK",82,0) ; "RTN","ORCHECK",83,0) DRUG(OI,PTR,IFN) ; -- Returns 6 ^-piece identifier for Dispense Drug "RTN","ORCHECK",84,0) N ORDD,ORNDF,Y "RTN","ORCHECK",85,0) I ORDG=+$O(^ORD(100.98,"B","IV RX",0)) S ORDD=$$IV G D1 "RTN","ORCHECK",86,0) I $G(IFN) S ORDD=$O(^OR(100,IFN,4.5,"ID","DRUG",0)),ORDD=+$G(^OR(100,IFN,4.5,+ORDD,1)) "RTN","ORCHECK",87,0) E S ORDD=+$G(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1)) "RTN","ORCHECK",88,0) D1 Q:'ORDD "" S ORNDF=$$ENDCM^PSJORUTL(ORDD) "RTN","ORCHECK",89,0) S Y=$P(ORNDF,U,3)_"^^99NDF^"_ORDD_U_$$NAME50^ORPEAPI(ORDD)_"^99PSD" "RTN","ORCHECK",90,0) Q Y "RTN","ORCHECK",91,0) ; "RTN","ORCHECK",92,0) IV() ; -- Get Dispense Drug for IV orderable "RTN","ORCHECK",93,0) N PSOI,TYPE,VOL,ORY "RTN","ORCHECK",94,0) S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2),VOL="" "RTN","ORCHECK",95,0) S TYPE=$S(PTR=$$PTR^ORCD("OR GTX ADDITIVE"):"A",1:"B") "RTN","ORCHECK",96,0) S:TYPE="B" VOL=$S($G(IFN):$$VALUE^ORCSAVE2(IFN,"VOLUME"),1:+$G(ORDIALOG($$PTR^ORCD("OR GTX VOLUME"),1))) "RTN","ORCHECK",97,0) D ENDDIV^PSJORUTL(PSOI,TYPE,VOL,.ORY) "RTN","ORCHECK",98,0) Q +$G(ORY) "RTN","ORCHECK",99,0) ; "RTN","ORCHECK",100,0) LIST(IFN) ; -- Displays list of ORCHECK(IFN) checks "RTN","ORCHECK",101,0) N ORI,ORJ,ORZ,ORMAX,ORTX,ON,OFF "RTN","ORCHECK",102,0) S ORZ=0 F S ORZ=$O(ORCHECK(IFN,ORZ)) Q:ORZ'>0 D "RTN","ORCHECK",103,0) . S:ORZ=1 ON=IOINHI,OFF=IOINORM S:ORZ'=1 (ON,OFF)="" ; use bold if High "RTN","ORCHECK",104,0) . S ORI=0 F S ORI=$O(ORCHECK(IFN,ORZ,ORI)) Q:ORI'>0 D "RTN","ORCHECK",105,0) . . S X=$P(ORCHECK(IFN,ORZ,ORI),U,3) I $L(X)<75 W !,ON_">>> "_X_OFF Q "RTN","ORCHECK",106,0) . . S ORMAX=74 K ORTX D TXT^ORCHTAB Q:'$G(ORTX) ; wrap "RTN","ORCHECK",107,0) . . F ORJ=1:1:ORTX W !,ON_$S(ORJ=1:">>> ",1:" ")_ORTX(ORJ)_OFF "RTN","ORCHECK",108,0) W ! "RTN","ORCHECK",109,0) Q "RTN","ORCHECK",110,0) ; "RTN","ORCHECK",111,0) CANCEL() ; -- Returns 1 or 0: Cancel order(s)? "RTN","ORCHECK",112,0) N X,Y,DIR,NUM "RTN","ORCHECK",113,0) S NUM=+$G(ORCHECK("IFN")),DIR(0)="YA" "RTN","ORCHECK",114,0) S DIR("A")="Do you want to cancel "_$S(NUM>1:"any of the new orders? ",1:"the new order? ") "RTN","ORCHECK",115,0) S DIR("?",1)="Enter YES to cancel "_$S(NUM>1:"an",1:"the")_" order. If you wish to override these order checks" "RTN","ORCHECK",116,0) 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." "RTN","ORCHECK",117,0) D ^DIR "RTN","ORCHECK",118,0) Q +Y "RTN","ORCHECK",119,0) ; "RTN","ORCHECK",120,0) REASON() ; -- Reason for overriding order checks "RTN","ORCHECK",121,0) ; I '$D(^XUSEC("ORES",DUZ)),'$D(^XUSEC("ORELSE",DUZ)) Q ?? "RTN","ORCHECK",122,0) N X,Y,DIR "RTN","ORCHECK",123,0) S DIR(0)="FA^2:80^K:X?1."" "" X",DIR("A")="REASON FOR OVERRIDE: " "RTN","ORCHECK",124,0) S DIR("?")="Enter a justification for overriding these order checks, up to 80 characters" "RTN","ORCHECK",125,0) D ^DIR I $D(DTOUT)!$D(DUOUT) S Y="^" "RTN","ORCHECK",126,0) Q Y "RTN","ORCHECK",127,0) ; "RTN","ORCHECK",128,0) SESSION ; -- SESSION event [called from ORCSIGN] "RTN","ORCHECK",129,0) ; Expects ORVP, ORES() "RTN","ORCHECK",130,0) K ^TMP($J,"ORK XTRA TXT") "RTN","ORCHECK",131,0) Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")'="E" "RTN","ORCHECK",132,0) N ORX,ORY,ORIFN,I,X,Y,ORGLOB "RTN","ORCHECK",133,0) S ORGLOB=$H "RTN","ORCHECK",134,0) K ^TMP($J,ORGLOB) "RTN","ORCHECK",135,0) S ORIFN=0 F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 I +$P(ORIFN,";",2)'>1 D "RTN","ORCHECK",136,0) . I "^14^13^11^10^"'[(U_$P($G(^OR(100,+ORIFN,3)),U,3)_U) Q ;unreleased "RTN","ORCHECK",137,0) . D BLD(+ORIFN) K ^TMP($J,"OCDATA") Q:'$$OCAPI^ORCHECK(+ORIFN,"OCDATA") "RTN","ORCHECK",138,0) . S ORCHECK("IFN")=+$G(ORCHECK("IFN"))+1 "RTN","ORCHECK",139,0) . S I=0 F S I=$O(^TMP($J,"OCDATA",I)) Q:'I D "RTN","ORCHECK",140,0) . . I $G(^TMP($J,"OCDATA",I,"OC NUMBER"))=32,$$ALGASS(+ORIFN)=1 Q "RTN","ORCHECK",141,0) . . I $G(^TMP($J,"OCDATA",I,"OC NUMBER"))=3 Q "RTN","ORCHECK",142,0) . . 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 "RTN","ORCHECK",143,0) . . 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 "RTN","ORCHECK",144,0) . . I $O(^TMP($J,"OCDATA",I,"OC TEXT",1)) D "RTN","ORCHECK",145,0) . . . 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 "RTN","ORCHECK",146,0) . . . 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) "RTN","ORCHECK",147,0) . . I $D(^ORD(100.05,^TMP($J,"OCDATA",I,"OC INSTANCE"),16)) D "RTN","ORCHECK",148,0) . . . N ORMONOI S ORMONOI=$O(^TMP($J,"ORMONOGRAPH",""),-1)+1 "RTN","ORCHECK",149,0) . . . M ^TMP($J,"ORMONOGRAPH",ORMONOI,"DATA")=^ORD(100.05,^TMP($J,"OCDATA",I,"OC INSTANCE"),16) "RTN","ORCHECK",150,0) . . . S ^TMP($J,"ORMONOGRAPH",ORMONOI,"INT")=^ORD(100.05,^TMP($J,"OCDATA",I,"OC INSTANCE"),17) "RTN","ORCHECK",151,0) . . . S ^TMP($J,"ORMONOGRAPH",ORMONOI,"OC")=$G(^TMP($J,"OCDATA",I,"OC TEXT",1,0)) "RTN","ORCHECK",152,0) . K ^TMP($J,"OCDATA") "RTN","ORCHECK",153,0) I $D(ORX) D EN^ORKCHK(.ORY,+ORVP,.ORX,"SESSION"),RETURN:$D(ORY),FDBDOWN(1),REMDUPS "RTN","ORCHECK",154,0) Q "RTN","ORCHECK",155,0) ; "RTN","ORCHECK",156,0) FDBDOWN(ORX) ; -- Checks to see if the FDB was down and if so set appropriate OC "RTN","ORCHECK",157,0) ; expects ORCHECK array of order checks "RTN","ORCHECK",158,0) ; if ORX is 1 then this is getting called from SESSION order checks "RTN","ORCHECK",159,0) Q:'$D(ORCHECK) "RTN","ORCHECK",160,0) ;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 "RTN","ORCHECK",161,0) N I S I="" F S I=$O(ORCHECK(I)) Q:'$L(I) D "RTN","ORCHECK",162,0) .N ORNEXT,ORDSG,ORENH,ORTHERE "RTN","ORCHECK",163,0) .S ORDSG=0,ORENH=0,ORTHERE=0,ORNEXT=1 "RTN","ORCHECK",164,0) .N J S J=0 F S J=$O(ORCHECK(I,J)) Q:'J D "RTN","ORCHECK",165,0) ..N K S K=0 F S K=$O(ORCHECK(I,J,K)) Q:'K D "RTN","ORCHECK",166,0) ...I (K+1)>ORNEXT S ORNEXT=K+1 "RTN","ORCHECK",167,0) ...I $G(ORCHECK(I,J,K))["Drug Dosage checks were not able to be performed." K ORCHECK(I,J,K) S ORDSG=1 "RTN","ORCHECK",168,0) ...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 "RTN","ORCHECK",169,0) ...I $G(ORCHECK(I,J,K))["These checks could not be completed for this patient:" S ORTHERE=1 "RTN","ORCHECK",170,0) .;if DSG or ENH flag is set then add to ORY "RTN","ORCHECK",171,0) .I ORDSG!(ORENH) D "RTN","ORCHECK",172,0) ..;look to see if message already exists "RTN","ORCHECK",173,0) ..I ORTHERE Q "RTN","ORCHECK",174,0) ..N ORKGLOB S ORKGLOB=$H "RTN","ORCHECK",175,0) ..N ORMAIN S ORMAIN="These checks could not be completed for this patient:" "RTN","ORCHECK",176,0) ..S ORCHECK(I,2,ORNEXT)="25^2^||"_ORKGLOB_"&"_ORMAIN "RTN","ORCHECK",177,0) ..I $G(ORX) S ^TMP($J,"ORK XTRA TXT",ORKGLOB,ORMAIN,0)=ORMAIN "RTN","ORCHECK",178,0) ..N ORCNT S ORCNT=1 "RTN","ORCHECK",179,0) ..I ORENH S ORCNT=ORCNT+1,^TMP($J,"ORK XTRA TXT",ORKGLOB,ORMAIN,ORCNT)=" Drug Interactions" "RTN","ORCHECK",180,0) ..I ORENH S ORCNT=ORCNT+1,^TMP($J,"ORK XTRA TXT",ORKGLOB,ORMAIN,ORCNT)=" Duplicate Therapy" "RTN","ORCHECK",181,0) ..I '$G(ORX),ORDSG S ORCNT=ORCNT+1,^TMP($J,"ORK XTRA TXT",ORKGLOB,ORMAIN,ORCNT)=" Dosing" "RTN","ORCHECK",182,0) Q "RTN","ORCHECK",183,0) ; "RTN","ORCHECK",184,0) RETURN ; -- Return checks in ORCHECK(ORIFN,CDL,#) "RTN","ORCHECK",185,0) N I,IFN,CDL S I=0 F S I=$O(ORY(I)) Q:I'>0 D "RTN","ORCHECK",186,0) . S IFN=+$P(ORY(I),U) S:'IFN IFN="NEW" "RTN","ORCHECK",187,0) . S CDL=+$P(ORY(I),U,3) S:'CDL CDL=99 "RTN","ORCHECK",188,0) . S:'$D(ORCHECK(IFN)) ORCHECK("IFN")=+$G(ORCHECK("IFN"))+1 ; count "RTN","ORCHECK",189,0) . S ORCHECK=+$G(ORCHECK)+1,ORCHECK(IFN,CDL,ORCHECK)=$P(ORY(I),U,2,4) "RTN","ORCHECK",190,0) Q "RTN","ORCHECK",191,0) ; "RTN","ORCHECK",192,0) ALGASS(ORIFN) ;see if patient from order has an allergy assessment "RTN","ORCHECK",193,0) N ORDFN S ORDFN=+$P(^OR(100,ORIFN,0),U,2) "RTN","ORCHECK",194,0) K ORARRAY D EN1^GMRAOR1(ORDFN,"ORARRAY") "RTN","ORCHECK",195,0) I ORARRAY'="" Q 1 "RTN","ORCHECK",196,0) Q 0 "RTN","ORCHECK",197,0) OCAPI(IFN,ORPLACE) ;IA #4859 "RTN","ORCHECK",198,0) ;LOOK AT ROUTINE OROCAPI1 FOR MORE DETAILED APIS "RTN","ORCHECK",199,0) ;API to get the order checking info for a specific order (IFN) "RTN","ORCHECK",200,0) ;info is stored in ^TMP($J,ORPLACE) "RTN","ORCHECK",201,0) ; ^TMP($J,ORPLACE,D0,"OC LEVEL")="order check level" "RTN","ORCHECK",202,0) ; ,"OC NUMBER")="file 100.8 ien" "RTN","ORCHECK",203,0) ; ,"OC TEXT")="order check text" "RTN","ORCHECK",204,0) ; ,"OR REASON")="over ride reason text" "RTN","ORCHECK",205,0) ; ,"OR PROVIDER")="provider DUZ who entered over ride reason" "RTN","ORCHECK",206,0) ; ,"OR DT")="date/time over ride reason was entered" "RTN","ORCHECK",207,0) ; NOTE on OC LEVEL: 1 is HIGH, 2 is MODERATE, 3 is LOW "RTN","ORCHECK",208,0) N RET,ORN,CNT,I,ORFLAG "RTN","ORCHECK",209,0) S ORN=+IFN,CNT=0,ORFLAG=0 "RTN","ORCHECK",210,0) ;if the order is not released then show ACCEPTANCE_CPRS ocs "RTN","ORCHECK",211,0) 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 "RTN","ORCHECK",212,0) ;if it has been signed then show SIGNATURE_CPRS ocs "RTN","ORCHECK",213,0) I 'ORFLAG D GETOC5^OROCAPI1(ORN,"SIGNATURE_CPRS",.RET) "RTN","ORCHECK",214,0) I $D(RET) S I=0 F S I=$O(RET(ORN,"DATA",I)) Q:'I S CNT=CNT+1 D "RTN","ORCHECK",215,0) .S ^TMP($J,ORPLACE,CNT,"OC NUMBER")=$P($G(RET(ORN,"DATA",I,1)),U) "RTN","ORCHECK",216,0) .S ^TMP($J,ORPLACE,CNT,"OC LEVEL")=$P($G(RET(ORN,"DATA",I,1)),U,2) "RTN","ORCHECK",217,0) .M ^TMP($J,ORPLACE,CNT,"OC TEXT")=RET(ORN,"DATA",I,"OC") "RTN","ORCHECK",218,0) .S ^TMP($J,ORPLACE,CNT,"OR REASON")=$G(RET(ORN,"DATA",I,"OR",1,0)) "RTN","ORCHECK",219,0) .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:"") "RTN","ORCHECK",220,0) .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:"") "RTN","ORCHECK",221,0) .S ^TMP($J,ORPLACE,CNT,"OR STATUS")=$P($G(RET(ORN,"DATA",I,0)),U,2) "RTN","ORCHECK",222,0) .S ^TMP($J,ORPLACE,CNT,"OC INSTANCE")=I "RTN","ORCHECK",223,0) Q CNT "RTN","ORCHECK",224,0) ; "RTN","ORCHECK",225,0) ISMONO(ORY) ;returns 1 if there is monograph data for the orderchecks being presented to the user "RTN","ORCHECK",226,0) S ORY=0 "RTN","ORCHECK",227,0) Q:'$$PATCH^XPDUTL("OR*3.0*272") "RTN","ORCHECK",228,0) I $D(^TMP($J,"ORMONOGRAPH")) S ORY=1 "RTN","ORCHECK",229,0) Q "RTN","ORCHECK",230,0) GETMONOL(ORY) ;returns a list of monographs available for the orderchecks being presented to the user "RTN","ORCHECK",231,0) Q:'$D(^TMP($J,"ORMONOGRAPH")) "RTN","ORCHECK",232,0) N I S I=0 "RTN","ORCHECK",233,0) F S I=$O(^TMP($J,"ORMONOGRAPH",I)) Q:'I D "RTN","ORCHECK",234,0) .S ORY($G(^TMP($J,"ORMONOGRAPH",I,"INT")))=I_U_$G(^TMP($J,"ORMONOGRAPH",I,"INT")) "RTN","ORCHECK",235,0) Q "RTN","ORCHECK",236,0) GETMONO(ORY,ORMONO) ;return a monograph "RTN","ORCHECK",237,0) Q:'$D(^TMP($J,"ORMONOGRAPH",ORMONO)) "RTN","ORCHECK",238,0) K ^TMP($J,"ORMONORPC") "RTN","ORCHECK",239,0) M ^TMP($J,"ORMONORPC")=^TMP($J,"ORMONOGRAPH",ORMONO,"DATA") "RTN","ORCHECK",240,0) K ^TMP($J,"ORMONORPC",0) "RTN","ORCHECK",241,0) S ORY=$NA(^TMP($J,"ORMONORPC")),@ORY="" "RTN","ORCHECK",242,0) Q "RTN","ORCHECK",243,0) DELMONO(ORY) ;delete monograph data "RTN","ORCHECK",244,0) K ^TMP($J,"ORMONOGRAPH"),^TMP($J,"ORMONORPC") "RTN","ORCHECK",245,0) Q "RTN","ORCHECK",246,0) GETXTRA(ORY,ORGL,ORRULE) ;get extra text for an order check "RTN","ORCHECK",247,0) ;^TMP($J,"ORK XTRA TXT") stores the text of order checks that are longer than a single line (reminder order checks) "RTN","ORCHECK",248,0) Q:'$D(^TMP($J,"ORK XTRA TXT",ORGL,ORRULE)) "RTN","ORCHECK",249,0) M ORY=^TMP($J,"ORK XTRA TXT",ORGL,ORRULE) "RTN","ORCHECK",250,0) Q "RTN","ORDSGCHK") 0^3^B90665074^B89700507 "RTN","ORDSGCHK",1,0) ORDSGCHK ; SLC/AGP - PRE 0.5 DOSE ORDER CHECKS;02/29/2012 08:12 "RTN","ORDSGCHK",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**280,352**;Dec 17, 1997;Build 18 "RTN","ORDSGCHK",3,0) ; "RTN","ORDSGCHK",4,0) EN(ORY,DFN,TYPE,OIL) ; "RTN","ORDSGCHK",5,0) N ARRAY,CNT,NAME "RTN","ORDSGCHK",6,0) ;if renewed order build OIL array "RTN","ORDSGCHK",7,0) I $G(ORREN)=1,+$G(ORIFN)>0 D "RTN","ORDSGCHK",8,0) .;IV orders should only have a null type "RTN","ORDSGCHK",9,0) .I TYPE="" S TYPE="PSIV" "RTN","ORDSGCHK",10,0) .D BLDREN(TYPE,ORIFN,.OIL) "RTN","ORDSGCHK",11,0) ;Build easy array to work with "RTN","ORDSGCHK",12,0) S CNT=0 F S CNT=$O(OIL(CNT)) Q:CNT'>0 D "RTN","ORDSGCHK",13,0) .S NODE=$G(OIL(CNT)) Q:$P(NODE,U,2)="PSIV" "RTN","ORDSGCHK",14,0) .S NAME=$P(NODE,U,2) "RTN","ORDSGCHK",15,0) .Q:'$P(NODE,U,3) "RTN","ORDSGCHK",16,0) .S ARRAY(NAME,$P(NODE,U,3))=NODE "RTN","ORDSGCHK",17,0) I TYPE="PSIV" D IV(.ORY,DFN,.ARRAY) "RTN","ORDSGCHK",18,0) I TYPE'="PSIV" D NONIV(.ORY,DFN,.ARRAY) "RTN","ORDSGCHK",19,0) ;I TYPE="PSO"!(TYPE="PSI") D NONIV(.ORY,DFN,.ARRAY) "RTN","ORDSGCHK",20,0) Q "RTN","ORDSGCHK",21,0) ; "RTN","ORDSGCHK",22,0) BLDREN(TYPE,ORIFN,OUT) ; "RTN","ORDSGCHK",23,0) N CNT,EXTVALUE,ISOI,ITEM,LOC,NAME,NUM,NODE,ORDIALOG,TEXT,VALUE,X0 "RTN","ORDSGCHK",24,0) S CNT=$O(OUT(""),-1) "RTN","ORDSGCHK",25,0) S X0=$G(^OR(100,+ORIFN,0)) "RTN","ORDSGCHK",26,0) S ORDIALOG=+$P(X0,U,5) "RTN","ORDSGCHK",27,0) D GETDLG^ORCD(ORDIALOG) "RTN","ORDSGCHK",28,0) D GETORDER^ORCD(+ORIFN) "RTN","ORDSGCHK",29,0) S LOC=0 F S LOC=$O(ORDIALOG(LOC)) Q:LOC'>0 D "RTN","ORDSGCHK",30,0) .S ITEM=$P($G(ORDIALOG(LOC)),U,2) "RTN","ORDSGCHK",31,0) .I ITEM="" Q "RTN","ORDSGCHK",32,0) .I ITEM="COMMENT" Q "RTN","ORDSGCHK",33,0) .S ISOI=$S($G(ORDIALOG(LOC,0))[101.43:1,1:0) "RTN","ORDSGCHK",34,0) .S NUM=0 F S NUM=$O(ORDIALOG(LOC,NUM)) Q:NUM'>0 D "RTN","ORDSGCHK",35,0) ..I NUM<1 Q "RTN","ORDSGCHK",36,0) ..S VALUE=$G(ORDIALOG(LOC,NUM)),EXTVALUE="" "RTN","ORDSGCHK",37,0) ..I ISOI=1 D "RTN","ORDSGCHK",38,0) ...S EXTVALUE=$P($G(^ORD(101.43,VALUE,0)),U) "RTN","ORDSGCHK",39,0) ...I $P($G(^ORD(101.41,LOC,0)),U)="OR GTX ADDITIVE" S ITEM="ADDITIVE" "RTN","ORDSGCHK",40,0) ..I ITEM="RATE" S EXTVALUE=VALUE "RTN","ORDSGCHK",41,0) ..S TEXT=TYPE_U_ITEM_U_NUM_U_VALUE_U_EXTVALUE "RTN","ORDSGCHK",42,0) ..S CNT=CNT+1,OUT(CNT)=TEXT "RTN","ORDSGCHK",43,0) Q "RTN","ORDSGCHK",44,0) ; "RTN","ORDSGCHK",45,0) DURATION(STR) ; "RTN","ORDSGCHK",46,0) N LEN,VAL,UNIT,IVLMT,TVAL "RTN","ORDSGCHK",47,0) S (UNIT,IVLMT)="",VAL=0 "RTN","ORDSGCHK",48,0) I $E($$LOW^XLFSTR(STR))="f" D "RTN","ORDSGCHK",49,0) . I STR["for a total of" D Q "RTN","ORDSGCHK",50,0) . .S VAL=$P(STR," ",5) "RTN","ORDSGCHK",51,0) . .S UNIT=$P(STR," ",6) "RTN","ORDSGCHK",52,0) . .S STR="" "RTN","ORDSGCHK",53,0) . S VAL=$P(STR," ",2) "RTN","ORDSGCHK",54,0) . S UNIT=$E($P(STR," ",3)) "RTN","ORDSGCHK",55,0) . S STR="" "RTN","ORDSGCHK",56,0) I $E($$LOW^XLFSTR(STR))="w" D "RTN","ORDSGCHK",57,0) . S TVAL=$P(STR," ",4) "RTN","ORDSGCHK",58,0) . S VAL=+TVAL "RTN","ORDSGCHK",59,0) . S LEN=$F(TVAL,VAL) "RTN","ORDSGCHK",60,0) . I $P(VAL,".")="" S VAL=0_VAL "RTN","ORDSGCHK",61,0) . F S UNIT=$E(TVAL,LEN) Q:((UNIT'=0)&(UNIT'=".")) D "RTN","ORDSGCHK",62,0) . . S LEN=LEN+1 "RTN","ORDSGCHK",63,0) . S STR="" "RTN","ORDSGCHK",64,0) I $L(UNIT),$L(VAL) S IVLMT=VAL_$$UP^XLFSTR(UNIT) "RTN","ORDSGCHK",65,0) I STR'="",IVLMT="" D "RTN","ORDSGCHK",66,0) .I STR["ML" S IVLMT=$P(STR,"M")_"M" Q "RTN","ORDSGCHK",67,0) .I STR["CC" S IVLMT=$P(STR,"C")_"M" Q "RTN","ORDSGCHK",68,0) .S IVLMT=STR "RTN","ORDSGCHK",69,0) Q IVLMT "RTN","ORDSGCHK",70,0) ; "RTN","ORDSGCHK",71,0) IV(ORY,DFN,ARRAY) ; "RTN","ORDSGCHK",72,0) N CNT,DRUG,DRUGIEN,DRUGNAME,NAME,NUM,OI,ORBASE,ORPSJARR,STR,STRENGTH "RTN","ORDSGCHK",73,0) ; "RTN","ORDSGCHK",74,0) ;populate single values from order "RTN","ORDSGCHK",75,0) S ORPSJARR("TVOL_DUR")="",ORPSJARR("SCHEDULE")="" "RTN","ORDSGCHK",76,0) I $D(ARRAY("DAYS")) S ORPSJARR("TVOL_DUR")=$$DURATION($P(ARRAY("DAYS",1),U,4)) "RTN","ORDSGCHK",77,0) ;S RATE=$P(ARRAY(NAME,1),U,4) "RTN","ORDSGCHK",78,0) S ORPSJARR("MR_IEN")=$P(ARRAY("ROUTE",1),U,4) "RTN","ORDSGCHK",79,0) I $D(ARRAY("SCHEDULE")) S ORPSJARR("SCHEDULE")=$P(ARRAY("SCHEDULE",1),U,4) "RTN","ORDSGCHK",80,0) S ORPSJARR("IV_TYPE")=$S($P(ARRAY("TYPE",1),U,4)="I":1,1:2) "RTN","ORDSGCHK",81,0) I ORPSJARR("IV_TYPE")=2 S ORPSJARR("INF_RATE")=$P(ARRAY("RATE",1),U,5) "RTN","ORDSGCHK",82,0) ; "RTN","ORDSGCHK",83,0) ;build additive first, Drug, Strength/unit, bag "RTN","ORDSGCHK",84,0) F NAME="ADDITIVE","ORDERABLE" D "RTN","ORDSGCHK",85,0) .K DRUG "RTN","ORDSGCHK",86,0) .S CNT=0,NUM=0 "RTN","ORDSGCHK",87,0) .F S NUM=$O(ARRAY(NAME,NUM)) Q:NUM'>0 D "RTN","ORDSGCHK",88,0) ..S CNT=CNT+1 "RTN","ORDSGCHK",89,0) ..S NODE=$G(ARRAY(NAME,NUM)),OI=$P(NODE,U,4) "RTN","ORDSGCHK",90,0) ..; "RTN","ORDSGCHK",91,0) ..S DRUGIEN=+$P(^ORD(101.43,OI,0),U,2) I DRUGIEN="" Q ;PHARMACY OI FROM 101.43 "RTN","ORDSGCHK",92,0) ..S DRUGNAME=$P($G(ARRAY(NAME,NUM)),U,5) ;OI NAME "RTN","ORDSGCHK",93,0) ..; "RTN","ORDSGCHK",94,0) ..I NAME="ADDITIVE" D Q "RTN","ORDSGCHK",95,0) ...S STRENGTH=$P($G(ARRAY("STRENGTH",NUM)),U,4)_" "_$P($G(ARRAY("UNITS",NUM)),U,4) "RTN","ORDSGCHK",96,0) ...S STR=+DRUGIEN_U_DRUGNAME_U_STRENGTH_U_$P($G(ARRAY("ADDFREQ",NUM)),U,4) "RTN","ORDSGCHK",97,0) ...S ORPSJARR("AD",CNT)=STR "RTN","ORDSGCHK",98,0) ..; "RTN","ORDSGCHK",99,0) ..;Soltution information "RTN","ORDSGCHK",100,0) ..S STR=+DRUGIEN_U_DRUGNAME_U_$P($G(ARRAY("VOLUME",NUM)),U,4)_" ML" "RTN","ORDSGCHK",101,0) ..S ORPSJARR("SOL",CNT)=STR "RTN","ORDSGCHK",102,0) ; "RTN","ORDSGCHK",103,0) S ORBASE(1)="ORDSGCHK1" "RTN","ORDSGCHK",104,0) S ORBASE(2)="ORDSGCHK2" "RTN","ORDSGCHK",105,0) D DOSE^PSJAPIDS(.ORBASE,DFN,.ORPSJARR) "RTN","ORDSGCHK",106,0) D PARSEOUT "RTN","ORDSGCHK",107,0) Q "RTN","ORDSGCHK",108,0) ; "RTN","ORDSGCHK",109,0) NONIV(ORY,DFN,ARRAY) ; "RTN","ORDSGCHK",110,0) N CNT,DOSESTR,DRUG,DRUGARR,DRUGIEN,DRUGNAME,DUR,NAME,NODE "RTN","ORDSGCHK",111,0) N OIIEN,ORBASE,ORDRUG,ORPSARR,PACK,PSNODE,SUB,TYPE,USAGE "RTN","ORDSGCHK",112,0) ; "RTN","ORDSGCHK",113,0) ;assume same drug type used throughout the order dialog "RTN","ORDSGCHK",114,0) ;free text dose do not have a drug. "RTN","ORDSGCHK",115,0) S DRUGIEN=$P($G(ARRAY("DRUG",1)),U,4) "RTN","ORDSGCHK",116,0) I +DRUGIEN>0,$$EXMT^PSSDSAPI(DRUGIEN)=1 Q "RTN","ORDSGCHK",117,0) ;if no ARRAY(DOSE) node set it to null to force free text evaluation "RTN","ORDSGCHK",118,0) ;I '$D(ARRAY("DOSE")),$D(ARRAY("INSTR")) N I S I=0 F S I=$O(ARRAY("INSTR",I)) Q:'I S ARRAY("DOSE",I)=$P(ARRAY("INSTR",I),U)_"^DOSE^"_I_"^" "RTN","ORDSGCHK",119,0) N I S I=0 F S I=$O(ARRAY("INSTR",I)) Q:'I I '$D(ARRAY("DOSE",I)) S ARRAY("DOSE",I)=$P(ARRAY("INSTR",I),U)_"^DOSE^"_I_"^" "RTN","ORDSGCHK",120,0) ; "RTN","ORDSGCHK",121,0) S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D "RTN","ORDSGCHK",122,0) .S SUB=$$GETSUB(NAME) I SUB="" Q "RTN","ORDSGCHK",123,0) .S CNT=0 F S CNT=$O(ARRAY(NAME,CNT)) Q:CNT'>0 D "RTN","ORDSGCHK",124,0) ..S NODE=$G(ARRAY(NAME,CNT)) "RTN","ORDSGCHK",125,0) ..; "RTN","ORDSGCHK",126,0) ..;get dose information and drug information from Dose Prompt "RTN","ORDSGCHK",127,0) ..I SUB="DOSE" D "RTN","ORDSGCHK",128,0) ...S PACK=$P(NODE,U) "RTN","ORDSGCHK",129,0) ...S TYPE=$S($P(NODE,U)="PSO":"O",1:"I") "RTN","ORDSGCHK",130,0) ...S DOSESTR=$P(NODE,U,4) "RTN","ORDSGCHK",131,0) ...; "RTN","ORDSGCHK",132,0) ...;free text dose "RTN","ORDSGCHK",133,0) ...I DOSESTR="" D Q "RTN","ORDSGCHK",134,0) ....N ORQUIT S ORQUIT=0 "RTN","ORDSGCHK",135,0) ....I $G(ORREN)=1 D "RTN","ORDSGCHK",136,0) .....N PSIFN S PSIFN=$G(^OR(100,+ORIFN,4)) "RTN","ORDSGCHK",137,0) .....S:TYPE="O" PSIFN=$TR(PSIFN,"S","P")_$S(PSIFN?1.N:"R",1:"") "RTN","ORDSGCHK",138,0) .....K ^TMP("PS",$J) "RTN","ORDSGCHK",139,0) .....D OEL^PSOORRL(DFN,PSIFN_";"_TYPE) ;DBIA 2400 "RTN","ORDSGCHK",140,0) .....I '$D(^TMP("PS",$J)) Q "RTN","ORDSGCHK",141,0) .....S ORPSARR(CNT,"DO")=$P($G(ARRAY("INSTR",CNT)),U,4) "RTN","ORDSGCHK",142,0) .....S ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT "RTN","ORDSGCHK",143,0) .....S ORDRUG(CNT,"DRUG_IEN")=+$G(^TMP("PS",$J,"DD",1,0)) "RTN","ORDSGCHK",144,0) .....S ORDRUG(CNT,"DRUG_NM")=$P($G(^TMP("PS",$J,0)),U) "RTN","ORDSGCHK",145,0) .....S ORQUIT=1 "RTN","ORDSGCHK",146,0) .....K ^TMP("PS",$J) "RTN","ORDSGCHK",147,0) ....I ORQUIT=1 Q "RTN","ORDSGCHK",148,0) ....S ORPSARR(CNT,"DO")=$P($G(ARRAY("INSTR",CNT)),U,4) "RTN","ORDSGCHK",149,0) ....S ORDRUG(CNT,"DRUG_NM")=$P($G(ARRAY("ORDERABLE",1)),U,5) "RTN","ORDSGCHK",150,0) ....S ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT "RTN","ORDSGCHK",151,0) ....;S OIIEN=$P($G(ARRAY("ORDERABLE",CNT)),U,4) "RTN","ORDSGCHK",152,0) ....S OIIEN=$P($G(ARRAY("ORDERABLE",1)),U,4) ;orderable only exists for first item (in complex order) "RTN","ORDSGCHK",153,0) ....S ORDRUG("OI")=+$P($G(^ORD(101.43,OIIEN,0)),U,2) "RTN","ORDSGCHK",154,0) ....S ORDRUG("PACKAGE")=$S(PACK="PSO":"O",PACK="PSH":"X",1:"I") "RTN","ORDSGCHK",155,0) ....S PSNODE=$G(^ORD(101.43,OIIEN,"PS")),USAGE="" "RTN","ORDSGCHK",156,0) ....I $P(PSNODE,U,4)=1 S USAGE=USAGE_"A" "RTN","ORDSGCHK",157,0) ....I $P(PSNODE,U,3)=1 S USAGE=USAGE_"B" "RTN","ORDSGCHK",158,0) ....S ORDRUG("OI_USAGE")=USAGE "RTN","ORDSGCHK",159,0) ...; "RTN","ORDSGCHK",160,0) ...S DRUGIEN=$P(DOSESTR,"&",6) "RTN","ORDSGCHK",161,0) ...K ^TMP($J,"DRUGARR") "RTN","ORDSGCHK",162,0) ...D ZERO^PSS50(DRUGIEN,,,,,"DRUGARR") "RTN","ORDSGCHK",163,0) ...S DRUGNAME=$G(^TMP($J,"DRUGARR",DRUGIEN,.01)) "RTN","ORDSGCHK",164,0) ...K ^TMP($J,"DRUGARR") "RTN","ORDSGCHK",165,0) ...; "RTN","ORDSGCHK",166,0) ...;Local Possible Dose "RTN","ORDSGCHK",167,0) ...I $P(DOSESTR,"&")="" D Q "RTN","ORDSGCHK",168,0) ....S ORPSARR(CNT,"DO")=$P($G(ARRAY("INSTR",CNT)),U,4) "RTN","ORDSGCHK",169,0) ....S ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT "RTN","ORDSGCHK",170,0) ....S ORDRUG(CNT,"DRUG_IEN")=DRUGIEN "RTN","ORDSGCHK",171,0) ....S ORDRUG(CNT,"DRUG_NM")=$P($G(ARRAY("ORDERABLE",1)),U,5) ;DRUGNAME "RTN","ORDSGCHK",172,0) ...; "RTN","ORDSGCHK",173,0) ...;Possible Dose "RTN","ORDSGCHK",174,0) ...S ORPSARR(CNT,"DRG_AMT")=$P(DOSESTR,"&") "RTN","ORDSGCHK",175,0) ...S ORPSARR(CNT,"DRG_UNIT")=$P(DOSESTR,"&",2) "RTN","ORDSGCHK",176,0) ...S ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT "RTN","ORDSGCHK",177,0) ...S ORDRUG(CNT,"DRUG_IEN")=DRUGIEN "RTN","ORDSGCHK",178,0) ...S ORDRUG(CNT,"DRUG_NM")=$P($G(ARRAY("ORDERABLE",1)),U,5) ;DRUGNAME "RTN","ORDSGCHK",179,0) ..; "RTN","ORDSGCHK",180,0) ..;Additional Order Data "RTN","ORDSGCHK",181,0) ..I SUB="DRATE" D Q "RTN","ORDSGCHK",182,0) ...S DUR=$P($P(NODE,U,4)," ") "RTN","ORDSGCHK",183,0) ...;S DUR=DUR_$E($P($P(NODE,U,4)," "),1) "RTN","ORDSGCHK",184,0) ...S ORPSARR(CNT,SUB)=DUR_$$DRATESTR($P($P(NODE,U,4)," ",2)) "RTN","ORDSGCHK",185,0) ..S ORPSARR(CNT,SUB)=$P(NODE,U,4) "RTN","ORDSGCHK",186,0) ; "RTN","ORDSGCHK",187,0) S ORBASE(1)="ORDSGCHK1" "RTN","ORDSGCHK",188,0) S ORBASE(2)="ORDSGCHK2" "RTN","ORDSGCHK",189,0) D DOSE^PSSDSAPD(.ORBASE,DFN,.ORPSARR,.ORDRUG) "RTN","ORDSGCHK",190,0) D PARSEOUT "RTN","ORDSGCHK",191,0) Q "RTN","ORDSGCHK",192,0) ; "RTN","ORDSGCHK",193,0) PARSEOUT ;PARSE OUTPUT GLOBAL "RTN","ORDSGCHK",194,0) N ORNBP S ORNBP="" "RTN","ORDSGCHK",195,0) I $D(^TMP($J,"ORDSGCHK2")) D "RTN","ORDSGCHK",196,0) .I +$G(^TMP($J,"ORDSGCHK2","OUT",0))=-1 S ORNBP="Drug Dosage checks were not able to be performed." Q "RTN","ORDSGCHK",197,0) .I $D(^TMP($J,"ORDSGCHK2","OUT","DOSE","ERROR")) D "RTN","ORDSGCHK",198,0) ..N I S I="" F S I=$O(^TMP($J,"ORDSGCHK2","OUT","DOSE","ERROR",I)) Q:'$L(I) D "RTN","ORDSGCHK",199,0) ...N J S J="" F S J=$O(^TMP($J,"ORDSGCHK2","OUT","DOSE","ERROR",I,J)) Q:'$L(J) D "RTN","ORDSGCHK",200,0) .... I $L($G(^TMP($J,"ORDSGCHK2","OUT","DOSE","ERROR",I,J,"MSG"))) S ORY=$G(ORY)+1,ORY(ORY)="ERR^"_^TMP($J,"ORDSGCHK2","OUT","DOSE","ERROR",I,J,"MSG") D "RTN","ORDSGCHK",201,0) ..... I $L($G(^TMP($J,"ORDSGCHK2","OUT","DOSE","ERROR",I,J,"TEXT"))) S ORY(ORY)=ORY(ORY)_". "_$G(^TMP($J,"ORDSGCHK2","OUT","DOSE","ERROR",I,J,"TEXT")) "RTN","ORDSGCHK",202,0) .I $D(^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE")) D "RTN","ORDSGCHK",203,0) ..N I S I="" F S I=$O(^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I)) Q:'$L(I) D "RTN","ORDSGCHK",204,0) ...N J S J="" F S J=$O(^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I,J)) Q:'$L(J) D "RTN","ORDSGCHK",205,0) .... I $G(^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I,J))["could not be performed" S ORNBP=^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I,J) Q "RTN","ORDSGCHK",206,0) .... I $G(^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I,J))["Error Summary" S ORNBP=^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I,J) Q "RTN","ORDSGCHK",207,0) .... I $G(^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I,J))["Reason(s):" S ORNBP=ORNBP_"."_^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I,J) Q "RTN","ORDSGCHK",208,0) .... I $G(^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I,J))[" " S ORNBP=ORNBP_"."_$P(^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I,J)," ",2) Q "RTN","ORDSGCHK",209,0) .... I $L(ORNBP)>1 S ORY=$G(ORY)+1,ORY(ORY)="ERR^"_ORNBP,ORNBP="" "RTN","ORDSGCHK",210,0) .... I $L($G(^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I,J))) S ORY=$G(ORY)+1,ORY(ORY)="ERR^"_^TMP($J,"ORDSGCHK2","OUT","EXCEPTIONS","DOSE",I,J) "RTN","ORDSGCHK",211,0) .N I S I="" F S I=$O(^TMP($J,"ORDSGCHK2","OUT","DOSE",I)) Q:'$L(I) D "RTN","ORDSGCHK",212,0) ..Q:(I="ERROR") "RTN","ORDSGCHK",213,0) ..N J S J="" F S J=$O(^TMP($J,"ORDSGCHK2","OUT","DOSE",I,J)) Q:'$L(J) D "RTN","ORDSGCHK",214,0) ...N TYP S TYP="" F S TYP=$O(^TMP($J,"ORDSGCHK2","OUT","DOSE",I,J,TYP)) Q:'$L(TYP) D "RTN","ORDSGCHK",215,0) ....N ORDIEN S ORDIEN=0 F S ORDIEN=$O(^TMP($J,"ORDSGCHK2","OUT","DOSE",I,J,TYP,"MESSAGE",ORDIEN)) Q:'ORDIEN D "RTN","ORDSGCHK",216,0) .....I $L($G(^TMP($J,"ORDSGCHK2","OUT","DOSE",I,J,TYP,"MESSAGE",ORDIEN))) D "RTN","ORDSGCHK",217,0) ......N OROCTYPE S OROCTYPE="DS" I TYP="3_GENERAL" S OROCTYPE="ERR" "RTN","ORDSGCHK",218,0) ......S ORY=$G(ORY)+1,ORY(ORY)=OROCTYPE_U_^TMP($J,"ORDSGCHK2","OUT","DOSE",I,J,TYP,"MESSAGE",ORDIEN) "RTN","ORDSGCHK",219,0) E S ORNBP="Drug Dosage checks were not able to be performed." "RTN","ORDSGCHK",220,0) I $L(ORNBP)>1 S ORY=$G(ORY)+1,ORY(ORY)="ERR^"_ORNBP,ORNBP="" "RTN","ORDSGCHK",221,0) Q "RTN","ORDSGCHK",222,0) ; "RTN","ORDSGCHK",223,0) GETSUB(NAME) ; "RTN","ORDSGCHK",224,0) I NAME="CONJ" Q "CONJ" "RTN","ORDSGCHK",225,0) I NAME="DAYS" Q "DRATE" "RTN","ORDSGCHK",226,0) I NAME="DOSE" Q "DOSE" "RTN","ORDSGCHK",227,0) I NAME="ROUTE" Q "MR_IEN" "RTN","ORDSGCHK",228,0) I NAME="SCHEDULE" Q "SCHEDULE" "RTN","ORDSGCHK",229,0) Q "" "RTN","ORDSGCHK",230,0) ; "RTN","ORDSGCHK",231,0) DRATESTR(ORIN) ;change the form of the DURATION "RTN","ORDSGCHK",232,0) ;DAYS=D,WEEKS=W,MONTHS=L,HOURS=H,MINUTES=M "RTN","ORDSGCHK",233,0) I $$UP^XLFSTR(ORIN)="MONTHS" Q "L" "RTN","ORDSGCHK",234,0) Q $E($$UP^XLFSTR(ORIN)) "RTN","ORDSGCHK",235,0) ; "RTN","ORKPS1") 0^2^B76491746^B71033645 "RTN","ORKPS1",1,0) ORKPS1 ; SLC/CLA - Order checking support procedures for medications ;04/06/2012 06:50 "RTN","ORKPS1",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**232,272,346,352**;Dec 17, 1997;Build 18 "RTN","ORKPS1",3,0) Q "RTN","ORKPS1",4,0) PROCESS(OI,DFN,ORKDG,ORPROSP,ORGLOBL) ;process data from pharmacy order check API "RTN","ORKPS1",5,0) ;ORPROSP = the med that is being checked "RTN","ORKPS1",6,0) Q:'$D(^TMP($J)) "RTN","ORKPS1",7,0) ;K ^TMP($J,"ORMONOGRAPH") "RTN","ORKPS1",8,0) N II,XX,ZZ,ZZD,ORMTYPE,ORN,ORZ,RCNT,GL,I,J,K,L,M,TDATA,VADMVT,ORX,ORY "RTN","ORKPS1",9,0) S II=1,XX=0,ZZ="",ZZD="",RCNT=0 "RTN","ORKPS1",10,0) I $G(^TMP($J,ORGLOBL,"OUT",0))<0 D Q "RTN","ORKPS1",11,0) .S YY(II)="ERR^Drug-Drug order checks (Duplicate Therapy, Duplicate Drug, Drug Interaction) were not able to be performed. "_$P($G(^TMP($J,ORGLOBL,"OUT",0)),U,2) "RTN","ORKPS1",12,0) .S II=II+1 "RTN","ORKPS1",13,0) I $D(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS")) D "RTN","ORKPS1",14,0) .S ORX="" F S ORX=$O(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS",ORX)) Q:'$L(ORX) D "RTN","ORKPS1",15,0) ..S ORY=0 F S ORY=$O(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS",ORX,ORY)) Q:'ORY D "RTN","ORKPS1",16,0) ...S YY(II)="ERR^"_$P($G(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS",ORX,ORY)),U,7) "RTN","ORKPS1",17,0) ...I $L($P($G(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS",ORX,ORY)),U,10))>0 S YY(II)=YY(II)_"("_$P($G(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS",ORX,ORY)),U,10)_")" "RTN","ORKPS1",18,0) ...S II=II+1 "RTN","ORKPS1",19,0) S ORX="" F ORX="DRUGDRUG","THERAPY" D "RTN","ORKPS1",20,0) .Q:'$D(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR")) "RTN","ORKPS1",21,0) .S ORY="" F S ORY=$O(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR",ORY)) Q:'$L(ORY) D "RTN","ORKPS1",22,0) ..S ORZ=0 F S ORZ=$O(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR",ORY,ORZ)) Q:'ORZ D "RTN","ORKPS1",23,0) ...S YY(II)="ERR^"_$$UPPER^ORWDPS32($G(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR",ORY,ORZ,"SEV")))_": "_$P($G(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR",ORY,ORZ,0)),U)_" - "_$G(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR",ORY,ORZ,"TEXT")) "RTN","ORKPS1",24,0) ...S II=II+1 "RTN","ORKPS1",25,0) ;set info about the drug being ordered "RTN","ORKPS1",26,0) S TDATA("NEW","TXT")="" "RTN","ORKPS1",27,0) S I="" F S I=$O(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",I)) Q:'$L(I) D "RTN","ORKPS1",28,0) .I $P($G(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",I)),U,3)=ORPROSP S TDATA("NEW","TXT")=$P($G(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",I)),U,4) "RTN","ORKPS1",29,0) .;I $P(I,";",4)=1 S TDATA("NEW","TXT")=$P($G(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",I)),U,4) "RTN","ORKPS1",30,0) I $L(ORKDG) S TDATA("NEW","PTYPE")=$S($G(ORKDG)="PSI":"I",$G(ORKDG)="PSO":"O",$G(ORKDG)="PSIV":"I",$G(ORKDG)="PSH":"O",1:"") "RTN","ORKPS1",31,0) I '$L(TDATA("NEW","PTYPE")) D ;if no display group "RTN","ORKPS1",32,0) .D ADM^VADPT2 "RTN","ORKPS1",33,0) .S TDATA("NEW","PTYPE")=$S(+$G(VADMVT)>0:"I",1:"O") "RTN","ORKPS1",34,0) .K VADMVT "RTN","ORKPS1",35,0) S TDATA("NEW","OTYPE")=TDATA("NEW","PTYPE") "RTN","ORKPS1",36,0) N ORPI S ORPI=0 F S ORPI=$O(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",ORPI)) Q:'$L(ORPI) I $P(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",ORPI),U,3)=+ORPROSP S TDATA("NEW","PROSP")=$P(ORPI,";",3,4) "RTN","ORKPS1",37,0) Q:'$L($G(TDATA("NEW","PROSP"))) "RTN","ORKPS1",38,0) I $L(ORKDG) S TDATA("NEW","OTYPE")=$S($G(ORKDG)="PSI":"UD",$G(ORKDG)="PSO":"OP",$G(ORKDG)="PSIV":"IV",$G(ORKDG)="PSH":"NV",1:"") "RTN","ORKPS1",39,0) D DI(.TDATA),DD(.TDATA),DT(.TDATA) "RTN","ORKPS1",40,0) Q "RTN","ORKPS1",41,0) ; "RTN","ORKPS1",42,0) DI(TDATA) ;add drug interaction checks "RTN","ORKPS1",43,0) N GL,ORSEV,ORDRUG,ORTXT,ORIEN "RTN","ORKPS1",44,0) S GL=$NA(^TMP($J,ORGLOBL,"OUT","DRUGDRUG")) "RTN","ORKPS1",45,0) S J="" F S J=$O(@GL@(J)) Q:'$L(J) D "RTN","ORKPS1",46,0) .S K="" F S K=$O(@GL@(J,K)) Q:'$L(K) D "RTN","ORKPS1",47,0) ..S L=0 F S L=$O(@GL@(J,K,L)) Q:'$L(L) D "RTN","ORKPS1",48,0) ...S M=0 F S M=$O(@GL@(J,K,L,M)) Q:'M D "RTN","ORKPS1",49,0) ....N ORNUM,ORSEV,ORDNAME,ORZ,CNT,ORSTAT,ORMON,ORWHICH,ORLINE,ORIDX "RTN","ORKPS1",50,0) ....;get the associated order number "RTN","ORKPS1",51,0) ....S ORNUM=$P(L,";",1,2) "RTN","ORKPS1",52,0) ....;if the status of the associated order is DISCONTINUED then don't add "RTN","ORKPS1",53,0) ....S ORSTAT=$$PHSTAT(DFN,ORNUM) "RTN","ORKPS1",54,0) ....Q:ORSTAT="DISCONTINUED" "RTN","ORKPS1",55,0) ....S ORWHICH="" "RTN","ORKPS1",56,0) ....I $P($P(@GL@(J,K,L,M),U),";",3,4)=TDATA("NEW","PROSP") D "RTN","ORKPS1",57,0) .....S ORWHICH=K_" ["_$S($P(L,";",3)="PROSPECTIVE":"UNRELEASED",1:ORSTAT)_"]" "RTN","ORKPS1",58,0) ....I $P(L,";",3,4)=TDATA("NEW","PROSP") D "RTN","ORKPS1",59,0) .....S ORWHICH=$P(@GL@(J,K,L,M),U,4)_" [" "RTN","ORKPS1",60,0) .....S ORWHICH=ORWHICH_$S($P($P(@GL@(J,K,L,M),U),";",3)="PROSPECTIVE":"UNRELEASED",1:$$PHSTAT(DFN,$P($P(@GL@(J,K,L,M),U),";",1,2))) "RTN","ORKPS1",61,0) .....S ORWHICH=ORWHICH_"]" "RTN","ORKPS1",62,0) ....Q:$L(ORWHICH)<2 "RTN","ORKPS1",63,0) ....;get text "RTN","ORKPS1",64,0) ....S ORTXT(J,K)=$S($G(ORTXT(J,K))'="":ORTXT(J,K)_" ",1:"")_$P($G(@GL@(J,K,L,M,"CLIN")),"CLINICAL EFFECTS: ",2),ORTXT(J,K,"ORWHICH")=ORWHICH "RTN","ORKPS1",65,0) ....;set the monograph into the temp global "RTN","ORKPS1",66,0) ....I $D(@GL@(J,K,L,M,"PMON")) D "RTN","ORKPS1",67,0) .....S ^TMP($J,"ORMONOGRAPH")=1+$G(^TMP($J,"ORMONOGRAPH")) "RTN","ORKPS1",68,0) .....S ORMON=^TMP($J,"ORMONOGRAPH") "RTN","ORKPS1",69,0) .....S ^TMP($J,"ORMONOGRAPH",ORMON,"INT")=@GL@(J,K,L,M,"INT") "RTN","ORKPS1",70,0) .....S ORIDX="",ORLINE=1 F S ORIDX=$O(@GL@(J,K,L,M,"PMON",ORIDX)) Q:+$G(ORIDX)=0 D "RTN","ORKPS1",71,0) ......S ^TMP($J,"ORMONOGRAPH",ORMON,"DATA",ORLINE,0)=@GL@(J,K,L,M,"PMON",ORIDX,0),ORLINE=ORLINE+1 "RTN","ORKPS1",72,0) .....S ORTXT(J,K,"MONOGRAPH")=1,ORTXT(J,K,"ORMON",ORMON)="" "RTN","ORKPS1",73,0) ....;get the severity "RTN","ORKPS1",74,0) ....S ORSEV=$$UPPER^ORU($G(@GL@(J,K,L,M,"SEV"))) "RTN","ORKPS1",75,0) ....;get the drug name "RTN","ORKPS1",76,0) ....S ORDNAME=K "RTN","ORKPS1",77,0) ....S ORTXT(J,K,"YY")="DI^"_ORSEV_U_ORNUM_U_ORDNAME_U_U_$G(@GL@(J,K,L,M,"INT")) "RTN","ORKPS1",78,0) ;RETURN DATA IN EXPECTED FORMAT "RTN","ORKPS1",79,0) S ORSEV="" F S ORSEV=$O(ORTXT(ORSEV)) Q:$G(ORSEV)="" D "RTN","ORKPS1",80,0) .S ORDRUG="" F S ORDRUG=$O(ORTXT(ORSEV,ORDRUG)) Q:$G(ORDRUG)="" D "RTN","ORKPS1",81,0) ..S YY(II)=ORTXT(ORSEV,ORDRUG,"YY") "RTN","ORKPS1",82,0) ..S $P(YY(II),U,5)=TDATA("NEW","TXT")_" and "_ORTXT(ORSEV,ORDRUG,"ORWHICH")_" - "_ORTXT(ORSEV,ORDRUG) "RTN","ORKPS1",83,0) ..S ORIEN=0 F S ORIEN=$O(ORTXT(ORSEV,ORDRUG,"ORMON",ORIEN)) Q:+$G(ORIEN)=0 D "RTN","ORKPS1",84,0) ...S ^TMP($J,"ORMONOGRAPH",ORIEN,"OC")=$P(YY(II),U,5) "RTN","ORKPS1",85,0) ..S:$G(ORTXT(ORSEV,ORDRUG,"MONOGRAPH")) $P(YY(II),U,5)=$P(YY(II),U,5)_" - Monograph Available" "RTN","ORKPS1",86,0) ..S II=II+1 "RTN","ORKPS1",87,0) Q "RTN","ORKPS1",88,0) ; "RTN","ORKPS1",89,0) DD(TDATA) ;add duplicate drug checks "RTN","ORKPS1",90,0) Q:$$SOLUT^ORKPS(OI) ;quit if the orderable item is a solution "RTN","ORKPS1",91,0) ;require that we do not perform dup drug/class OCs for solutions) "RTN","ORKPS1",92,0) S XX=0,ZZ="" "RTN","ORKPS1",93,0) F S XX=$O(^TMP($J,"DD",XX)) Q:XX<1 D "RTN","ORKPS1",94,0) .N ORREM "RTN","ORKPS1",95,0) .S ZZ=$G(^TMP($J,"DD",XX,0)),ORMTYPE=$P($P(ZZ,U,4),";",2) "RTN","ORKPS1",96,0) .S ORREM=$P($P(ZZ,U,4),";") I (ORREM["Z"),$D(^TMP($J,ORGLOBL,"OUT","REMOTE",+ORREM)) D "RTN","ORKPS1",97,0) ..N ORTXT,ORREM1,ORREMSIG "RTN","ORKPS1",98,0) ..S ORREM1=$G(^TMP($J,ORGLOBL,"OUT","REMOTE",+ORREM)) "RTN","ORKPS1",99,0) ..S ORREMSIG=$G(^TMP($J,ORGLOBL,"OUT","REMOTE",+ORREM,"SIG",0)) "RTN","ORKPS1",100,0) ..S ORTXT=" "_ORREMSIG_" ["_$P(ORREM1,U,4)_" - Last Fill: "_$P(ORREM1,U,6)_" Quantity Dispensed: "_$P(ORREM1,U,8)_"] >>"_$P(ORREM1,U) "RTN","ORKPS1",101,0) ..S $P(ZZ,U,2)=$P(ZZ,U,2)_ORTXT "RTN","ORKPS1",102,0) .I $G(TDATA("NEW","PTYPE"))'=$G(ORMTYPE),'$L($G(^TMP($J,"DD",XX,1))) Q "RTN","ORKPS1",103,0) .S ORN=$P($P(ZZ,U,3),";"),ORZ="" "RTN","ORKPS1",104,0) .I $L($G(ORN))>0,+$G(ORN)=+$G(ORIFN) Q ;QUIT if dup med ord # = current ord # "RTN","ORKPS1",105,0) .I +$G(ORIFN),+$G(ORN)=$P(^OR(100,+ORIFN,3),U,5) Q ;QUIT if dup med ord # = the current order #'s REPLACED ORDER (changing an order) "RTN","ORKPS1",106,0) .Q:ORPROSP'=+ZZ "RTN","ORKPS1",107,0) .I $L(ORN),$D(^OR(100,ORN,8,0)) S ORZ=^OR(100,ORN,8,0) "RTN","ORKPS1",108,0) .I $L($G(ORZ)),($P(^OR(100,ORN,8,$P(ORZ,U,3),0),U,2)="DC") Q "RTN","ORKPS1",109,0) .I $L(ORN),$P(^ORD(100.01,$P(^OR(100,ORN,3),U,3),0),U)="DISCONTINUED" Q "RTN","ORKPS1",110,0) .I ZZ'="" S YY(II)="DD^"_ZZ,II=II+1 "RTN","ORKPS1",111,0) .S ^TMP($J,"DD",XX,"OC")="" ;set this if this DD entry turned into an OC "RTN","ORKPS1",112,0) Q "RTN","ORKPS1",113,0) ; "RTN","ORKPS1",114,0) DT(TDATA) ;add duplicate therapy checks "RTN","ORKPS1",115,0) N I "RTN","ORKPS1",116,0) Q:$$SUPPLY^ORKPS(OI) ;quit if the orderable item is a supply "RTN","ORKPS1",117,0) S GL=$NA(^TMP($J,ORGLOBL,"OUT","THERAPY")) "RTN","ORKPS1",118,0) S I=0 F S I=$O(@GL@(I)) Q:'I D "RTN","ORKPS1",119,0) .;get all drug names "RTN","ORKPS1",120,0) .N ORDRUGS,ORCLASS,ORF,ORPROSCNT,ORPROFCNT,DRUGS,ORRETSTR S ORDRUGS="",ORCLASS="",ORF=0,ORPROSCNT=0,ORPROFCNT=0 "RTN","ORKPS1",121,0) .S J=0 F S J=$O(@GL@(I,"DRUGS",J)) Q:'J D "RTN","ORKPS1",122,0) ..;keep count of PROSPECTIVE drugs "RTN","ORKPS1",123,0) ..I $P($P($G(@GL@(I,"DRUGS",J)),U),";",3,4)=TDATA("NEW","PROSP") S ORF=1 "RTN","ORKPS1",124,0) ..I $P($P($G(@GL@(I,"DRUGS",J)),U),";",3)="PROSPECTIVE" D "RTN","ORKPS1",125,0) ...S ORPROSCNT=1+$G(ORPROSCNT) "RTN","ORKPS1",126,0) ...I $P($P($G(@GL@(I,"DRUGS",J)),U),";",3,4)'=TDATA("NEW","PROSP") S ORDRUGS=ORDRUGS_$S($L(ORDRUGS):", ",1:"")_$P($G(@GL@(I,"DRUGS",J)),U,3)_" [UNRELEASED]",DRUGS($P($G(@GL@(I,"DRUGS",J)),U,3))="" "RTN","ORKPS1",127,0) ..;-check each PROFILE drug to see if it is not the same order as the prospective (ORIFN) "RTN","ORKPS1",128,0) ..I $P($P($G(@GL@(I,"DRUGS",J)),U),";",3)="PROFILE" D "RTN","ORKPS1",129,0) ...;if not the same then set ORNUM=THE PROFILE DRUG "O;PSNUM" "RTN","ORKPS1",130,0) ...I $P($P($G(@GL@(I,"DRUGS",J)),U),";",2)'=$G(^OR(100,+$G(ORIFN),4)) D "RTN","ORKPS1",131,0) ....I $L($P($G(@GL@(I,"DRUGS",J)),U,4))>0,(+$P($G(@GL@(I,"DRUGS",J)),U,4)=$P($G(^OR(100,+$G(ORIFN),3)),U,5)) Q "RTN","ORKPS1",132,0) ....I $L($P($G(@GL@(I,"DRUGS",J)),U,4))>0,(+$P($G(@GL@(I,"DRUGS",J)),U,4)=+$G(ORIFN)) Q "RTN","ORKPS1",133,0) ....I $E($G(@GL@(I,"DRUGS",J)),1)="R" S $P(@GL@(I,"DRUGS",J),U,5)="O" "RTN","ORKPS1",134,0) ....I $G(TDATA("NEW","PTYPE"))'=$P($G(@GL@(I,"DRUGS",J)),U,5) Q "RTN","ORKPS1",135,0) ....S ORNUM=$P($P($G(@GL@(I,"DRUGS",J)),U),";",1,2) "RTN","ORKPS1",136,0) ....S ORDRUGS=ORDRUGS_$S($L(ORDRUGS):", ",1:"")_$P($G(@GL@(I,"DRUGS",J)),U,3)_" ["_$$PHSTAT(DFN,ORNUM)_"]" "RTN","ORKPS1",137,0) ....S DRUGS($P($G(@GL@(I,"DRUGS",J)),U,3))="",ORPROFCNT=ORPROFCNT+1 "RTN","ORKPS1",138,0) .Q:'$$CHKDD(.DRUGS) "RTN","ORKPS1",139,0) .;quit if ORNUM is not set and PROSPECTIVE count <=1 "RTN","ORKPS1",140,0) .Q:('$L($G(ORNUM))&(ORPROSCNT<2)) "RTN","ORKPS1",141,0) .;get all classes "RTN","ORKPS1",142,0) .I ORF S J=0 F S J=$O(@GL@(I,J)) Q:'J D "RTN","ORKPS1",143,0) ..S ORCLASS=ORCLASS_$S($L(ORCLASS):", ",1:"")_$G(@GL@(I,J,"CLASS")) "RTN","ORKPS1",144,0) .;assemble return string ("DC"+ORNUM_U_Classes_U_Classes (drugs)) "RTN","ORKPS1",145,0) .S ORRETSTR="Duplicate Therapy: Order(s) exist for {"_ORDRUGS_"} in the same therapeutic categor(ies): "_ORCLASS "RTN","ORKPS1",146,0) .I ORF S YY(II)="DC"_U_$G(ORNUM)_U_ORCLASS_U_ORRETSTR,II=II+1 "RTN","ORKPS1",147,0) Q "RTN","ORKPS1",148,0) ; "RTN","ORKPS1",149,0) PHSTAT(DFN,ORNUM) ;get the status of the order "RTN","ORKPS1",150,0) N RET,J,I "RTN","ORKPS1",151,0) S RET="" "RTN","ORKPS1",152,0) I $P(ORNUM,";")="P" S RET="PENDING" "RTN","ORKPS1",153,0) I $P(ORNUM,";")="N" S RET="NON-VA" "RTN","ORKPS1",154,0) I $P(ORNUM,";")="O" D "RTN","ORKPS1",155,0) .K ^TMP($J,"OROCLST") D RX^PSO52API(DFN,"OROCLST",$P(ORNUM,";",2),,"ST") "RTN","ORKPS1",156,0) .S RET=$P($G(^TMP($J,"OROCLST",DFN,$P(ORNUM,";",2),100)),U,2) "RTN","ORKPS1",157,0) .K ^TMP($J,"OROCLST") "RTN","ORKPS1",158,0) I $P(ORNUM,";")="I"!($E($P(ORNUM,";"),1)="C") D "RTN","ORKPS1",159,0) .N ORLAST,ORPHNUM "RTN","ORKPS1",160,0) .I $E($P(ORNUM,";"),1)="C" S ORLAST=$S($E($P(ORNUM,";"),2)=1:"V",$E($P(ORNUM,";"),2)=2:"U",1:"NV") "RTN","ORKPS1",161,0) .E S ORLAST=$E(ORNUM,$L(ORNUM)) "RTN","ORKPS1",162,0) .I ORLAST="P" S RET="PENDING" Q "RTN","ORKPS1",163,0) .S ORPHNUM=+$P(ORNUM,";",2) "RTN","ORKPS1",164,0) .I ORLAST="U" D "RTN","ORKPS1",165,0) ..K ^TMP($J,"OR GET STATUS") D PSS431^PSS55(DFN,ORPHNUM,"","","OR GET STATUS") "RTN","ORKPS1",166,0) ..S RET=$P($G(^TMP($J,"OR GET STATUS",ORPHNUM,28)),U,2) "RTN","ORKPS1",167,0) .I ORLAST="V" D "RTN","ORKPS1",168,0) ..K ^TMP($J,"OR GET STATUS") D PSS436^PSS55(DFN,ORPHNUM,"OR GET STATUS") "RTN","ORKPS1",169,0) ..S RET=$P($G(^TMP($J,"OR GET STATUS",ORPHNUM,100)),U,2) "RTN","ORKPS1",170,0) .I ORLAST="NV" D "RTN","ORKPS1",171,0) ..K ^TMP($J,"OR GET STATUS") D PSJ^PSJ53P1(ORPHNUM,"OR GET STATUS") "RTN","ORKPS1",172,0) ..S RET=$P($G(^TMP($J,"OR GET STATUS",ORPHNUM,28)),U,2) "RTN","ORKPS1",173,0) .S:$E($P(ORNUM,";"),1)="C" RET=RET_" CLINIC ORDER" "RTN","ORKPS1",174,0) I $P(ORNUM,";")="R" D "RTN","ORKPS1",175,0) .N ORREMOTE S ORREMOTE=$G(^TMP($J,ORGLOBL,"OUT","REMOTE",$P(ORNUM,";",2))) "RTN","ORKPS1",176,0) .S RET=$P(ORREMOTE,U,4)_" >> "_$P(ORREMOTE,U) "RTN","ORKPS1",177,0) Q RET "RTN","ORKPS1",178,0) ; "RTN","ORKPS1",179,0) CHKDD(DARRAY) ;check the duplicate drug OCs returned "RTN","ORKPS1",180,0) ;if all drugs in DARRAY are already displayed in a DD OC then don't show the DT OC (return 0) "RTN","ORKPS1",181,0) ;check the ^TMP($J,"DD"I,"OC") node to see if the DD entry turned into an OC "RTN","ORKPS1",182,0) N I S I=0 F S I=$O(^TMP($J,"DD",I)) Q:'I D "RTN","ORKPS1",183,0) .I $D(DARRAY($P($G(^TMP($J,"DD",I,0)),U,2))),$D(^TMP($J,"DD",I,"OC")) D "RTN","ORKPS1",184,0) ..K DARRAY($P($G(^TMP($J,"DD",I,0)),U,2)) "RTN","ORKPS1",185,0) Q $D(DARRAY) "RTN","ORKPS1",186,0) ; "RTN","ORY352") 0^^B8020148^n/a "RTN","ORY352",1,0) ORY352 ;SLC/RFR - PRE/POST INSTALL FOR PATCH OR*3.0*352 ;02/09/2012 13:07 "RTN","ORY352",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**352**;Dec 17, 1997;Build 18 "RTN","ORY352",3,0) Q "RTN","ORY352",4,0) PRE ;PRE-INSTALL SECTION "RTN","ORY352",5,0) ;DELETE THE EXISTING DD FOR FILE 100.05 (KIDS WILL INSTALL A NEW DD) "RTN","ORY352",6,0) N DIU "RTN","ORY352",7,0) D BMES^XPDUTL("Deleting the data dictionary for file ORDER CHECK INSTANCES (#100.05)...") "RTN","ORY352",8,0) S DIU="^ORD(100.05,",DIU(0)="" "RTN","ORY352",9,0) D EN^DIU2 "RTN","ORY352",10,0) D BMES^XPDUTL("Successfully deleted the data dictionary.") "RTN","ORY352",11,0) Q "RTN","ORY352",12,0) QUEUE ;QUEUE THE POST-INSTALL SECTION "RTN","ORY352",13,0) N ORMSG,XPDIDTOT "RTN","ORY352",14,0) N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK "RTN","ORY352",15,0) S XPDIDTOT=1 "RTN","ORY352",16,0) D UPDATE^XPDID(0) "RTN","ORY352",17,0) D BMES^XPDUTL("Queueing the post-install task...") "RTN","ORY352",18,0) S ZTRTN="POST^ORY352",ZTDESC="OR*3.0*352 POST INSTALL" "RTN","ORY352",19,0) S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10) "RTN","ORY352",20,0) S ZTIO="" "RTN","ORY352",21,0) D ^%ZTLOAD "RTN","ORY352",22,0) I +$G(ZTSK)=0 D "RTN","ORY352",23,0) .S ORMSG(1)=" ",ORMSG(2)="Unable to queue the post-install." "RTN","ORY352",24,0) .D MES^XPDUTL(.ORMSG) "RTN","ORY352",25,0) E D BMES^XPDUTL("Successfully queued post-install; task #"_ZTSK) "RTN","ORY352",26,0) D UPDATE^XPDID(1) "RTN","ORY352",27,0) Q "RTN","ORY352",28,0) POST ;POST-INSTALL SECTION "RTN","ORY352",29,0) N ORLIMIT,ORIEN,ORIDX,ORLINE,ORBODY "RTN","ORY352",30,0) N XMMG,XMDUZ,XMY,XMSUB,XMTEXT,XMZ,XMERR,XPDIDTOT,DIFROM,XMK "RTN","ORY352",31,0) ;REMOVE DATA STORED IN NODE ^ORD(100.05,D0,16) WHILE PRESERVING DESCENDANTS "RTN","ORY352",32,0) S ORIEN=0 F S ORIEN=$O(^ORD(100.05,ORIEN)) Q:+$G(ORIEN)=0 D "RTN","ORY352",33,0) .Q:$D(^ORD(100.05,ORIEN,16))<11 "RTN","ORY352",34,0) .K ^TMP($J,"ORMONO") "RTN","ORY352",35,0) .M ^TMP($J,"ORMONO")=^ORD(100.05,ORIEN,16) "RTN","ORY352",36,0) .K ^ORD(100.05,ORIEN,16) "RTN","ORY352",37,0) .S ORIDX=0,ORLINE=1 F S ORIDX=$O(^TMP($J,"ORMONO",ORIDX)) Q:+$G(ORIDX)=0 D "RTN","ORY352",38,0) ..S ^ORD(100.05,ORIEN,16,ORLINE,0)=^TMP($J,"ORMONO",ORIDX,0),ORLINE=ORLINE+1 "RTN","ORY352",39,0) .S ORLINE=$O(^ORD(100.05,ORIEN,16,"?"),-1) "RTN","ORY352",40,0) .S ^ORD(100.05,ORIEN,16,0)=U_U_ORLINE_U_ORLINE_U_$P(^TMP($J,"ORMONO",0),U,5)_U "RTN","ORY352",41,0) K ^TMP($J,"ORMONO") "RTN","ORY352",42,0) ;SEND COMPLETION EMAIL "RTN","ORY352",43,0) S ORBODY(1)="Post-installation successfully completed." "RTN","ORY352",44,0) S ORBODY(2)="" "RTN","ORY352",45,0) S ORBODY(3)="Please delete the post-install routine ORY352 using the" "RTN","ORY352",46,0) S ORBODY(4)="Kernel Toolkit option Delete Routines [XTRDEL] as follows:" "RTN","ORY352",47,0) S ORBODY(5)="ROUTINE DELETE" "RTN","ORY352",48,0) S ORBODY(6)="" "RTN","ORY352",49,0) S ORBODY(7)="All Routines? No => No" "RTN","ORY352",50,0) S ORBODY(8)="" "RTN","ORY352",51,0) S ORBODY(9)="Routine: ORY352" "RTN","ORY352",52,0) S ORBODY(10)="Routine: " "RTN","ORY352",53,0) S ORBODY(11)="1 routine" "RTN","ORY352",54,0) S ORBODY(12)="" "RTN","ORY352",55,0) S ORBODY(13)="1 routines to DELETE, OK: NO// YES" "RTN","ORY352",56,0) S ORBODY(14)="ORY352" "RTN","ORY352",57,0) S ORBODY(15)="Done." "RTN","ORY352",58,0) S XMY(DUZ)="" "RTN","ORY352",59,0) S XMSUB="PATCH OR*3.0*352 POST-INSTALLATION REPORT" "RTN","ORY352",60,0) S XMTEXT="ORBODY(" "RTN","ORY352",61,0) D ^XMD "RTN","ORY352",62,0) I $D(XMMG)=0 D "RTN","ORY352",63,0) .S XMK=$$BSKT^XMAD2("IN",+DUZ) "RTN","ORY352",64,0) .D:+XMK>0 MAKENEW^XMXUTIL(DUZ,+XMK,XMZ,1) "RTN","ORY352",65,0) Q "SEC","^DIC",100.05,100.05,0,"AUDIT") @ "SEC","^DIC",100.05,100.05,0,"DD") @ "SEC","^DIC",100.05,100.05,0,"DEL") @ "SEC","^DIC",100.05,100.05,0,"LAYGO") @ "SEC","^DIC",100.05,100.05,0,"WR") @ "VER") 8.0^22.0 "^DD",100.05,100.05,0) FIELD^^15^15 "^DD",100.05,100.05,0,"DDA") N "^DD",100.05,100.05,0,"DT") 3120323 "^DD",100.05,100.05,0,"IX","B",100.05,.01) "^DD",100.05,100.05,0,"NM","ORDER CHECK INSTANCES") "^DD",100.05,100.05,0,"VRPK") OR "^DD",100.05,100.05,.01,0) ORDER^RP100'^OR(100,^0;1^Q "^DD",100.05,100.05,.01,1,0) ^.1 "^DD",100.05,100.05,.01,1,1,0) 100.05^B "^DD",100.05,100.05,.01,1,1,1) S ^ORD(100.05,"B",$E(X,1,30),DA)="" "^DD",100.05,100.05,.01,1,1,2) K ^ORD(100.05,"B",$E(X,1,30),DA) "^DD",100.05,100.05,.01,3) Select the order that this order check is in reference to "^DD",100.05,100.05,.01,21,0) ^^1^1^3090121^^ "^DD",100.05,100.05,.01,21,1,0) This gives the order that the Order Check is related to. "^DD",100.05,100.05,.01,"DT") 3090121 "^DD",100.05,100.05,1,0) STATUS^P100.01'^ORD(100.01,^0;2^Q "^DD",100.05,100.05,1,3) Enter the status of the order when the order check occurred. "^DD",100.05,100.05,1,21,0) ^^1^1^3090116^^ "^DD",100.05,100.05,1,21,1,0) This is the status of the order when the Order Check occurred. "^DD",100.05,100.05,1,"DT") 3090116 "^DD",100.05,100.05,2,0) OCCURRENCE^F^^0;3^K:$L(X)>15!($L(X)<1) X "^DD",100.05,100.05,2,3) Enter a descriptor tag between 1 and 15 characters "^DD",100.05,100.05,2,21,0) ^^6^6^3090116^ "^DD",100.05,100.05,2,21,1,0) This is a description field that the application where the order check "^DD",100.05,100.05,2,21,2,0) occurred can use to describe where/when the order check took place. For "^DD",100.05,100.05,2,21,3,0) instance, CPRS will use ACCEPTANCE_CPRS when the order check happened at "^DD",100.05,100.05,2,21,4,0) order acceptance inside of the CPRS application. CPRS will use "^DD",100.05,100.05,2,21,5,0) SIGNATURE_CPRS when the order check happened at order signature inside of "^DD",100.05,100.05,2,21,6,0) the CPRS application. "^DD",100.05,100.05,2,"DT") 3090116 "^DD",100.05,100.05,3,0) USER^P200'^VA(200,^0;4^Q "^DD",100.05,100.05,3,3) Enter the user who saw the order checks "^DD",100.05,100.05,3,21,0) ^^1^1^3090121^ "^DD",100.05,100.05,3,21,1,0) This is the user that saw the order checks. "^DD",100.05,100.05,3,"DT") 3090121 "^DD",100.05,100.05,4,0) OCCURRENCE D/T^D^^0;5^S %DT="E" D ^%DT S X=Y K:X<1 X "^DD",100.05,100.05,4,3) Enter the date/time of the order check "^DD",100.05,100.05,4,21,0) ^^1^1^3090115^ "^DD",100.05,100.05,4,21,1,0) This is the date/time that the order checks happened. "^DD",100.05,100.05,4,"DT") 3090121 "^DD",100.05,100.05,5,0) ORDER CHECK^P100.8'^ORD(100.8,^1;1^Q "^DD",100.05,100.05,5,3) Enter the type of Order Check "^DD",100.05,100.05,5,21,0) ^^1^1^3090121^ "^DD",100.05,100.05,5,21,1,0) This field represents what type of order check took place "^DD",100.05,100.05,5,"DT") 3090121 "^DD",100.05,100.05,6,0) CLINICAL DANGER LEVEL^S^1:HIGH;2:MODERATE;3:LOW;^1;2^Q "^DD",100.05,100.05,6,3) Enter the Clinical Danger Level of this Order Check "^DD",100.05,100.05,6,21,0) ^^2^2^3090115^ "^DD",100.05,100.05,6,21,1,0) This is the clinical danger of the Order Check type (file 100.8) at the "^DD",100.05,100.05,6,21,2,0) time this order check was seen. "^DD",100.05,100.05,6,"DT") 3090115 "^DD",100.05,100.05,7,0) OVERRIDE REASON^100.57^^3;0 "^DD",100.05,100.05,7,21,0) ^^2^2^3090116^ "^DD",100.05,100.05,7,21,1,0) This field represents the reason that the provider is overriding the "^DD",100.05,100.05,7,21,2,0) order check and continuing with placing the order. "^DD",100.05,100.05,8,0) ORDER CHECK MESSAGE^100.58^^2;0 "^DD",100.05,100.05,8,21,0) ^^2^2^3090115^ "^DD",100.05,100.05,8,21,1,0) This field stores the text of the order check that was presented to the "^DD",100.05,100.05,8,21,2,0) user. "^DD",100.05,100.05,13,0) PHARMACIST OVERRIDE COMMENTS^F^^11;1^K:$L(X)>80!($L(X)<1) X "^DD",100.05,100.05,13,3) Enter the reason that the pharmacist is overriding the order check "^DD",100.05,100.05,13,21,0) ^^2^2^3090116^ "^DD",100.05,100.05,13,21,1,0) This field represents the reason that the Pharmacist is overriding the "^DD",100.05,100.05,13,21,2,0) Order Check and continuing with placing the order. "^DD",100.05,100.05,13,"DT") 3090116 "^DD",100.05,100.05,14,0) PHARMACIST^P200'^VA(200,^11;2^Q "^DD",100.05,100.05,14,3) Enter the Pharmacist who is entering the Pharmacist Override Comments "^DD",100.05,100.05,14,8.5) @ "^DD",100.05,100.05,14,21,0) ^^1^1^3090121^ "^DD",100.05,100.05,14,21,1,0) This is the Pharmacist who entered the Pharmacist Override Comments "^DD",100.05,100.05,14,"DT") 3090121 "^DD",100.05,100.05,14.1,0) PHARMACIST COMMENTS D/T^D^^15;1^S %DT="EST" D ^%DT S X=Y K:Y<1 X "^DD",100.05,100.05,14.1,3) Enter the date/time that the Pharmacist Override Comments were entered. "^DD",100.05,100.05,14.1,21,0) ^^2^2^3090116^ "^DD",100.05,100.05,14.1,21,1,0) This field represents the Date and Time that the Pharmacist Override "^DD",100.05,100.05,14.1,21,2,0) Comments were entered. "^DD",100.05,100.05,14.1,"DT") 3090121 "^DD",100.05,100.05,15,0) MONOGRAPH^100.515^^16;0 "^DD",100.05,100.05,15,21,0) ^^1^1^3120305^ "^DD",100.05,100.05,15,21,1,0) This field stores the monograph for drug-drug interactions. "^DD",100.05,100.05,16,0) MONOGRAPH TERM^F^^17;1^K:$L(X)>50!($L(X)<1) X "^DD",100.05,100.05,16,3) Answer must be 1-50 characters in length "^DD",100.05,100.05,16,21,0) ^^2^2^3090618^ "^DD",100.05,100.05,16,21,1,0) This is the term that will be displayed to the user when selecting from a "^DD",100.05,100.05,16,21,2,0) list of monographs to view. "^DD",100.05,100.05,16,"DT") 3090618 "^DD",100.05,100.05,17,0) DRUG ALLERGIES^100.517PA^^4;0 "^DD",100.05,100.05,17,21,0) ^.001^2^2^3120131^^^^ "^DD",100.05,100.05,17,21,1,0) This sub-file contains drug allergies that were displayed during pharmacy "^DD",100.05,100.05,17,21,2,0) (OP & IP) order entry. "^DD",100.05,100.515,0) MONOGRAPH SUB-FIELD^^.01^1 "^DD",100.05,100.515,0,"DT") 3120202 "^DD",100.05,100.515,0,"NM","MONOGRAPH") "^DD",100.05,100.515,0,"UP") 100.05 "^DD",100.05,100.515,.01,0) MONOGRAPH^W^^0;1^Q "^DD",100.05,100.515,.01,3) Enter the monograph text received from pharmacy. "^DD",100.05,100.515,.01,21,0) ^^2^2^3120202^ "^DD",100.05,100.515,.01,21,1,0) This field will hold the monograph data that pharmacy sends back with "^DD",100.05,100.515,.01,21,2,0) Drug Interaction order checks. "^DD",100.05,100.515,.01,"DT") 3120202 "^DD",100.05,100.517,0) DRUG ALLERGIES SUB-FIELD^^9^11 "^DD",100.05,100.517,0,"DT") 3120323 "^DD",100.05,100.517,0,"IX","B",100.517,.01) "^DD",100.05,100.517,0,"NM","DRUG ALLERGIES") "^DD",100.05,100.517,0,"UP") 100.05 "^DD",100.05,100.517,.01,0) INTERACTING MEDICATION^P50'^PSDRUG(^0;1^Q "^DD",100.05,100.517,.01,1,0) ^.1 "^DD",100.05,100.517,.01,1,1,0) 100.517^B "^DD",100.05,100.517,.01,1,1,1) S ^ORD(100.05,DA(1),4,"B",$E(X,1,30),DA)="" "^DD",100.05,100.517,.01,1,1,2) K ^ORD(100.05,DA(1),4,"B",$E(X,1,30),DA) "^DD",100.05,100.517,.01,3) Enter drug name. "^DD",100.05,100.517,.01,21,0) ^.001^1^1^3111005^^ "^DD",100.05,100.517,.01,21,1,0) Dispense drug associated with drug allergy. "^DD",100.05,100.517,.01,"DT") 3110915 "^DD",100.05,100.517,1,0) LOCATION^S^L:Local;R:Remote;B:Local and Remote;^0;2^Q "^DD",100.05,100.517,1,3) Enter location type where drug allergy was entered. "^DD",100.05,100.517,1,21,0) ^.001^1^1^3111006^^^^ "^DD",100.05,100.517,1,21,1,0) Location type where drug allergy was entered. "^DD",100.05,100.517,1,"DT") 3120305 "^DD",100.05,100.517,2,0) CAUSATIVE AGENT^V^^0;3^ "^DD",100.05,100.517,2,3) Select the agent that caused this reaction. "^DD",100.05,100.517,2,21,0) ^^1^1^3120319^ "^DD",100.05,100.517,2,21,1,0) Agent that caused the drug allergy. "^DD",100.05,100.517,2,"DT") 3120319 "^DD",100.05,100.517,2,"V",0) ^.12P^^5 "^DD",100.05,100.517,2,"V",1,0) 120.82^GMR ALLERGY^1^A^n^n "^DD",100.05,100.517,2,"V",2,0) 50.416^DRUG INGREDIENTS^2^I^n^n "^DD",100.05,100.517,2,"V",3,0) 50.605^VA DRUG CLASS^3^C^n^n "^DD",100.05,100.517,2,"V",4,0) 50.6^NATIONAL DRUG^4^N^n^n "^DD",100.05,100.517,2,"V",4,1) "^DD",100.05,100.517,2,"V",4,2) "^DD",100.05,100.517,2,"V",5,0) 50^LOCAL DRUG^5^D^n^n "^DD",100.05,100.517,3,0) VA DRUG CLASS^100.5173PA^^1;0 "^DD",100.05,100.517,3,21,0) ^.001^1^1^3111006^^^^ "^DD",100.05,100.517,3,21,1,0) This sub-file stores the drug classes associated with the drug allergy. "^DD",100.05,100.517,3,"DT") 3111005 "^DD",100.05,100.517,4,0) DRUG INGREDIENTS^100.5174PA^^2;0 "^DD",100.05,100.517,4,21,0) ^.001^1^1^3111006^^^^ "^DD",100.05,100.517,4,21,1,0) This sub-file contains drug ingredients associated with the drug allergies. "^DD",100.05,100.517,4,"DT") 3110915 "^DD",100.05,100.517,5,0) SIGNS/SYMPTOMS^100.5175PA^^3;0 "^DD",100.05,100.517,5,21,0) ^.001^1^1^3111006^^^ "^DD",100.05,100.517,5,21,1,0) Signs and symptoms of drug allergy. "^DD",100.05,100.517,6,0) REMOTE LOCATION^P4'^DIC(4,^0;4^Q "^DD",100.05,100.517,6,3) Select the remote institution that reported this allergy. "^DD",100.05,100.517,6,21,0) ^^1^1^3120323^ "^DD",100.05,100.517,6,21,1,0) Points to the non-local institution where the drug allergy was reported. "^DD",100.05,100.517,6,"DT") 3120323 "^DD",100.05,100.517,7,0) INTERVENTION^P9009032.4'^APSPQA(32.4,^0;5^Q "^DD",100.05,100.517,7,3) Enter intervention for the drug allergy. "^DD",100.05,100.517,7,21,0) ^.001^1^1^3111005^^^^ "^DD",100.05,100.517,7,21,1,0) Contains the intervention for the drug allergy. "^DD",100.05,100.517,7,"DT") 3110915 "^DD",100.05,100.517,8,0) DATABASE^S^C:COTS;V:VISTA;^0;6^Q "^DD",100.05,100.517,8,3) Enter if drug allergy was generated in the VistA system or a COTS product. "^DD",100.05,100.517,8,21,0) ^.001^2^2^3111005^^^ "^DD",100.05,100.517,8,21,1,0) Stores if drug allergy was generated in the VistA system or a COTS "^DD",100.05,100.517,8,21,2,0) product. "^DD",100.05,100.517,8,"DT") 3110920 "^DD",100.05,100.517,9,0) OBSERVED/HISTORICAL^S^O:Observed;H:Historical;^0;7^Q "^DD",100.05,100.517,9,3) Enter whether the reaction data was observed or was provided by the patient. "^DD",100.05,100.517,9,21,0) ^^2^2^3120131^ "^DD",100.05,100.517,9,21,1,0) Indicates whether this allergy/adverse reaction has been observed by some "^DD",100.05,100.517,9,21,2,0) personnel, or if it is historical data gathered about the patient. "^DD",100.05,100.517,9,"DT") 3120305 "^DD",100.05,100.517,10,0) SEVERITY^S^1:MILD;2:MODERATE;3:SEVERE;^0;8^Q "^DD",100.05,100.517,10,3) Select the severity of the adverse reaction. "^DD",100.05,100.517,10,21,0) ^^1^1^3120319^ "^DD",100.05,100.517,10,21,1,0) This field indicates the severity of this reaction. "^DD",100.05,100.517,10,"DT") 3120319 "^DD",100.05,100.5173,0) VA DRUG CLASS SUB-FIELD^^.01^1 "^DD",100.05,100.5173,0,"DT") 3110915 "^DD",100.05,100.5173,0,"IX","B",100.5173,.01) "^DD",100.05,100.5173,0,"NM","VA DRUG CLASS") "^DD",100.05,100.5173,0,"UP") 100.517 "^DD",100.05,100.5173,.01,0) VA DRUG CLASS^P50.605'^PS(50.605,^0;1^Q "^DD",100.05,100.5173,.01,1,0) ^.1 "^DD",100.05,100.5173,.01,1,1,0) 100.5173^B "^DD",100.05,100.5173,.01,1,1,1) S ^ORD(100.05,DA(2),4,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",100.05,100.5173,.01,1,1,2) K ^ORD(100.05,DA(2),4,DA(1),1,"B",$E(X,1,30),DA) "^DD",100.05,100.5173,.01,3) Enter VA Drug Class. "^DD",100.05,100.5173,.01,21,0) ^.001^1^1^3111006^^^^ "^DD",100.05,100.5173,.01,21,1,0) VA Drug Class associated with the drug allergy. "^DD",100.05,100.5173,.01,"DT") 3111005 "^DD",100.05,100.5174,0) DRUG INGREDIENTS SUB-FIELD^^.01^1 "^DD",100.05,100.5174,0,"DT") 3110915 "^DD",100.05,100.5174,0,"IX","B",100.5174,.01) "^DD",100.05,100.5174,0,"NM","DRUG INGREDIENTS") "^DD",100.05,100.5174,0,"UP") 100.517 "^DD",100.05,100.5174,.01,0) DRUG INGREDIENT^P50.416'^PS(50.416,^0;1^Q "^DD",100.05,100.5174,.01,1,0) ^.1 "^DD",100.05,100.5174,.01,1,1,0) 100.5174^B "^DD",100.05,100.5174,.01,1,1,1) S ^ORD(100.05,DA(2),4,DA(1),2,"B",$E(X,1,30),DA)="" "^DD",100.05,100.5174,.01,1,1,2) K ^ORD(100.05,DA(2),4,DA(1),2,"B",$E(X,1,30),DA) "^DD",100.05,100.5174,.01,3) Enter drug ingredient associated with the drug allergy. "^DD",100.05,100.5174,.01,21,0) ^.001^1^1^3111006^^^^ "^DD",100.05,100.5174,.01,21,1,0) Drug ingredient associated with the drug allergy. "^DD",100.05,100.5174,.01,"DT") 3111005 "^DD",100.05,100.5175,0) SIGNS/SYMPTOMS SUB-FIELD^^.01^1 "^DD",100.05,100.5175,0,"DT") 3110915 "^DD",100.05,100.5175,0,"IX","B",100.5175,.01) "^DD",100.05,100.5175,0,"NM","SIGNS/SYMPTOMS") "^DD",100.05,100.5175,0,"UP") 100.517 "^DD",100.05,100.5175,.01,0) SIGN/SYMPTOM^P120.83'^GMRD(120.83,^0;1^Q "^DD",100.05,100.5175,.01,1,0) ^.1 "^DD",100.05,100.5175,.01,1,1,0) 100.5175^B "^DD",100.05,100.5175,.01,1,1,1) S ^ORD(100.05,DA(2),4,DA(1),3,"B",$E(X,1,30),DA)="" "^DD",100.05,100.5175,.01,1,1,2) K ^ORD(100.05,DA(2),4,DA(1),3,"B",$E(X,1,30),DA) "^DD",100.05,100.5175,.01,3) Enter sign/symptom of drug allergy. "^DD",100.05,100.5175,.01,21,0) ^.001^1^1^3111006^^^^ "^DD",100.05,100.5175,.01,21,1,0) This is a sign/symptom of the drug allergy. "^DD",100.05,100.5175,.01,"DT") 3111006 "^DD",100.05,100.57,0) OVERRIDE REASON SUB-FIELD^^.01^1 "^DD",100.05,100.57,0,"DT") 3070622 "^DD",100.05,100.57,0,"NM","OVERRIDE REASON") "^DD",100.05,100.57,0,"UP") 100.05 "^DD",100.05,100.57,.01,0) OVERRIDE REASON^W^^0;1 "^DD",100.05,100.57,.01,"DT") 3070622 "^DD",100.05,100.58,0) ORDER CHECK MESSAGE SUB-FIELD^^.01^1 "^DD",100.05,100.58,0,"DT") 3070622 "^DD",100.05,100.58,0,"NM","ORDER CHECK MESSAGE") "^DD",100.05,100.58,0,"UP") 100.05 "^DD",100.05,100.58,.01,0) ORDER CHECK MESSAGE^W^^0;1 "^DD",100.05,100.58,.01,"DT") 3070622 "^DIC",100.05,100.05,0) ORDER CHECK INSTANCES^100.05 "^DIC",100.05,100.05,0,"GL") ^ORD(100.05, "^DIC",100.05,100.05,"%",0) ^1.005^^0 "^DIC",100.05,100.05,"%D",0) ^^2^2^3090121^ "^DIC",100.05,100.05,"%D",1,0) The purpose of this file is to create a repository for instances of order "^DIC",100.05,100.05,"%D",2,0) checks that are presented to the users of VISTA across all applications. "^DIC",100.05,"B","ORDER CHECK INSTANCES",100.05) "BLD",8293,6) ^313 **END** **END**