$TXT Created by BARFIELD,RICHARD at FOIA.PLATINUM.VA.GOV (KIDS) on Wednesday, 10/30/24 at 12:49 Warning: Installing this backup patch message will install older versions of routines and Build Components (options, protocols, templates, etc.). Please verify with the Development Team that it is safe to install. $END TXT $KID OR*3.0*535b **INSTALL NAME** OR*3.0*535b "BLD",13817,0) OR*3.0*535b^ORDER ENTRY/RESULTS REPORTING^0^3241030^n "BLD",13817,1,0) ^^5^5^3241030 "BLD",13817,1,1,0) Backup of OR*3.0*535 on Oct 30, 2024 "BLD",13817,1,2,0) "BLD",13817,1,3,0) "BLD",13817,1,4,0) of routines and Build Components (options, protocols, templates, etc.). "BLD",13817,1,5,0) Please verify with the Development Team that it is safe to install. "BLD",13817,4,0) ^9.64PA^100.04^2 "BLD",13817,4,100.04,0) 100.04 "BLD",13817,4,100.04,222) y^y^f^^^^n^^n "BLD",13817,4,100.04,224) "BLD",13817,4,100.8,0) 100.8 "BLD",13817,4,100.8,222) n^y^f^^n^^n^o^n "BLD",13817,4,100.8,224) I Y=100 "BLD",13817,4,"B",100.04,100.04) "BLD",13817,4,"B",100.8,100.8) "BLD",13817,6.3) 0 "BLD",13817,"ABPKG") n^n^n "BLD",13817,"INIT") RSTR^ORY535R "BLD",13817,"KRN",0) ^9.67PA^1.5^25 "BLD",13817,"KRN",.4,0) .4 "BLD",13817,"KRN",.401,0) .401 "BLD",13817,"KRN",.402,0) .402 "BLD",13817,"KRN",.403,0) .403 "BLD",13817,"KRN",.5,0) .5 "BLD",13817,"KRN",.84,0) .84 "BLD",13817,"KRN",1.5,0) "BLD",13817,"KRN",1.6,0) 1.6 "BLD",13817,"KRN",1.61,0) 1.61 "BLD",13817,"KRN",1.62,0) 1.62 "BLD",13817,"KRN",3.6,0) 3.6 "BLD",13817,"KRN",3.8,0) 3.8 "BLD",13817,"KRN",9.2,0) 9.2 "BLD",13817,"KRN",9.8,0) 9.8 "BLD",13817,"KRN",9.8,"NM",0) ^9.68A^25^25 "BLD",13817,"KRN",9.8,"NM",1,0) ORMGMRC^^0^B47176451 "BLD",13817,"KRN",9.8,"NM",2,0) ORMLR^^0^B55099277 "BLD",13817,"KRN",9.8,"NM",3,0) "BLD",13817,"KRN",9.8,"NM",4,0) ORRCLNP^^0^B585941 "BLD",13817,"KRN",9.8,"NM",5,0) ORRCQLPT^^0^B1006284 "BLD",13817,"KRN",9.8,"NM",6,0) ORB3UTL^^0^B53105834 "BLD",13817,"KRN",9.8,"NM",7,0) ORKMGR^^0^B31961626 "BLD",13817,"KRN",9.8,"NM",8,0) ORKPS^^0^B104632974 "BLD",13817,"KRN",9.8,"NM",9,0) ORWORB^^0^B144620893 "BLD",13817,"KRN",9.8,"NM",10,0) ORX1^^0^B28462850 "BLD",13817,"KRN",9.8,"NM",11,0) ORY535^^1^ "BLD",13817,"KRN",9.8,"NM",12,0) ORY5350^^1^ "BLD",13817,"KRN",9.8,"NM",13,0) ORY53501^^1^ "BLD",13817,"KRN",9.8,"NM",14,0) "BLD",13817,"KRN",9.8,"NM",15,0) ORY53503^^1^ "BLD",13817,"KRN",9.8,"NM",16,0) ORY53504^^1^ "BLD",13817,"KRN",9.8,"NM",17,0) ORY53505^^1^ "BLD",13817,"KRN",9.8,"NM",18,0) ORY53506^^1^ "BLD",13817,"KRN",9.8,"NM",19,0) ORY53507^^1^ "BLD",13817,"KRN",9.8,"NM",20,0) ORY53508^^1^ "BLD",13817,"KRN",9.8,"NM",21,0) ORY5351^^1^ "BLD",13817,"KRN",9.8,"NM",22,0) ORY5352^^1^ "BLD",13817,"KRN",9.8,"NM",23,0) ORY5353^^1^ "BLD",13817,"KRN",9.8,"NM",24,0) ORY5354^^1^ "BLD",13817,"KRN",9.8,"NM",25,0) "BLD",13817,"KRN",9.8,"NM","B","ORB3UTL",6) "BLD",13817,"KRN",9.8,"NM","B","ORKMGR",7) "BLD",13817,"KRN",9.8,"NM","B","ORKPS",8) "BLD",13817,"KRN",9.8,"NM","B","ORMGMRC",1) "BLD",13817,"KRN",9.8,"NM","B","ORMLR",2) "BLD",13817,"KRN",9.8,"NM","B","ORMRA",3) "BLD",13817,"KRN",9.8,"NM","B","ORRCLNP",4) "BLD",13817,"KRN",9.8,"NM","B","ORRCQLPT",5) "BLD",13817,"KRN",9.8,"NM","B","ORWORB",9) "BLD",13817,"KRN",9.8,"NM","B","ORX1",10) "BLD",13817,"KRN",9.8,"NM","B","ORY535",11) "BLD",13817,"KRN",9.8,"NM","B","ORY5350",12) "BLD",13817,"KRN",9.8,"NM","B","ORY53501",13) "BLD",13817,"KRN",9.8,"NM","B","ORY53502",14) "BLD",13817,"KRN",9.8,"NM","B","ORY53503",15) "BLD",13817,"KRN",9.8,"NM","B","ORY53504",16) "BLD",13817,"KRN",9.8,"NM","B","ORY53505",17) "BLD",13817,"KRN",9.8,"NM","B","ORY53506",18) "BLD",13817,"KRN",9.8,"NM","B","ORY53507",19) "BLD",13817,"KRN",9.8,"NM","B","ORY53508",20) "BLD",13817,"KRN",9.8,"NM","B","ORY5351",21) "BLD",13817,"KRN",9.8,"NM","B","ORY5352",22) "BLD",13817,"KRN",9.8,"NM","B","ORY5353",23) "BLD",13817,"KRN",9.8,"NM","B","ORY5354",24) "BLD",13817,"KRN",9.8,"NM","B","ORY535ES",25) "BLD",13817,"KRN",19,0) 19 "BLD",13817,"KRN",19,"NM",0) ^9.68A^4^4 "BLD",13817,"KRN",19,"NM",2,0) ORCL OVERRIDE REASONS^^1^ "BLD",13817,"KRN",19,"NM",3,0) ORK METFORMIN EGFR^^1^ "BLD",13817,"KRN",19,"NM","B","ORCL OVERRIDE REASONS",2) "BLD",13817,"KRN",19,"NM","B","ORK METFORMIN EGFR",3) "BLD",13817,"KRN",19.1,0) 19.1 "BLD",13817,"KRN",101,0) "BLD",13817,"KRN",409.61,0) 409.61 "BLD",13817,"KRN",771,0) 771 "BLD",13817,"KRN",779.2,0) 779.2 "BLD",13817,"KRN",870,0) 870 "BLD",13817,"KRN",8989.51,0) 8989.51 "BLD",13817,"KRN",8989.51,"NM",0) ^9.68A^1^1 "BLD",13817,"KRN",8989.51,"NM",1,0) ORK METFORMIN EGFR^^1^ "BLD",13817,"KRN",8989.51,"NM","B","ORK METFORMIN EGFR",1) "BLD",13817,"KRN",8989.52,0) 8989.52 "BLD",13817,"KRN",8993,0) 8993 "BLD",13817,"KRN",8994,0) "BLD",13817,"KRN","B",.4,.4) "BLD",13817,"KRN","B",.401,.401) "BLD",13817,"KRN","B",.402,.402) "BLD",13817,"KRN","B",.403,.403) "BLD",13817,"KRN","B",.5,.5) "BLD",13817,"KRN","B",.84,.84) "BLD",13817,"KRN","B",1.5,1.5) "BLD",13817,"KRN","B",1.6,1.6) "BLD",13817,"KRN","B",1.61,1.61) "BLD",13817,"KRN","B",1.62,1.62) "BLD",13817,"KRN","B",3.6,3.6) "BLD",13817,"KRN","B",3.8,3.8) "BLD",13817,"KRN","B",9.2,9.2) "BLD",13817,"KRN","B",9.8,9.8) "BLD",13817,"KRN","B",19,19) "BLD",13817,"KRN","B",19.1,19.1) "BLD",13817,"KRN","B",101,101) "BLD",13817,"KRN","B",409.61,409.61) "BLD",13817,"KRN","B",771,771) "BLD",13817,"KRN","B",779.2,779.2) "BLD",13817,"KRN","B",870,870) "BLD",13817,"KRN","B",8989.51,8989.51) "BLD",13817,"KRN","B",8989.52,8989.52) "BLD",13817,"KRN","B",8993,8993) "BLD",13817,"KRN","B",8994,8994) "FIA",100.04) ORDER CHECK OVERRIDE REASONS "FIA",100.04,0) ^ORD(100.04, "FIA",100.04,0,0) 100.04 "FIA",100.04,0,1) y^y^f^^^^n^^n "FIA",100.04,0,10) "FIA",100.04,0,11) "FIA",100.04,0,"RLRO") "FIA",100.04,100.04) "FIA",100.8) ORDER CHECKS "FIA",100.8,0) ^ORD(100.8, "FIA",100.8,0,0) 100.8 "FIA",100.8,0,1) n^y^f^^n^^n^o^n "FIA",100.8,0,10) "FIA",100.8,0,11) I Y=100 "FIA",100.8,0,"RLRO") "FIA",100.8,100.8) 0 "FIA",100.8,100.82) 0 "INIT") RSTR^ORY535R "IX",100.04,100.04,"B",0) IR^I^100.04^^^^^LS "IX",100.04,100.04,"B",1) S ^OR(100.04,"B",X,DA)="" "IX",100.04,100.04,"B",2) K ^OR(100.04,"B",X,DA) "IX",100.04,100.04,"B",2.5) K ^OR(100.04,"B") "IX",100.04,100.04,"B",11.1,0) ^.114IA^1^1 "IX",100.04,100.04,"B",11.1,1,0) 1^F^100.04^.01^^1^F "IX",100.04,100.04,"B",11.1,1,2) S X=$P(X,".") "KRN",19,12362,-1) 1^2 "KRN",19,12362,0) ORCL OVERRIDE REASONS "KRN",19,12363,-1) 1^3 "KRN",19,12363,0) ORK METFORMIN EGFR 1^1 "KRN",8989.51,4762,0) ORK METFORMIN EGFR "MBREQ") "ORD",0,9.8) 9.8;;1;RTNF^XPDTA;RTNE^XPDTA "ORD",0,9.8,0) ROUTINE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "ORD",20,8989.51) 8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^X PDIA3(%) "ORD",20,8989.51,0) PARAMETER DEFINITION "PKG",35,-1) 1^1 "PKG",35,0) "PKG",35,22,0) ^9.49I^1^1 "PKG",35,22,1,0) 3.0^3241030 "PKG",35,22,1,"PAH",1,0) 535b^3241030 "PKG",35,22,1,"PAH",1,1,0) ^^5^5^3241030 "PKG",35,22,1,"PAH",1,1,1,0) Backup of OR*3.0*535 on Oct 30, 2024 "PKG",35,22,1,"PAH",1,1,2,0) "PKG",35,22,1,"PAH",1,1,3,0) Warning: Installing this backup patch message will install older versions "PKG",35,22,1,"PAH",1,1,4,0) of routines and Build Components (options, protocols, templates, etc.). "PKG",35,22,1,"PAH",1,1,5,0) Please verify with the Development Team that it is safe to install. "QUES","XPF1",0) Y "QUES","XPF1","??") "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") "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") "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") "RTN") 26 "RTN","ORB3UTL") 0^6^B53105834 "RTN","ORB3UTL",1,0) ORB3UTL ;SLC/JMH - OE/RR Notification Utilities ;Aug 20, 2019@09:43 "RTN","ORB3UTL",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377,539**;Dec 17, 1997;Build 0 "RTN","ORB3UTL",3,0) ; "RTN","ORB3UTL",4,0) GENALRTS ;fire off due alerts "RTN","ORB3UTL",5,0) ;get unfired records "RTN","ORB3UTL",6,0) N ORI S ORI=0 "RTN","ORB3UTL",7,0) F S ORI=$O(^OR(100.97,"C",0,ORI)) Q:'ORI D "RTN","ORB3UTL",8,0) .N ORWHEN S ORWHEN=$P($G(^OR(100.97,ORI,0)),U,3) "RTN","ORB3UTL",9,0) "RTN","ORB3UTL",10,0) Q "RTN","ORB3UTL",11,0) ; "RTN","ORB3UTL",12,0) GENALRT(ORID) ;fire a specific scheduled alert "RTN","ORB3UTL",13,0) N ORDUZ,ORMSG "RTN","ORB3UTL",14,0) S ORDUZ($P($G(^OR(100.97,ORID,0)),U,4))=$P($G(^OR(100.97,ORID,0)),U,4) "RTN","ORB3UTL",15,0) S ORMSG=$G(^OR(100.97,ORID,2)) "RTN","ORB3UTL",16,0) N ORI S ORI=0 F S ORI=$O(^OR(100.97,ORID,3,ORI)) Q:'ORI S ORMSG(ORI)=$G(^OR( 100.97,ORID,3,ORI,0)) "RTN","ORB3UTL",17,0) N ORDFN S ORDFN=+$G(^OR(100.97,ORID,0)) "RTN","ORB3UTL",18,0) D EN^ORB3(90,ORDFN,"",.ORDUZ,.ORMSG,"") "RTN","ORB3UTL",19,0) N ORXQAID S ORXQAID="OR,"_ORDFN_",90;"_$P($G(^OR(100.97,ORID,0)),U,4)_";"_$$NO "RTN","ORB3UTL",20,0) K ORFDART,ORMSGRT "RTN","ORB3UTL",21,0) S ORFDART(100.97,ORID_",",4)=ORXQAID "RTN","ORB3UTL",22,0) S ORFDART(100.97,ORID_",",7)=$$NOW^XLFDT() "RTN","ORB3UTL",23,0) D FILE^DIE("","ORFDART","ORMSGRT") "RTN","ORB3UTL",24,0) Q ORXQAID "RTN","ORB3UTL",25,0) ; "RTN","ORB3UTL",26,0) SCHALRT(ORDATA) ;Schedule a long text alert "RTN","ORB3UTL",27,0) ;ORDATA fields "RTN","ORB3UTL",28,0) ; PATIENT - File 2 IEN - for the patient this alert is for "RTN","ORB3UTL",29,0) ; WHEN - date/time of when this alert will be generated "RTN","ORB3UTL",30,0) "RTN","ORB3UTL",31,0) ; TITLE - Free Text title of alert "RTN","ORB3UTL",32,0) ; BODY(D0) - Word Processing body of the alert for long text "RTN","ORB3UTL",33,0) N DIC,DIE,DR,DA,ORFDART,ORIENRT,ORMSGRT "RTN","ORB3UTL",34,0) S ORFDART(100.97,"+1,",.01)=ORDATA("PATIENT") "RTN","ORB3UTL",35,0) D UPDATE^DIE("","ORFDART","ORIENRT","ORMSGRT") "RTN","ORB3UTL",36,0) I $D(ORIENRT(1)) S DA=ORIENRT(1) "RTN","ORB3UTL",37,0) S DIC="^OR(100.97,",DIC(0)="F",DIE=DIC "RTN","ORB3UTL",38,0) S DR="1////"_$$NOW^XLFDT()_";2////"_ORDATA("WHEN")_";3////"_ORDATA("WHO")_";5/ ///"_ORDATA("TITLE")_";4////0"_";8////"_$G(ORDATA("IFN")) "RTN","ORB3UTL",39,0) D ^DIE "RTN","ORB3UTL",40,0) D WP^DIE(100.97,DA_",",6,,"ORDATA(""BODY"")","ERROR") Q "RTN","ORB3UTL",42,0) ; "RTN","ORB3UTL",43,0) DEFER(ORY,ORPROV,ORALERT,ORDT) ;defer an alert "RTN","ORB3UTL",44,0) ;ORALERT - alert to defer "RTN","ORB3UTL",45,0) ;ORPROV - provider to defer the alert for "RTN","ORB3UTL",46,0) ;ORDT - date/time to defer the alert until "RTN","ORB3UTL",47,0) N ORROOT "RTN","ORB3UTL",48,0) S ORY=1 "RTN","ORB3UTL",49,0) ;CALL KERNEL API FOR DEFERRAL "RTN","ORB3UTL",50,0) D DEFALERT^XQALDATA("ORROOT",ORPROV,ORDT,ORALERT) "RTN","ORB3UTL",51,0) N ORRES S ORRES=$G(ORROOT(1),1) I $P(ORRES,U)<0 S ORY=ORRES "RTN","ORB3UTL",53,0) Q "RTN","ORB3UTL",54,0) NOTIFPG(ORY,ORPAT,ORFROM,ORTO) ;page through a patients alerts "RTN","ORB3UTL",55,0) ;ORPAT - patient DFN "RTN","ORB3UTL",56,0) ;ORPG - page to get "RTN","ORB3UTL",57,0) ;ORPGSZ - page size (defaults to 25) "RTN","ORB3UTL",58,0) N URGLIST,REMLIST,NONORLST,ORY2,I,ORTOTU,ORTOT "RTN","ORB3UTL",59,0) N ALRT,ALRTDFN,ALRTDT,ALRTI,ALRTLOC,ALRTMSG,ALRTPT,ALRTXQA,FWDBY,J,NONOR,ORHAS ,ORN,ORN0,ORURG,PRE,REM,URG "RTN","ORB3UTL",60,0) D INDNOT(.ORY2) "RTN","ORB3UTL",61,0) K ORY "RTN","ORB3UTL",62,0) "RTN","ORB3UTL",63,0) D GETPAT3^XQALDATA("^TMP(""ORB2"",$J)",ORPAT,ORFROM,ORTO) "RTN","ORB3UTL",64,0) D URGLIST^ORQORB(.URGLIST) "RTN","ORB3UTL",65,0) D REMLIST^ORQORB(.REMLIST) "RTN","ORB3UTL",66,0) D REMNONOR^ORQORB(.NONORLST) "RTN","ORB3UTL",67,0) S (I,J)=0 "RTN","ORB3UTL",68,0) F S I=$O(^TMP("ORB2",$J,I)) Q:'I D "RTN","ORB3UTL",69,0) .N ORPROV ; ajb "RTN","ORB3UTL",70,0) .S ALRTDFN="" "RTN","ORB3UTL",71,0) .S ALRT=^TMP("ORB2",$J,I) "RTN","ORB3UTL",72,0) .S PRE=$E(ALRT,1,1) "RTN","ORB3UTL",73,0) "RTN","ORB3UTL",74,0) .S NONOR="" F S NONOR=$O(NONORLST(NONOR)) Q:NONOR="" D "RTN","ORB3UTL",75,0) ..I ALRTXQA[NONOR S REM=1 ;allow this type of alert to be Removed "RTN","ORB3UTL",76,0) .S ALRTMSG=$P($P(ALRT,U),PRE_" ",2) "RTN","ORB3UTL",77,0) .I $E(ALRT,4,8)'="-----" D ;not forwarded alert info/comment "RTN","ORB3UTL",78,0) ..S ORURG="n/a" "RTN","ORB3UTL",79,0) ..S ALRTI=$P(ALRT," ") "RTN","ORB3UTL",80,0) ..S ALRTPT="" "RTN","ORB3UTL",81,0) ..S ALRTLOC="" "RTN","ORB3UTL",82,0) ..I $E($P(ALRTXQA,";"),1,3)="TIU" S ORURG="Moderate" "RTN","ORB3UTL",83,0) ..I $P(ALRTXQA,",")="OR" D "RTN","ORB3UTL",84,0) "RTN","ORB3UTL",85,0) ... D "RTN","ORB3UTL",86,0) .... N XQALERTD D ALERTDAT^XQALBUTL(ALRTXQA) "RTN","ORB3UTL",87,0) .... S ORPROV=$$GET1^DIQ(100,+XQALERTD("2"),1) "RTN","ORB3UTL",88,0) ...; ajb "RTN","ORB3UTL",89,0) ...S ORN=$P($P(ALRTXQA,";"),",",3) "RTN","ORB3UTL",90,0) ...S URG=$G(URGLIST(ORN)) "RTN","ORB3UTL",91,0) ...S ORURG=$S(URG=1:"HIGH",URG=2:"Moderate",1:"low") "RTN","ORB3UTL",92,0) ...S REM=$G(REMLIST(ORN)) "RTN","ORB3UTL",93,0) ...S ORN0=$G(^ORD(100.9,+ORN,0)) "RTN","ORB3UTL",94,0) ...S ALRTI=$S(ORN=90:"L",$P(ORN0,U,6)="INFODEL":"I",1:"") "RTN","ORB3UTL",95,0) "RTN","ORB3UTL",96,0) ...S ALRTLOC=$G(^DPT(+$G(ALRTDFN),.1)) "RTN","ORB3UTL",97,0) ..S ALRTI=$S(ALRTI="I":"I",ALRTI="L":"L",1:"") "RTN","ORB3UTL",98,0) ..I (ALRT["): ")!($G(ORN)=27&(ALRT[") CV")) D ;WAT "RTN","ORB3UTL",99,0) ...S ALRTPT=$P(ALRT,": ") "RTN","ORB3UTL",100,0) ...S ALRTPT=$E(ALRTPT,4,$L(ALRTPT)) "RTN","ORB3UTL",101,0) ...I $G(ORN)=27&(ALRT[") CV") S ALRTMSG=$P($P(ALRT,U),": ",2) ;WAT "RTN","ORB3UTL",102,0) ...E S ALRTMSG=$P($P(ALRT,U),"): ",2) ;WAT "RTN","ORB3UTL",103,0) ...I $E(ALRTMSG,1,1)="[" D "RTN","ORB3UTL",104,0) ....S:'$L(ALRTLOC) ALRTLOC=$P($P(ALRTMSG,"]"),"[",2) "RTN","ORB3UTL",105,0) ....S ALRTMSG=$P(ALRTMSG,"] ",2) "RTN","ORB3UTL",106,0) "RTN","ORB3UTL",107,0) ..S ALRTDT=$P(ALRTXQA,";",3) "RTN","ORB3UTL",108,0) ..S ALRTDT=$P(ALRTDT,".")_"."_$E($P(ALRTDT,".",2)_"0000",1,4) "RTN","ORB3UTL",109,0) ..S ALRTDT=$E(ALRTDT,4,5)_"/"_$E(ALRTDT,6,7)_"/"_($E(ALRTDT,1,3)+1700)_"@"_$E( $P(ALRTDT,".",2),1,2)_":"_$E($P(ALRTDT,".",2),3,4) "RTN","ORB3UTL",110,0) ..;S ALRTDT=($E(ALRTDT,1,3)+1700)_"/"_$E(ALRTDT,4,5)_"/"_$E(ALRTDT,6,7)_"@"_$E ($P(ALRTDT,".",2),1,2)_":"_$E($P(ALRTDT,".",2),3,4) "RTN","ORB3UTL",111,0) ..S J=J+1,^TMP("ORBG",$J,J)=ALRTI_U_ALRTPT_U_ALRTLOC_U_ORURG_U_ALRTDT_U "RTN","ORB3UTL",112,0) ..S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_ALRTMSG_U_U_ALRTXQA_U_$G(REM)_U "RTN","ORB3UTL",113,0) .; "RTN","ORB3UTL",114,0) .;if alert forward info/comment: "RTN","ORB3UTL",115,0) .I $E(ALRTMSG,1,5)="-----" D "RTN","ORB3UTL",116,0) "RTN","ORB3UTL",117,0) ..I $E(ALRTMSG,1,14)=FWDBY D "RTN","ORB3UTL",118,0) ...S J=J+1,^TMP("ORBG",$J,J)=FWDBY_U_$P($P(ALRTMSG,FWDBY,2),"Generated: ")_$P( $P(ALRTMSG,FWDBY,2),"Generated: ",2) "RTN","ORB3UTL",119,0) ..E S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_""""_ALRTMSG_"""" "RTN","ORB3UTL",120,0) .S ORHAS=$S($D(ORY2(ALRTXQA)):1,1:0) "RTN","ORB3UTL",121,0) .S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_ORHAS "RTN","ORB3UTL",122,0) .I $G(ORPROV)'="" S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_ORPROV ; ajb "RTN","ORB3UTL",123,0) ;S ^TMP("ORBG",$J)="" "RTN","ORB3UTL",124,0) S ^TMP("ORBG",$J,0)=^TMP("ORB2",$J,0) "RTN","ORB3UTL",125,0) S ORY=$NA(^TMP("ORBG",$J)) "RTN","ORB3UTL",126,0) Q ; "RTN","ORB3UTL",128,0) INDNOT(ORY) ;index the user's alerts by the xqaldata, include deferred alerts "RTN","ORB3UTL",129,0) N ORY2 D FASTUSER^ORWORB(.ORY2,0) "RTN","ORB3UTL",130,0) N ORI S ORI=0 F S ORI=$O(@ORY2@(ORI)) Q:'ORI D "RTN","ORB3UTL",131,0) . I $L($P(@ORY2@(ORI),U,8))>0 S ORY($P(@ORY2@(ORI),U,8))=@ORY2@(ORI) "RTN","ORB3UTL",132,0) Q "RTN","ORB3UTL",133,0) ; "RTN","ORB3UTL",134,0) GETNOTIF(RETURN,ALERT) ; Return a notification structure to the SMART Dialog Sy stem "RTN","ORB3UTL",135,0) Set RETURN=$NA(^TMP($J)) Kill @RETURN "RTN","ORB3UTL",136,0) New ORTMP,X,IEN,IENS,DFN "RTN","ORB3UTL",137,0) "RTN","ORB3UTL",138,0) Set IEN=+$Piece(ALERT,",",3),IENS=IEN_"," "RTN","ORB3UTL",139,0) Set @RETURN@(0)="PROCESS AS SMART NOTIFICATION="_+$$GET1^DIQ(100.9,IENS,6.1,"I ") "RTN","ORB3UTL",140,0) Quit:'$Piece(@RETURN@(0),"=",2) ; Flag not set for SMART processing "RTN","ORB3UTL",141,0) Set @RETURN@(1)="NOTE TITLE="_$$GET1^DIQ(100.9,IENS,6.2,"E") "RTN","ORB3UTL",142,0) Set @RETURN@(2)="NOTE TITLE IEN="_+$$GET1^DIQ(100.9,IENS,6.2,"I") "RTN","ORB3UTL",143,0) Set @RETURN@(3)="NOTIFICATION IEN="_IEN "RTN","ORB3UTL",144,0) Set @RETURN@(4)="NOTIFICATION NAME="_$$GET1^DIQ(100.9,IENS,.01,"E") "RTN","ORB3UTL",145,0) Set @RETURN@(5)="ALLOW ADDENDUM="_+$$GET1^DIQ(100.9,IENS,6.3,"I") "RTN","ORB3UTL",146,0) Set @RETURN@(6)="TIU OBJECT="_+$$GET1^DIQ(100.9,IENS,6.4,"I") "RTN","ORB3UTL",147,0) Set @RETURN@(7)="DFN="_DFN Set @RETURN@(8)="ALERT="_ALERT "RTN","ORB3UTL",149,0) Set @RETURN@(9)="PATIENT NAME="_$P($G(^DPT(DFN,0)),U) "RTN","ORB3UTL",150,0) Quit "RTN","ORB3UTL",151,0) ; "RTN","ORB3UTL",152,0) GETNOTES(RETURN,DOC,DFN) ; Returns existing notes that can be addended "RTN","ORB3UTL",153,0) Set RETURN=$NA(^TMP($J)) Kill @RETURN "RTN","ORB3UTL",154,0) New ROOT,STAT,IEN,LOOP "RTN","ORB3UTL",155,0) For STAT=7,8 Do "RTN","ORB3UTL",156,0) . Set LOOP=$Name(^TIU(8925,"APT",DFN,DOC,STAT)) "RTN","ORB3UTL",157,0) . Set ROOT=$Extract(LOOP,1,$Length(LOOP)-1)_"," "RTN","ORB3UTL",158,0) . For Set LOOP=$Query(@LOOP) Quit:$Piece(LOOP,ROOT)'="" Do . . S IEN=$QSubscript(LOOP,$QLength(LOOP)) "RTN","ORB3UTL",160,0) . . ; Validate MAKE ADDENDUM "RTN","ORB3UTL",161,0) . . Q:'$$CANDO^TIULP(IEN,"MAKE ADDENDUM") "RTN","ORB3UTL",162,0) . . Set @RETURN@(0)=$Get(@RETURN@(0))+1 "RTN","ORB3UTL",163,0) . . Set @RETURN@(@RETURN@(0))=IEN_U_$$GET1^DIQ(8925,IEN,.01)_U_$$GET1^DIQ(8925 ,IEN,1301)_U_$$GET1^DIQ(8925,IEN,1211) "RTN","ORB3UTL",164,0) S @RETURN@(0)="COUNT="_$G(@RETURN@(0)) "RTN","ORB3UTL",165,0) Quit "RTN","ORB3UTL",166,0) ; "RTN","ORB3UTL",167,0) GETDESC(RETURN,ALERT) ; Returns notification description "RTN","ORB3UTL",168,0) S RETURN=$NA(^TMP($J)) K @RETURN "RTN","ORB3UTL",169,0) "RTN","ORB3UTL",170,0) I 'ORNOTID D Q "RTN","ORB3UTL",171,0) .S @RETURN@(0)="UNABLE TO DETERMINE ALERT" "RTN","ORB3UTL",172,0) N ORTIUOBJ S ORTIUOBJ=$P($G(^ORD(100.9,ORNOTID,6)),U,4) "RTN","ORB3UTL",173,0) I 'ORTIUOBJ D Q "RTN","ORB3UTL",174,0) .S @RETURN@(0)="NO DATA OBJECT SETUP" "RTN","ORB3UTL",175,0) S ORTIUOBJ=$P($G(^TIU(8925.1,ORTIUOBJ,0)),U,1) "RTN","ORB3UTL",176,0) I '$L(ORTIUOBJ) D Q "RTN","ORB3UTL",177,0) .S @RETURN@(0)="NO DATA OBJECT SETUP" "RTN","ORB3UTL",178,0) N DFN S DFN=$P($P(ALERT,";"),",",2) "RTN","ORB3UTL",179,0) I 'DFN D Q "RTN","ORB3UTL",180,0) "RTN","ORB3UTL",181,0) ; Value from the TIU OBJECT specified in file 100.9, field 6.4 "RTN","ORB3UTL",182,0) N ORBOIL S ORBOIL=$$BOIL^TIUSRVD("|"_ORTIUOBJ_"|") "RTN","ORB3UTL",183,0) I $E(ORBOIL,0,2)="~@" D "RTN","ORB3UTL",184,0) .N ORGLOB S ORGLOB=$P(ORBOIL,"~@",2) "RTN","ORB3UTL",185,0) .I $D(@ORGLOB) D "RTN","ORB3UTL",186,0) ..N ORGLOBI S ORGLOBI=0 F S ORGLOBI=$O(@ORGLOB@(ORGLOBI)) Q:'ORGLOBI D "RTN","ORB3UTL",187,0) ...S @RETURN@(ORGLOBI-1)=@ORGLOB@(ORGLOBI,0) "RTN","ORB3UTL",188,0) E S @RETURN@(0)=ORBOIL "RTN","ORB3UTL",189,0) Q "RTN","ORB3UTL",190,0) ; "RTN","ORKMGR") "RTN","ORKMGR",1,0) ORKMGR ; SLC/AEB,CLA - Manager Options - Order Checking Parameters ;9/22/97 "RTN","ORKMGR",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,105,401**;Dec 17, 1997;Build 0 "RTN","ORKMGR",3,0) ; "RTN","ORKMGR",4,0) ;References to ^XPAR supported by IA #2263 "RTN","ORKMGR",5,0) ;Direct read of 8989.51 "B" index supported by IA #2685 "RTN","ORKMGR",6,0) ;References to ^DIR supported by IA #10026 "RTN","ORKMGR",7,0) ;Fileman read of File 200 Field .01 field supported by IA #10060 "RTN","ORKMGR",8,0) ;Fileman read of File 44 Field .01 field supported by IA #10040 "RTN","ORKMGR",9,0) ;Fileman read of File 49 Field .01 supported by IA #10093 "RTN","ORKMGR",10,0) ;Fileman read of File 4 Field .01 supported by IA #10090 "RTN","ORKMGR",11,0) "RTN","ORKMGR",12,0) ;Fileman read of File 9.4 Field .01 supported by IA #10048 "RTN","ORKMGR",13,0) ;Reference to $$GET1^DIQ() supported by IA #2056 "RTN","ORKMGR",14,0) ; "RTN","ORKMGR",15,0) PFLAG ; "RTN","ORKMGR",16,0) N ORKT,PAR,PIEN "RTN","ORKMGR",17,0) S ORKT="Enable/Disable an Order Check",PIEN=0 "RTN","ORKMGR",18,0) S PIEN=$O(^XTV(8989.51,"B","ORK PROCESSING FLAG",PIEN)) Q:PIEN="" "RTN","ORKMGR",19,0) S PAR=PIEN "RTN","ORKMGR",20,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",21,0) Q "RTN","ORKMGR",22,0) "RTN","ORKMGR",23,0) CLINDL ; "RTN","ORKMGR",24,0) N ORKT,PAR,PIEN "RTN","ORKMGR",25,0) S ORKT="Set Clinical Danger Level for an Order Check",PIEN=0 "RTN","ORKMGR",26,0) S PIEN=$O(^XTV(8989.51,"B","ORK CLINICAL DANGER LEVEL",PIEN)) Q:PIEN="" "RTN","ORKMGR",27,0) S PAR=PIEN "RTN","ORKMGR",28,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",29,0) Q "RTN","ORKMGR",30,0) ; "RTN","ORKMGR",31,0) CTLIMH ; "RTN","ORKMGR",32,0) N ORKT,PAR,PIEN "RTN","ORKMGR",33,0) "RTN","ORKMGR",34,0) S PIEN=$O(^XTV(8989.51,"B","ORK CT LIMIT HT",PIEN)) Q:PIEN="" "RTN","ORKMGR",35,0) S PAR=PIEN "RTN","ORKMGR",36,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",37,0) Q "RTN","ORKMGR",38,0) ; "RTN","ORKMGR",39,0) CTLIMW ; "RTN","ORKMGR",40,0) N ORKT,PAR,PIEN "RTN","ORKMGR",41,0) S ORKT="CAT Scanner Weight Limit",PIEN=0 "RTN","ORKMGR",42,0) S PIEN=$O(^XTV(8989.51,"B","ORK CT LIMIT WT",PIEN)) Q:PIEN="" "RTN","ORKMGR",43,0) S PAR=PIEN "RTN","ORKMGR",44,0) "RTN","ORKMGR",45,0) Q "RTN","ORKMGR",46,0) ; "RTN","ORKMGR",47,0) MRLIMH ; "RTN","ORKMGR",48,0) N ORKT,PAR,PIEN "RTN","ORKMGR",49,0) S ORKT="MRI Scanner Height Limit",PIEN=0 "RTN","ORKMGR",50,0) S PIEN=$O(^XTV(8989.51,"B","ORK MRI LIMIT HT",PIEN)) Q:PIEN="" "RTN","ORKMGR",51,0) S PAR=PIEN "RTN","ORKMGR",52,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",53,0) Q "RTN","ORKMGR",54,0) ; "RTN","ORKMGR",55,0) "RTN","ORKMGR",56,0) N ORKT,PAR,PIEN "RTN","ORKMGR",57,0) S ORKT="MRI Scanner Weight Limit",PIEN=0 "RTN","ORKMGR",58,0) S PIEN=$O(^XTV(8989.51,"B","ORK MRI LIMIT WT",PIEN)) Q:PIEN="" "RTN","ORKMGR",59,0) S PAR=PIEN "RTN","ORKMGR",60,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",61,0) Q "RTN","ORKMGR",62,0) ; "RTN","ORKMGR",63,0) DUPOR ; "RTN","ORKMGR",64,0) N ORKT,PAR,PIEN "RTN","ORKMGR",65,0) S ORKT="Orderable Item Duplicate Order Range",PIEN=0 "RTN","ORKMGR",66,0) "RTN","ORKMGR",67,0) S PAR=PIEN "RTN","ORKMGR",68,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",69,0) Q "RTN","ORKMGR",70,0) ; "RTN","ORKMGR",71,0) DUPLR ; "RTN","ORKMGR",72,0) N ORKT,PAR,PIEN "RTN","ORKMGR",73,0) S ORKT="Lab Duplicate Order Range",PIEN=0 "RTN","ORKMGR",74,0) S PIEN=$O(^XTV(8989.51,"B","ORK DUP ORDER RANGE LAB",PIEN)) Q:PIEN="" "RTN","ORKMGR",75,0) S PAR=PIEN "RTN","ORKMGR",76,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",77,0) "RTN","ORKMGR",78,0) ; "RTN","ORKMGR",79,0) DUPRA ; "RTN","ORKMGR",80,0) N ORKT,PAR,PIEN "RTN","ORKMGR",81,0) S ORKT="Imaging Duplicate Order Range",PIEN=0 "RTN","ORKMGR",82,0) S PIEN=$O(^XTV(8989.51,"B","ORK DUP ORDER RANGE RADIOLOGY",PIEN)) Q:PIEN="" "RTN","ORKMGR",83,0) S PAR=PIEN "RTN","ORKMGR",84,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",85,0) Q "RTN","ORKMGR",86,0) ; "RTN","ORKMGR",87,0) SYSEN ; "RTN","ORKMGR",88,0) "RTN","ORKMGR",89,0) S ORKT="Enable or Disable Order Checking System",PIEN=0 "RTN","ORKMGR",90,0) S PIEN=$O(^XTV(8989.51,"B","ORK SYSTEM ENABLE/DISABLE",PIEN)) Q:PIEN="" "RTN","ORKMGR",91,0) S PAR=PIEN "RTN","ORKMGR",92,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",93,0) Q "RTN","ORKMGR",94,0) ; "RTN","ORKMGR",95,0) DEBUG ; "RTN","ORKMGR",96,0) N ORKT,PAR,PIEN "RTN","ORKMGR",97,0) S ORKT="Enable or Disable Logging Debug Messages",PIEN=0 "RTN","ORKMGR",98,0) S PIEN=$O(^XTV(8989.51,"B","ORK DEBUG ENABLE/DISABLE",PIEN)) Q:PIEN="" "RTN","ORKMGR",99,0) "RTN","ORKMGR",100,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",101,0) Q "RTN","ORKMGR",102,0) ; "RTN","ORKMGR",103,0) POLYRX ; "RTN","ORKMGR",104,0) N ORKT,PAR,PIEN "RTN","ORKMGR",105,0) S ORKT="Set Number of Meds for Polypharmacy",PIEN=0 "RTN","ORKMGR",106,0) S PIEN=$O(^XTV(8989.51,"B","ORK POLYPHARMACY",PIEN)) Q:PIEN="" "RTN","ORKMGR",107,0) S PAR=PIEN "RTN","ORKMGR",108,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",109,0) Q "RTN","ORKMGR",110,0) "RTN","ORKMGR",111,0) GLUCREAT ; "RTN","ORKMGR",112,0) N ORKT,PAR,PIEN "RTN","ORKMGR",113,0) S ORKT="Set Creatinine Search Range for Glucophage-Lab Results Order Check",PI EN=0 "RTN","ORKMGR",114,0) S PIEN=$O(^XTV(8989.51,"B","ORK GLUCOPHAGE CREATININE",PIEN)) Q:PIEN="" "RTN","ORKMGR",115,0) S PAR=PIEN "RTN","ORKMGR",116,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",117,0) Q "RTN","ORKMGR",118,0) ; "RTN","ORKMGR",119,0) EDITUSER ; "RTN","ORKMGR",120,0) N ORKT,PAR,PIEN S ORKT="Set One or More Order Checks to be Uneditable By End Users",PIEN=0 "RTN","ORKMGR",122,0) S PIEN=$O(^XTV(8989.51,"B","ORK EDITABLE BY USER",PIEN)) Q:PIEN="" "RTN","ORKMGR",123,0) ;P.401 added check for existing disabled parameters "RTN","ORKMGR",124,0) N OLDLIST,NEWLIST,ERR,ORPFIEN "RTN","ORKMGR",125,0) S ORPFIEN=0 S ORPFIEN=$O(^XTV(8989.51,"B","ORK PROCESSING FLAG",ORPFIEN)) "RTN","ORKMGR",126,0) D ENVAL^XPAR(.OLDLIST,PIEN,,.ERR) "RTN","ORKMGR",127,0) S PAR=PIEN "RTN","ORKMGR",128,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",129,0) I '$G(ERR) D ENVAL^XPAR(.NEWLIST,PIEN,,.ERR) "RTN","ORKMGR",130,0) Q:$G(ERR) "RTN","ORKMGR",131,0) N ORENT S ORENT="" F S ORENT=$O(NEWLIST(ORENT)) Q:'ORENT N ORINST S ORINST= ))!($G(OLDLIST(ORENT,ORINST))=1))&(($G(NEWLIST(ORENT,ORINST))=0)) D "RTN","ORKMGR",132,0) .N PFLIST D ENVAL^XPAR(.PFLIST,ORPFIEN,,.ERR) Q:$G(ERR) "RTN","ORKMGR",133,0) .N PFENT S PFENT="" F S PFENT=$O(PFLIST(PFENT)) Q:'PFENT N PFINST S PFINST=" " F S PFINST=$O(PFLIST(PFENT,PFINST)) Q:'PFINST I PFINST=ORINST D "RTN","ORKMGR",134,0) ..D CHG^XPAR(PFENT,ORPFIEN,"`"_PFINST,"E",.ERR) "RTN","ORKMGR",135,0) Q "RTN","ORKMGR",136,0) ; "RTN","ORKMGR",137,0) CMCREAT ; "RTN","ORKMGR",138,0) N ORKT,PAR,PIEN "RTN","ORKMGR",139,0) S ORKT="Set Creatinine Search Range for Biochem Abnormality for Contrast Media Order Chk",PIEN=0 "RTN","ORKMGR",140,0) S PIEN=$O(^XTV(8989.51,"B","ORK CONTRAST MEDIA CREATININE",PIEN)) Q:PIEN="" S PAR=PIEN "RTN","ORKMGR",142,0) D TITLE(ORKT) D PROC(PAR) "RTN","ORKMGR",143,0) Q "RTN","ORKMGR",144,0) ; "RTN","ORKMGR",145,0) TITLE(ORKT) ; "RTN","ORKMGR",146,0) ; Center and write title - Parameter to be set "RTN","ORKMGR",147,0) S IOP=0 D ^%ZIS K IOP W @IOF "RTN","ORKMGR",148,0) W !,?(80-$L(ORKT)-1/2),ORKT "RTN","ORKMGR",149,0) Q "RTN","ORKMGR",150,0) PROC(PAR) ; Process Parameter Settings "RTN","ORKMGR",151,0) D EDITPAR^XPAREDIT(PAR) Q "RTN","ORKMGR",153,0) USRCHKS ; List order checks a user could receive "RTN","ORKMGR",154,0) N ORKUSR "RTN","ORKMGR",155,0) ; Get user DUZ number "RTN","ORKMGR",156,0) K DIC,Y S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name: ",DIC("B")= DUZ D ^DIC Q:Y<1 "RTN","ORKMGR",157,0) S ORKUSR=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT "RTN","ORKMGR",158,0) D USRCHKS^ORKUTL(ORKUSR) "RTN","ORKMGR",159,0) Q "RTN","ORKPS") 0^8^B104632974 "RTN","ORKPS",1,0) ORKPS ; slc/CLA - Order checking support procedures for medications ;12/29/17 11:58 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,141,190,232,316,272,346,3 45,382,469**;Dec 17, 1997;Build 0 "RTN","ORKPS",3,0) Q "RTN","ORKPS",4,0) CHECK(YY,DFN,MED,OI,ORKDG,OROIL,ORSUPPLY,ORIVTYPE,ORIVRAN,ORDODSG) ; return dru g order checks "RTN","ORKPS",5,0) ;YY: returned array of data "RTN","ORKPS",6,0) ;DFN: patient id "RTN","ORKPS",7,0) ;MED: drug ien [file #50] ^ generic name [file #50] "RTN","ORKPS",8,0) ;OI: orderable item ien [file #101.43] "RTN","ORKPS",9,0) ;ORKDG: display group (should be PSI, PSIV, PSO or PSH) "RTN","ORKPS",10,0) ;OROIL: list of items ordered "RTN","ORKPS",11,0) ;ORSUPPLY: pharmacy orderable item ien [file #50.7] if it resolves to one or m "RTN","ORKPS",12,0) ; 0 if the pharmacy orderable item does not resolve to any supply ite ms "RTN","ORKPS",13,0) ;ORIVTYPE: the MED type as sent from Infusion Order Dialog "RTN","ORKPS",14,0) ; A for additive "RTN","ORKPS",15,0) ; B for base "RTN","ORKPS",16,0) ;ORIVRAN: FLAG THAT DENOTES IF ALL COMPONENTS OF INFUSION ORDER HAVE ALREADY B EEN PROCESSED "RTN","ORKPS",17,0) ; 1 FOR ALREADY PROCESSED "RTN","ORKPS",18,0) ; EMPTY STRING FOR NOT YET PROCESSED "RTN","ORKPS",19,0) ;ORDODSG: FLAG THAT DENOTES IF DOSAGE CHECKS SHOULD BE PERFORMED "RTN","ORKPS",20,0) ; 1 FOR PERFORM DOSAGE CHECKS "RTN","ORKPS",21,0) "RTN","ORKPS",22,0) ; returned info: varies for ^TMP($J x-ref - refer to listings below "RTN","ORKPS",23,0) N OR2CRITN,OR2CRITF,OR2CRITD,OR2SIGN,OR2SIGF,OR2SIGD,OR2DUPN,OR2DUPF,OR2DUPD,O R2DUPCN,OR2DUPCF,OR2DUPCD "RTN","ORKPS",24,0) N ORPHDG,ORKSOIA,ORDOCHKS "RTN","ORKPS",25,0) D PARAMS^ORKCHK6("CRITICAL DRUG INTERACTION",.OR2CRITN,.OR2CRITF,.OR2CRITD) "RTN","ORKPS",26,0) D PARAMS^ORKCHK6("SIGNIFICANT DRUG INTERACTION",.OR2SIGN,.OR2SIGF,.OR2SIGD) "RTN","ORKPS",27,0) D PARAMS^ORKCHK6("DUPLICATE DRUG THERAPY",.OR2DUPCN,.OR2DUPCF,.OR2DUPCD) "RTN","ORKPS",28,0) N ORDFN,ORKA,ORPTY,ORPHOI,OROILI,ORKAI S ORDFN=DFN "RTN","ORKPS",29,0) S ORPHOI=+$P($G(^ORD(101.43,+OI,0)),U,2) "RTN","ORKPS",30,0) S ORPTY=$S($G(ORKDG)="PSI":"I;",$G(ORKDG)="PSIV":"I;",$G(ORKDG)="PSO":"O;",$G( ORKDG)="PSH":"O;",1:"O;") "RTN","ORKPS",31,0) :"") "RTN","ORKPS",32,0) I $G(ORIVTYPE)'="A" D Q:'ORDOCHKS ; Don't do checks if pharmacy does not wan t us to "RTN","ORKPS",33,0) .S ORDOCHKS=$$PRE^PSSDSAPK(ORPHOI,ORPHDG) "RTN","ORKPS",34,0) .S:'ORDODSG ORDODSG=ORDOCHKS "RTN","ORKPS",35,0) S:$G(ORIVTYPE)="A" ORDODSG=1 "RTN","ORKPS",36,0) I +MED,('ORIVRAN) S ORKA(1)=MED_U_$$GETPSNM(+MED),ORKAI=1 "RTN","ORKPS",37,0) ;ADD ALL COMPONENTS OF IV ORDER SO WE ONLY HAVE TO DO A SINGLE PRE CALL "RTN","ORKPS",38,0) I ORKDG="PSIV",('ORIVRAN) D "RTN","ORKPS",39,0) .S ORIVRAN=1,OROILI=0 F S OROILI=$O(OROIL(OROILI)) Q:'OROILI D "RTN","ORKPS",40,0) ..N OR2OI,OR2PSOI,OR2PHDG "RTN","ORKPS",41,0) "RTN","ORKPS",42,0) ..I +OROIL(OROILI)=OI Q "RTN","ORKPS",43,0) ..S OR2OI=+OROIL(OROILI) "RTN","ORKPS",44,0) ..S OR2PSOI=+$P($G(^ORD(101.43,+OR2OI,0)),U,2) "RTN","ORKPS",45,0) ..S OR2PHDG=$P(OROIL(OROILI),U,2) "RTN","ORKPS",46,0) ..S OR2PHDG=$S(OR2PHDG="PSI":"U",OR2PHDG="PSIV":"I",OR2PHDG="PSO":"O",OR2PHDG= "PSH":"N",1:"") "RTN","ORKPS",47,0) ..Q:OR2PHDG'="I" "RTN","ORKPS",48,0) ..I $P($P(OROIL(OROILI),U,3),";")="B",$$PRE^PSSDSAPK(OR2PSOI,OR2PHDG)=0 Q "RTN","ORKPS",49,0) ..I $P($P(OROIL(OROILI),U,3),";")="B",$P($P(OROIL(OROILI),U,3),";",2)="",$G(OR REN)=1 D "RTN","ORKPS",50,0) ...N ORVOLID,ORVOLVAL S ORVOLVAL="",ORVOLID=$O(^OR(100,+$G(ORIFN),4.5,"ID","VO LUME","")) ...I ORVOLID>0 S ORVOLVAL=$G(^OR(100,+$G(ORIFN),4.5,ORVOLID,1)) "RTN","ORKPS",52,0) ...S OROIL(OROILI)=OROIL(OROILI)_ORVOLVAL "RTN","ORKPS",53,0) ..N ORUSID "RTN","ORKPS",54,0) ..S ORUSID=$$USID^ORWDXC(OROIL(OROILI)) "RTN","ORKPS",55,0) ..S ORKAI=ORKAI+1,ORKA(ORKAI)=$P(ORUSID,U,4)_U_$$GETPSNM($P(ORUSID,U,4)) "RTN","ORKPS",56,0) D:$D(ORKA) CPRS^PSODDPR4(ORDFN,"OROCOUT"_ORPTY,.ORKA,ORPTY_+$G(^OR(100,+$G(ORI FN),4))) "RTN","ORKPS",57,0) I +ORSUPPLY D "RTN","ORKPS",58,0) .S ORKSOIA(+ORSUPPLY)=$G(ORIFN) "RTN","ORKPS",59,0) .D CPRS^PSODDPR8(ORDFN,"OROCOUT"_ORPTY,.ORKSOIA,ORPHDG_";"_+$G(^OR(100,+$G(ORN UM),4)),$S($D(ORKA):1,1:"")) "RTN","ORKPS",60,0) I $D(ORKA)!($D(ORKSOIA))!(ORIVRAN) D .S:OR2CRITF_OR2SIGF_OR2DUPCF["E" ^TMP($J,"ORENHCHK")=1 "RTN","ORKPS",62,0) .D PROCESS^ORKPS1(OI,ORDFN,ORKDG,+ORSUPPLY_U_+MED,"OROCOUT"_ORPTY) "RTN","ORKPS",63,0) Q "RTN","ORKPS",64,0) CHKSESS(YY,DFN,MED,OI,ORKPDATA,ORKDG,ORSUPPLY,ORIVTYPE) ; return drug order che cks for session "RTN","ORKPS",65,0) ;ORSUPPLY: pharmacy orderable item ien [file #50.7] if it resolves to one or m ore supply items "RTN","ORKPS",66,0) ; 0 if the pharmacy orderable item does not resolve to any supply ite ms "RTN","ORKPS",67,0) ;ORIVTYPE: the MED type as sent from Infusion Order Dialog "RTN","ORKPS",68,0) ; A for additive "RTN","ORKPS",69,0) ; B for base "RTN","ORKPS",70,0) "RTN","ORKPS",71,0) N ORKFLG,ORSESS,ORPSPKG,ORPSA,ORSNUM,ORNUM,DUPX,DUPORN,ORPTY "RTN","ORKPS",72,0) N ORKSOIA,ORRET,ORDFN,ORPHDG S ORDFN=DFN "RTN","ORKPS",73,0) S ORPTY=$S($G(ORKDG)="PSI":"I;",$G(ORKDG)="PSIV":"I;",$G(ORKDG)="PSO":"O;",$G( ORKDG)="PSH":"O;",1:"O;") "RTN","ORKPS",74,0) S ORPHDG=$S(ORKDG="PSI":"U",ORKDG="PSIV":"I",ORKDG="PSO":"O",ORKDG="PSH":"N",1 :"") "RTN","ORKPS",75,0) I '$D(^TMP($J,"OROCOUT"_ORPTY)) D "RTN","ORKPS",76,0) .S ORKFLG=0 "RTN","ORKPS",77,0) .S ORNUM=$P(ORKA,"|",5) "RTN","ORKPS",78,0) .S ORPHOI=+$P($G(^ORD(101.43,+OI,0)),U,2) "RTN","ORKPS",79,0) .I $G(ORIVTYPE)'="A",'$$PRE^PSSDSAPK(ORPHOI,ORPHDG) Q ; Don't do checks if ph armacy does not want us to .;get unsigned medication orders: "RTN","ORKPS",81,0) .S HOR=0,SEQ=0 "RTN","ORKPS",82,0) .S HOR=$O(^TMP("ORR",$J,HOR)) "RTN","ORKPS",83,0) .I +$G(HOR)>0 D "RTN","ORKPS",84,0) ..F S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1 D "RTN","ORKPS",85,0) ...S ORKORN=+$P(^TMP("ORR",$J,HOR,SEQ),U),DUPORN=0 "RTN","ORKPS",86,0) ...Q:+$G(ORKORN)<1 "RTN","ORKPS",87,0) ...Q:+ORKORN=+ORNUM "RTN","ORKPS",88,0) ...Q:$P(^OR(100,+ORKORN,8,$P(^OR(100,+ORKORN,8,0),U,3),0),U,2)="DC" "RTN","ORKPS",89,0) ...Q:$P(^ORD(100.01,$P(^OR(100,+ORKORN,3),U,3),0),U)="DISCONTINUED" "RTN","ORKPS",90,0) ...S ORKDRUG=$$VALUE^ORCSAVE2(+ORKORN,"DRUG") ;get disp drug for order ...S ORPSPKG=$$DGRX^ORQOR2(+ORKORN) "RTN","ORKPS",92,0) ...S:ORPSPKG="CLINIC INFUSIONS" ORPSPKG="IV MEDICATIONS" ; OR*3*430 "RTN","ORKPS",93,0) ...S ORPSPKG=$S(ORPSPKG="UNIT DOSE MEDICATIONS":"PSI",ORPSPKG="OUTPATIENT MEDI CATIONS":"PSO",ORPSPKG="IV MEDICATIONS":"PSIV",ORPSPKG="NON-VA MEDICATIONS":"PS H",1:"") "RTN","ORKPS",94,0) ...S DUPX="" F S DUPX=$O(ORKDRUGA(DUPX)) Q:'DUPX!(DUPORN=1) D "RTN","ORKPS",95,0) ....S:ORKORN=ORKDRUGA(DUPX) DUPORN=1 "RTN","ORKPS",96,0) ...Q:DUPORN=1 ;quit if already processed drug order "RTN","ORKPS",97,0) ...I +$G(ORKDRUG)<1,$L(ORPSPKG)>0 D "RTN","ORKPS",98,0) ....N OROI S OROI=$$OI^ORX8(+ORKORN) "RTN","ORKPS",99,0) ....S ORRET=$$OI2DD(+OROI,$S($G(ORKDG)="PSI":"I",$G(ORKDG)="PSIV":"I",$G(ORKDG )="PSO":"O",$G(ORKDG)="PSH":"O",1:"O"),1) "RTN","ORKPS",100,0) "RTN","ORKPS",101,0) ....I +ORRET S ORKDRUG=+ORRET "RTN","ORKPS",102,0) ...;only process vs. unsigned med order if disp drug is assoc w/order: "RTN","ORKPS",103,0) ...Q:+$G(ORKDRUG)<1 "RTN","ORKPS",104,0) ...I ORPSPKG="PSIV" D "RTN","ORKPS",105,0) ....;loop through each OI in the IV order "RTN","ORKPS",106,0) ....N OR2I "RTN","ORKPS",107,0) ....S OR2I=0 F S OR2I=$O(^OR(100,+ORKORN,4.5,"ID","ORDERABLE",OR2I)) Q:'OR2I D "RTN","ORKPS",108,0) .....N OR2OI,OR2DRUG "RTN","ORKPS",109,0) .....S OR2OI=$G(^OR(100,+ORKORN,4.5,OR2I,1)) "RTN","ORKPS",110,0) .....Q:'OR2OI .....;get the drug for each OI "RTN","ORKPS",112,0) .....S OR2DRUG=$$OI2DD(+OR2OI,"I",1) "RTN","ORKPS",113,0) .....;check if drug should be add it and add it if so "RTN","ORKPS",114,0) .....I $$IVADD(OR2DRUG,OR2OI) S ORKDRUGA(+OR2DRUG_";"_ORPSPKG_";"_ORKORN)=ORKO RN_U_$$GETPSNM(+OR2DRUG) "RTN","ORKPS",115,0) ...I ORPSPKG'="PSIV" S ORKDRUGA(+ORKDRUG_";"_ORPSPKG_";"_ORKORN)=ORKORN_U_$$GE TPSNM(+ORKDRUG) "RTN","ORKPS",116,0) ...; OR*3*469 - Load all components (solution and additive) of IV for order ch ecking "RTN","ORKPS",117,0) ... I ORPSPKG="PSIV" D "RTN","ORKPS",118,0) .... N ORX,ORRET S ORX=0 F S ORX=+$O(^OR(100,ORKORN,4.5,"ID","ORDERABLE",ORX) ) Q:'ORX D "RTN","ORKPS",119,0) ..... S ORRET=$$OI2DD(+$G(^OR(100,ORKORN,4.5,ORX,1)),"I",1) Q:'ORRET ..... I +$P(ORRET,";",4) S ORKSOIA(+$P(ORRET,";",4))=ORKORN "RTN","ORKPS",121,0) ..... I '$D(ORKDRUGA(+ORRET_";PSIV;"_ORKORN)) S ORKDRUGA(+ORRET_";PSIV;"_ORKOR N)=ORKORN_U_$$GETPSNM(+ORRET) "RTN","ORKPS",122,0) .... Q ; end of OR*3*469 change "RTN","ORKPS",123,0) .N ORPROSP,CNT "RTN","ORKPS",124,0) .S CNT=1 "RTN","ORKPS",125,0) .S:+MED ORPROSP(CNT)=MED_U_$$GETPSNM(+MED)_U_+$G(ORNUM),CNT=CNT+1 "RTN","ORKPS",126,0) .N I S I="" F S I=$O(ORKDRUGA(I)) Q:'I S ORPROSP(CNT)=+I_U_$P(ORKDRUGA(I),U, 2)_U_U_$P(ORKDRUGA(I),U,1),CNT=CNT+1 "RTN","ORKPS",127,0) .D SHRNKPR "RTN","ORKPS",128,0) .D CPRS^PSODDPR4(DFN,"OROCOUT"_ORPTY,.ORPROSP,ORPTY_+$G(^OR(100,+$G(ORNUM),4)) ) "RTN","ORKPS",129,0) "RTN","ORKPS",130,0) ..S ORKSOIA(+ORSUPPLY)=$G(ORNUM) "RTN","ORKPS",131,0) ..D:$D(ORKSOIA)>9 CPRS^PSODDPR8(DFN,"OROCOUT"_ORPTY,.ORKSOIA,ORPHDG_";"_+$G(^O R(100,+$G(ORNUM),4)),1) "RTN","ORKPS",132,0) D PROCESS^ORKPS1(OI,ORDFN,ORKDG,+ORSUPPLY_U_+MED,"OROCOUT"_ORPTY) "RTN","ORKPS",133,0) Q "RTN","ORKPS",134,0) IVADD(ORDRUG,OROI) ;RETURN YES OR NO IF SHOULD ADD THE IV ITEM "RTN","ORKPS",135,0) N ORRET "RTN","ORKPS",136,0) ;default is yes to add it, will always be 1 for an additive "RTN","ORKPS",137,0) S ORRET=1 "RTN","ORKPS",138,0) ;check if drug is a base "RTN","ORKPS",139,0) K ^TMP($J,"ORBASECHECK") D DRGIEN^PSS52P7(ORDRUG,,"ORBASECHECK") "RTN","ORKPS",141,0) I $P($G(^TMP($J,"ORBASECHECK",0),0),U)>0 D ;GOT A BASE HERE "RTN","ORKPS",142,0) .;if drug is a base, check if pharmacy says we can add it or not "RTN","ORKPS",143,0) .N ORPHOI "RTN","ORKPS",144,0) .S ORPHOI=+$P($G(^ORD(101.43,+OROI,0)),U,2) "RTN","ORKPS",145,0) .S ORRET=$$PRE^PSSDSAPK(ORPHOI,"I") "RTN","ORKPS",146,0) K ^TMP($J,"ORBASECHECK") "RTN","ORKPS",147,0) Q ORRET "RTN","ORKPS",148,0) SHRNKPR ;REMOVE DUPLICATS FROM PROSPECTIVE LIST "RTN","ORKPS",149,0) Q:'$D(ORPROSP) "RTN","ORKPS",150,0) N ORX,ORI S ORI=0 F S ORI=$O(ORPROSP(ORI)) Q:'ORI S ORX=ORPROSP(ORI) D .N ORJ S ORJ=ORI F S ORJ=$O(ORPROSP(ORJ)) Q:'ORJ I ORX=ORPROSP(ORJ) K ORPROS P(ORJ) "RTN","ORKPS",152,0) Q "RTN","ORKPS",153,0) GETPSNM(ORIEN) ;GET THE FILE 50 .01 FIELD FROM A FILE 50 IEN "RTN","ORKPS",154,0) N RET K ^TMP($J,"ORRETNM") "RTN","ORKPS",155,0) D NDF^PSS50(ORIEN,,,,,"ORRETNM") S RET=$G(^TMP($J,"ORRETNM",ORIEN,.01)) "RTN","ORKPS",156,0) K ^TMP($J,"ORRETNM") "RTN","ORKPS",157,0) Q RET "RTN","ORKPS",158,0) TAKEMED(ORKDFN,ORKMED) ;extrinsic function returns med orderable item if any "RTN","ORKPS",159,0) ;active med patient is taking contains any piece of ORKMED "RTN","ORKPS",160,0) ;ORKDFN patient DFN "RTN","ORKPS",161,0) "RTN","ORKPS",162,0) Q:'$L($G(ORKDFN)) "0^Patient not identified." "RTN","ORKPS",163,0) Q:'$L($G(ORKMED)) "0^Medication not identified." "RTN","ORKPS",164,0) N ORKARX,ORKY,ORI,ORJ,ORCNT,ORKMEDP,ORKRSLT "RTN","ORKPS",165,0) D LIST^ORQQPS(.ORKY,ORKDFN,"","") "RTN","ORKPS",166,0) Q:$P(ORKY(1),U)="" "0^No active meds found." "RTN","ORKPS",167,0) S ORKRSLT="0^No matching meds found." "RTN","ORKPS",168,0) S ORCNT=$L(ORKMED,U) "RTN","ORKPS",169,0) S ORI=0 F S ORI=$O(ORKY(ORI)) Q:ORI<1 D "RTN","ORKPS",170,0) .S ORKARX=$P(ORKY(ORI),U,2) "RTN","ORKPS",171,0) .F ORJ=1:1:ORCNT S ORKMEDP=$P(ORKMED,U,ORJ) D "RTN","ORKPS",172,0) 16 use uppercase in comparison "RTN","ORKPS",173,0) Q ORKRSLT "RTN","ORKPS",174,0) POLYRX(DFN) ;extrins funct rtns 1 if patient exceeds polypharmacy, 0 if not "RTN","ORKPS",175,0) N ORSLT,ORENT,ORLOC,ORPAR,ORMEDS "RTN","ORKPS",176,0) S ORSLT=0 "RTN","ORKPS",177,0) Q:'$L(DFN) ORSLT "RTN","ORKPS",178,0) S VA200="" D OERR^VADPT "RTN","ORKPS",179,0) S ORLOC=+$G(^DIC(42,+VAIN(4),44)) "RTN","ORKPS",180,0) K VA200,VAIN "RTN","ORKPS",181,0) S ORENT=+$G(ORLOC)_";SC(^DIV^SYS^PKG" "RTN","ORKPS",182,0) S ORPAR=$$GET^XPAR(ORENT,"ORK POLYPHARMACY",1,"I") S ORMEDS=$$NUMRX(DFN) "RTN","ORKPS",184,0) I $G(ORMEDS)>$G(ORPAR) S ORSLT=1 "RTN","ORKPS",185,0) Q ORSLT "RTN","ORKPS",186,0) GLCREAT(DFN) ;extrinsic function returns patient's (DFN) most recent serum "RTN","ORKPS",187,0) ; creatinine within # of days from parameter ORK GLUCOPHAGE CREATININE "RTN","ORKPS",188,0) ; results format: test id^result units flag ref range collect d/t^result "RTN","ORKPS",189,0) ; used by order check GLUCOPHAGE-LAB RESULTS "RTN","ORKPS",190,0) N ORLOC,ORPAR,ORDAYS "RTN","ORKPS",191,0) N BDT,CDT,ORY,ORX,ORZ,TEST,ORI,ORJ,CREARSLT,LABFILE,SPECFILE,SPECIMEN,VAIN,VAD M,RSLTS "RTN","ORKPS",192,0) Q:'$L(DFN) "0^" "RTN","ORKPS",193,0) "RTN","ORKPS",194,0) Q:'$L(ORDAYS) "0^" "RTN","ORKPS",195,0) D NOW^%DTC "RTN","ORKPS",196,0) S BDT=$$FMADD^XLFDT(%,"-"_ORDAYS,"","","") "RTN","ORKPS",197,0) K % "RTN","ORKPS",198,0) Q:'$L($G(BDT)) "0^" "RTN","ORKPS",199,0) S LABFILE=$$TERMLKUP^ORB31(.ORY,"SERUM CREATININE") "RTN","ORKPS",200,0) Q:'$D(ORY) "0^" ;no link between SERUM CREATININE and local lab test "RTN","ORKPS",201,0) Q:$G(LABFILE)'=60 "0^" "RTN","ORKPS",202,0) S SPECFILE=$$TERMLKUP^ORB31(.ORX,"SERUM SPECIMEN") "RTN","ORKPS",203,0) Q:'$D(ORX) "0^" ;no link between SERUM SPECIMEN and local specimen "RTN","ORKPS",204,0) "RTN","ORKPS",205,0) F ORI=1:1:ORY D "RTN","ORKPS",206,0) .S TEST=$P(ORY(ORI),U) "RTN","ORKPS",207,0) .Q:+$G(TEST)<1 "RTN","ORKPS",208,0) .F ORJ=1:1:ORX D "RTN","ORKPS",209,0) ..S SPECIMEN=$P(ORX(ORJ),U) "RTN","ORKPS",210,0) ..Q:+$G(SPECIMEN)<1 "RTN","ORKPS",211,0) ..S ORZ=$$LOCL^ORQQLR1(DFN,TEST,SPECIMEN) "RTN","ORKPS",212,0) ..Q:'$L($G(ORZ)) "RTN","ORKPS",213,0) ..S CDT=$P(ORZ,U,7) "RTN","ORKPS",214,0) ..I CDT'0:"I",1:"O") "RTN","ORKPS",247,0) K ^TMP("PS",$J) D OCL^PSOORRL(DFN,"","") ;if no date range, returns active meds for pt "RTN","ORKPS",249,0) N X "RTN","ORKPS",250,0) S X=0 "RTN","ORKPS",251,0) F S X=$O(^TMP("PS",$J,X)) Q:X<1 D "RTN","ORKPS",252,0) .S ORX=$G(^TMP("PS",$J,X,0)) "RTN","ORKPS",253,0) .S ORY=$P(ORX,U) "RTN","ORKPS",254,0) .S ORNUM=$P(ORX,U,8) ;order entry order number "RTN","ORKPS",255,0) .S ORS=$P(ORX,U,9) ;medication status from pharmacy "RTN","ORKPS",256,0) .S ORPRENEW=$P(ORX,U,14) ;pending renewal flag (1: pending renewal) "RTN","ORKPS",257,0) .Q:+ORX<1 "RTN","ORKPS",258,0) .Q:$P(ORY,";",2)'=ORPTYPE ;quit if med is not pt type (inpt/outpt) .;quit if status is a non-active type: "RTN","ORKPS",260,0) .Q:$G(ORS)="EXPIRED" "RTN","ORKPS",261,0) .Q:$G(ORS)["DISCONTINUE" "RTN","ORKPS",262,0) .Q:$G(ORS)="DELETED" "RTN","ORKPS",263,0) .Q:+$G(ORPRENEW)>0 "RTN","ORKPS",264,0) .Q:$$SUPPLY($$OI^ORQOR2(ORNUM))=1 ;quit if a supply "RTN","ORKPS",265,0) .S NUMRX=NUMRX+1 "RTN","ORKPS",266,0) K ^TMP("PS",$J) "RTN","ORKPS",267,0) Q NUMRX "RTN","ORKPS",268,0) OI2DD(OROI,ORPSPKG,ORCHKTYP) ;rtn dispense drugs for a PS OI "RTN","ORKPS",269,0) ;ORCHKTYP: TYPE OF ORDER CHECK SYSTEM IS PERFORMING ; 1 FOR ENHANCED ORDER CHECKS "RTN","ORKPS",271,0) ; 2 FOR DOSAGE ORDER CHECK "RTN","ORKPS",272,0) N PSOI,ORRET "RTN","ORKPS",273,0) Q:'$D(^ORD(101.43,OROI,0)) "" "RTN","ORKPS",274,0) S PSOI=+$P(^ORD(101.43,OROI,0),U,2) "RTN","ORKPS",275,0) Q:PSOI<1 "" "RTN","ORKPS",276,0) S:ORPSPKG="H" ORPSPKG="X" ;if non-va med need to pass api "X" "RTN","ORKPS",277,0) S ORRET=$$DRG^PSSDSAPM(PSOI,ORPSPKG,ORCHKTYP) "RTN","ORKPS",278,0) I ORCHKTYP=1,(+$P(ORRET,";",4)) S $P(ORRET,";",4)=PSOI "RTN","ORKPS",279,0) Q ORRET "RTN","ORMGMRC") 0^1^B47176451 ORMGMRC ; SLC/MKB - Process Consult ORM msgs ;Sep 10, 2020@14:17:35 "RTN","ORMGMRC",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,26,68,92,153,174,195,255,243,280,350,4 15,519**;Dec 17, 1997;Build 0 "RTN","ORMGMRC",3,0) EN ; -- entry point for GMRC messges "RTN","ORMGMRC",4,0) I '$L($T(@ORDCNTRL)) Q ;S ORERR="Invalid order control code" Q "RTN","ORMGMRC",5,0) I ORDCNTRL'="SN",ORDCNTRL'="ZP",'ORIFN!('$D(^OR(100,+ORIFN,0))) S ORERR="Inval id OE/RR order number" Q "RTN","ORMGMRC",6,0) S:ORDCNTRL="OC"&(ORTYPE="ORR") ORDCNTRL="UA" ;new code "RTN","ORMGMRC",7,0) N ORSTS,OREASON1,NTE S ORSTS=$$STATUS(ORDSTS) "RTN","ORMGMRC",8,0) S:'ORLOG ORLOG=$$NOW^XLFDT S:'ORDUZ ORDUZ=DUZ S:$G(DGPMT) ORDUZ="" "RTN","ORMGMRC",9,0) S OREASON=$P(OREASON,U,5),NTE=$O(@ORMSG@(+ORC)),OREASON1="" "RTN","ORMGMRC",10,0) I NTE,$E(@ORMSG@(NTE),1,3)="NTE" S OREASON1=$P(@ORMSG@(NTE),"|",4) D @ORDCNTRL "RTN","ORMGMRC",12,0) Q "RTN","ORMGMRC",13,0) ; "RTN","ORMGMRC",14,0) ZP ; -- Purged "RTN","ORMGMRC",15,0) Q:'ORIFN Q:'$D(^OR(100,+ORIFN,0)) "RTN","ORMGMRC",16,0) K ^OR(100,+ORIFN,4) I "^3^5^6^8^"[(U_$P($G(^(3)),U,3)_U) D STATUS^ORCSAVE2(+OR IFN,14) ; Remove pkg reference, sts=lapsed if still active "RTN","ORMGMRC",17,0) Q "RTN","ORMGMRC",18,0) ; "RTN","ORMGMRC",19,0) ZR ; -- Purged as requested [ack] "RTN","ORMGMRC",20,0) D DELETE^ORCSAVE2(+ORIFN) "RTN","ORMGMRC",21,0) "RTN","ORMGMRC",22,0) ; "RTN","ORMGMRC",23,0) ZU ; -- Unable to purge [ack] "RTN","ORMGMRC",24,0) S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity "RTN","ORMGMRC",25,0) Q "RTN","ORMGMRC",26,0) ; "RTN","ORMGMRC",27,0) OK ; -- Order accepted, GMRC order # assigned [ack] "RTN","ORMGMRC",28,0) S ^OR(100,+ORIFN,4)=PKGIFN S:'$G(ORSTS) ORSTS=5 "RTN","ORMGMRC",29,0) D STATUS^ORCSAVE2(+ORIFN,ORSTS) ; 5=pending "RTN","ORMGMRC",30,0) D DATES^ORCSAVE2(+ORIFN,+$E($$NOW^XLFDT,1,12)) "RTN","ORMGMRC",31,0) Q "RTN","ORMGMRC",32,0) "RTN","ORMGMRC",33,0) XX ; -- Change order "RTN","ORMGMRC",34,0) N ORDIALOG,ORDG,ORDA,ORX,ORP,ORSIG S:'$L(ORNATR) ORNATR="S" "RTN","ORMGMRC",35,0) D DLG Q:$D(ORERR) Q:'$D(ORDIALOG) S ORIFN=+ORIFN "RTN","ORMGMRC",36,0) S ORDA=$$ACTION^ORCSAVE("XX",ORIFN,ORNP,OREASON1,ORLOG,ORDUZ) "RTN","ORMGMRC",37,0) I ORDA'>0 S ORERR="Cannot create new order action" Q "RTN","ORMGMRC",38,0) ; -Update sts of order to active, last action to dc/edit: "RTN","ORMGMRC",39,0) S ORX=+$P($G(^OR(100,ORIFN,3)),U,7) S:ORX'>0 ORX=+$O(^(8,ORDA),-1) "RTN","ORMGMRC",40,0) I $D(^OR(100,ORIFN,8,ORX,0)),$P(^(0),U,15)="" S $P(^(0),U,15)=12 "RTN","ORMGMRC",41,0) S $P(^OR(100,ORIFN,3),U,7)=ORDA D:$G(ORSTS) STATUS^ORCSAVE2(ORIFN,ORSTS) "RTN","ORMGMRC",42,0) D PXRMKILL^ORDD100(ORIFN,ORVP,ORLOG) ; JEH 255 "RTN","ORMGMRC",43,0) "RTN","ORMGMRC",44,0) ; -If unsigned edit, leave XX unsigned & mark ORX as Sig Not Req'd "RTN","ORMGMRC",45,0) S ORSIG=$S($P($G(^OR(100,ORIFN,8,ORX,0)),U,4)'=2:1,1:0) "RTN","ORMGMRC",46,0) D SIGSTS^ORCSAVE2(ORIFN,ORDA):ORSIG,SIGN^ORCSAVE2(ORIFN,,,5,ORX):'ORSIG "RTN","ORMGMRC",47,0) ; -Update responses, get/save new order text: "RTN","ORMGMRC",48,0) K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ORDA) "RTN","ORMGMRC",49,0) S $P(^OR(100,ORIFN,8,ORDA,0),U,14)=ORDA "RTN","ORMGMRC",50,0) K:OREASON="RESUBMIT" ^OR(100,ORIFN,6) ;clear previous DC data "RTN","ORMGMRC",51,0) I OREASON="RESUBMIT" N DA S DA=+ORIFN D EK^ORDD100A S $P(^OR(100,ORIFN,0),U,9) ="" ;p415 clear stop date/time including xref "AE" "RTN","ORMGMRC",52,0) D PXRMADD^ORDD100(ORIFN,ORVP,ORLOG) ; JEH 255 "RTN","ORMGMRC",53,0) I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL) Q "RTN","ORMGMRC",55,0) ; "RTN","ORMGMRC",56,0) SN ; -- New backdoor order: return NA msg w/ORIFN, or DE msg "RTN","ORMGMRC",57,0) N ORDIALOG,ORDG,ORP K ^TMP("ORWORD",$J) S:'$L(ORNATR) ORNATR="W" "RTN","ORMGMRC",58,0) I '$D(^VA(200,ORNP,0)) S ORERR="Missing or invalid ordering provider" Q "RTN","ORMGMRC",59,0) I ORDUZ,'$D(^VA(200,ORDUZ,0)) S ORERR="Invalid entering person" Q "RTN","ORMGMRC",60,0) I '$G(ORL) S ORERR="Missing or invalid patient location" Q "RTN","ORMGMRC",61,0) D DLG Q:$D(ORERR) Q:'$D(ORDIALOG) "RTN","ORMGMRC",62,0) SN1 D EN^ORCSAVE K ^TMP("ORWORD",$J) ; setting status, xrefs "RTN","ORMGMRC",63,0) I '$G(ORIFN) S ORERR="Cannot create new order" Q "RTN","ORMGMRC",64,0) ;Save DG1 and ZCL segments of HL7 message from backdoor orders D BDOSTR^ORWDBA3 "RTN","ORMGMRC",66,0) D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR),SIGSTS^ORCSAVE2(ORIFN,1) "RTN","ORMGMRC",67,0) S:'ORSTRT ORSTRT=$$NOW^XLFDT D DATES^ORCSAVE2(+ORIFN,ORSTRT) "RTN","ORMGMRC",68,0) D:$G(ORSTS) STATUS^ORCSAVE2(ORIFN,ORSTS) "RTN","ORMGMRC",69,0) I $G(ORL) S ORP(1)=ORIFN_";1^1" D PRINTS^ORWD1(.ORP,+ORL) ; chart copy "RTN","ORMGMRC",70,0) S ^OR(100,ORIFN,4)=PKGIFN "RTN","ORMGMRC",71,0) Q "RTN","ORMGMRC",72,0) ; "RTN","ORMGMRC",73,0) DLG ; -- Build ORDIALOG(),ORDG from msg "RTN","ORMGMRC",74,0) N OBR,USID,TYPE,OI,ZSV,J,OBX,WP,I,DSTID "RTN","ORMGMRC",75,0) S OBR=$$OBR I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="Missing OBR segm "RTN","ORMGMRC",76,0) S USID=$P(@ORMSG@(OBR),"|",5),TYPE=$S(USID["99CON":"CONSULT",1:"REQUEST") "RTN","ORMGMRC",77,0) S ORDIALOG=$O(^ORD(101.41,"AB","GMRCOR "_TYPE,0)) "RTN","ORMGMRC",78,0) D GETDLG1^ORCD(ORDIALOG) "RTN","ORMGMRC",79,0) S ORDIALOG($$PTR("URGENCY"),1)=ORURG "RTN","ORMGMRC",80,0) ;ORSTRT & ORSTOP defined in routine ORM "RTN","ORMGMRC",81,0) S ORDIALOG($$PTR("CLINICALLY INDICATED DATE"),1)=ORSTRT ;WAT/280/350 "RTN","ORMGMRC",82,0) S OI=$$ORDITEM^ORM(USID) I 'OI S ORERR="Invalid consult or procedure" Q "RTN","ORMGMRC",83,0) S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI "RTN","ORMGMRC",84,0) S ZSV=$O(@ORMSG@(OBR)) I ZSV,$E(@ORMSG@(ZSV),1,3)="ZSV" D "RTN","ORMGMRC",85,0) . N X1,X2 S X1=$P(@ORMSG@(ZSV),"|",2),X2=$P(@ORMSG@(ZSV),"|",3) "RTN","ORMGMRC",86,0) "RTN","ORMGMRC",87,0) . I TYPE="CONSULT",$L(X2) S ORDIALOG($$PTR("FREE TEXT OI"),1)=X2 "RTN","ORMGMRC",88,0) . S DSTID=$P(@ORMSG@(ZSV),"|",4) S:$L(DSTID) ORDIALOG($$PTR("DST ID"),1)=DSTID "RTN","ORMGMRC",89,0) D1 S ORDIALOG($$PTR("CATEGORY"),1)=$G(ORCAT) "RTN","ORMGMRC",90,0) S J=$P(@ORMSG@(OBR),"|",19),ORDIALOG($$PTR("PLACE OF CONSULTATION"),1)=$S(J="O C":"C",1:J) "RTN","ORMGMRC",91,0) S ORDIALOG($$PTR("PROVIDER"),1)=$P(@ORMSG@(OBR),"|",20) "RTN","ORMGMRC",92,0) S OBX=OBR F S OBX=$O(@ORMSG@(OBX)) Q:OBX'>0 S J=$E(@ORMSG@(OBX),1,3) Q:J="OR C" Q:J="MSH" I J="OBX" D "RTN","ORMGMRC",93,0) . N SEG,NAME,VALUE S SEG=@ORMSG@(OBX) "RTN","ORMGMRC",94,0) . S NAME=$$UP^XLFSTR($P($P(SEG,"|",4),U,2)),VALUE=$P(SEG,"|",6) "RTN","ORMGMRC",95,0) . I NAME="PROVISIONAL DIAGNOSIS" D Q "RTN","ORMGMRC",96,0) ,2) "RTN","ORMGMRC",97,0) .. S ORDIALOG($$PTR("FREE TEXT"),1)=VALUE "RTN","ORMGMRC",98,0) . S WP=$$PTR("WORD PROCESSING 1"),I=1,^TMP("ORWORD",$J,WP,1,I,0)=VALUE "RTN","ORMGMRC",99,0) . S J=0 F S J=$O(@ORMSG@(OBX,J)) Q:J'>0 S I=I+1,^TMP("ORWORD",$J,WP,1,I,0)=@ ORMSG@(OBX,J) "RTN","ORMGMRC",100,0) S:$G(I) ^TMP("ORWORD",$J,WP,1,0)="^^"_I_U_I_U_DT_U,ORDIALOG(WP,1)="^TMP(""ORWO RD"",$J,"_WP_",1)" "RTN","ORMGMRC",101,0) Q "RTN","ORMGMRC",102,0) ; "RTN","ORMGMRC",103,0) OBR() ; -- Return subscript of RXE segment "RTN","ORMGMRC",104,0) N X,I,SEG S X="",I=+ORC "RTN","ORMGMRC",105,0) F S I=$O(@ORMSG@(I)) Q:I'>0 S SEG=$E(@ORMSG@(I),1,3) Q:SEG="ORC" I SEG="OBR "RTN","ORMGMRC",106,0) Q X "RTN","ORMGMRC",107,0) ; "RTN","ORMGMRC",108,0) SC ; -- Status changed (i.e. scheduled) "RTN","ORMGMRC",109,0) S:'$G(ORSTS) ORSTS=6 D STATUS^ORCSAVE2(+ORIFN,ORSTS) ; 6=active "RTN","ORMGMRC",110,0) Q "RTN","ORMGMRC",111,0) ; "RTN","ORMGMRC",112,0) STATUS(X) ; -- Returns ptr to Order Status file #100.01 "RTN","ORMGMRC",113,0) Q $S(X="DC":1,X="CM":2,X="HD":3,X="IP":5,X="SC":6,X="A":9,X="RP":12,X="CA":13, X="ZC":8,1:5) "RTN","ORMGMRC",114,0) ; "RTN","ORMGMRC",115,0) RE ; -- Completed, w/results N I,SEG,DA,DR,DIE,X,Y "RTN","ORMGMRC",117,0) S:'$G(ORSTS) ORSTS=2 D STATUS^ORCSAVE2(+ORIFN,ORSTS) "RTN","ORMGMRC",118,0) S X="",DA=+ORIFN,DIE="^OR(100," "RTN","ORMGMRC",119,0) S DR="71////"_+$E($$NOW^XLFDT,1,12) D ^DIE "RTN","ORMGMRC",120,0) S I=+ORC,X="" F S I=$O(@ORMSG@(I)) Q:I<1 S SEG=$G(@ORMSG@(I)) Q:$E(SEG,1,3)= "ORC" I $E(SEG,1,3)="OBX",$P(SEG,"|",4)["SIG FINDINGS" S X=$P(SEG,"|",6) Q "RTN","ORMGMRC",121,0) S $P(^OR(100,DA,7),U,2)=$S(X="Y":1,1:"") "RTN","ORMGMRC",122,0) S:'$G(ORNP) ORNP=+$P($G(^OR(100,+ORIFN,0)),U,4) "RTN","ORMGMRC",123,0) I $P(ORC,"|",17)["MAINTENANCE" Q ;group update - no CM ack needed "RTN","ORMGMRC",124,0) I $L($T(ADD^ORRCACK)) D ADD^ORRCACK(+ORIFN,ORNP) ;Ack stub for prov "RTN","ORMGMRC",125,0) Q "RTN","ORMGMRC",126,0) "RTN","ORMGMRC",127,0) UA ; -- Unable to Accept [ack] "RTN","ORMGMRC",128,0) S ORDUZ="" I '$L(OREASON1),$L(OREASON) S OREASON1=OREASON "RTN","ORMGMRC",129,0) OC ; -- Cancelled/Denied "RTN","ORMGMRC",130,0) S:'$L(ORNATR) ORNATR="X" ;Rejected "RTN","ORMGMRC",131,0) S ^OR(100,+ORIFN,6)=$O(^ORD(100.02,"C",ORNATR,0))_U_ORDUZ_U_ORLOG_U_U_OREASON1 "RTN","ORMGMRC",132,0) D STATUS^ORCSAVE2(+ORIFN,13) I ORDCNTRL="OC" D UPDATE("DC") Q "RTN","ORMGMRC",133,0) UD ; -- Unable to discontinue [ack] "RTN","ORMGMRC",134,0) N DA S DA=$P(ORIFN,";",2) I DA D "RTN","ORMGMRC",135,0) . S $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ;request rejected "RTN","ORMGMRC",136,0) . S:$L(OREASON1) ^OR(100,+ORIFN,8,DA,1)=OREASON1 "RTN","ORMGMRC",137,0) "RTN","ORMGMRC",138,0) ; "RTN","ORMGMRC",139,0) OD ; -- Discontinued "RTN","ORMGMRC",140,0) S ^OR(100,+ORIFN,6)=$S($L(ORNATR):$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_ U_ORLOG_U_U_OREASON1 "RTN","ORMGMRC",141,0) D STATUS^ORCSAVE2(+ORIFN,1),UPDATE("DC"):$L(ORNATR) "RTN","ORMGMRC",142,0) Q "RTN","ORMGMRC",143,0) ; "RTN","ORMGMRC",144,0) DR ; -- Discontinued [ack] "RTN","ORMGMRC",145,0) D STATUS^ORCSAVE2(+ORIFN,1) "RTN","ORMGMRC",146,0) Q "RTN","ORMGMRC",147,0) ; UPDATE(ORACT) ; -- continue processing "RTN","ORMGMRC",149,0) N ORX,ORDA,ORP "RTN","ORMGMRC",150,0) S ORX=$$CREATE^ORX1(ORNATR) D:ORX "RTN","ORMGMRC",151,0) . S ORDA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,OREASON1,ORLOG,ORDUZ) "RTN","ORMGMRC",152,0) . I ORDA'>0 S ORERR="Cannot create new order action" Q "RTN","ORMGMRC",153,0) . D RELEASE^ORCSAVE2(+ORIFN,ORDA,ORLOG,ORDUZ,ORNATR) "RTN","ORMGMRC",154,0) . D SIGSTS^ORCSAVE2(+ORIFN,ORDA) "RTN","ORMGMRC",155,0) . I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL) "RTN","ORMGMRC",156,0) . S $P(^OR(100,+ORIFN,3),U,7)=ORDA "RTN","ORMGMRC",157,0) I 'ORX,ORACT="DC",'$$ACTV^ORX1(ORNATR) S $P(^OR(100,+ORIFN,3),U,7)=0 "RTN","ORMGMRC",158,0) D:$G(ORACT)="DC" CANCEL^ORCSEND(+ORIFN) Q "RTN","ORMGMRC",160,0) ; "RTN","ORMGMRC",161,0) PTR(X) ; -- Returns ptr to prompt in Order Dialog file #101.41 "RTN","ORMGMRC",162,0) Q $O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0)) "RTN","ORMLR") 0^2^B55099277 "RTN","ORMLR",1,0) ORMLR ; SLC/MKB - Process Lab ORM msgs ;11:59 AM 26 Jul 2000 "RTN","ORMLR",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,92,153,174,195,243,315**;Dec 17, 1997; Build 0 "RTN","ORMLR",3,0) EN ; -- entry point for LR messages "RTN","ORMLR",4,0) I '$L($T(@ORDCNTRL)) Q ;S ORERR="Invalid order control code" Q "RTN","ORMLR",5,0) I ORDCNTRL'="SN",ORDCNTRL'="ZC",ORDCNTRL'="ZP" D Q:$L($G(ORERR)) "RTN","ORMLR",6,0) "RTN","ORMLR",7,0) . S ORDUZ=DUZ,ORLOG=+$E($$NOW^XLFDT,1,12) "RTN","ORMLR",8,0) S OREASON=$$REASON I 'ORNATR,OREASON S ORNATR=+$P($G(^ORD(100.03,+OREASON,0)), U,7) "RTN","ORMLR",9,0) D @ORDCNTRL "RTN","ORMLR",10,0) Q "RTN","ORMLR",11,0) ; "RTN","ORMLR",12,0) STATUS(X) ; -- Returns Order Status for HL7 code X "RTN","ORMLR",13,0) N Y S Y=$S(X="DC":1,X="CM":2,X="IP":5,X="SC":6,X="ZS":9,X="CA":13,1:"") "RTN","ORMLR",14,0) Q Y "RTN","ORMLR",15,0) ; "RTN","ORMLR",16,0) OK ; -- Order accepted, LR order # assigned [ack] S ^OR(100,+ORIFN,4)=PKGIFN ; LR identifier "RTN","ORMLR",18,0) D STATUS^ORCSAVE2(+ORIFN,5) ; pending "RTN","ORMLR",19,0) Q "RTN","ORMLR",20,0) ; "RTN","ORMLR",21,0) ZC ; -- Convert existing 2.5 orders to 3.0 format "RTN","ORMLR",22,0) S ORNATR="" I 'ORIFN!('$D(^OR(100,+ORIFN,0))) D Q ;create "RTN","ORMLR",23,0) . K ORIFN D SN Q:'$G(ORIFN) S ORDCNTRL="SN" "RTN","ORMLR",24,0) . I ORSTOP,ORSTOP<$$NOW^XLFDT S $P(^OR(100,+ORIFN,3),U)=ORSTOP "RTN","ORMLR",25,0) N ORDIALOG,I,X,OBR,NTE S ORIFN=+ORIFN "RTN","ORMLR",26,0) S I=+ORC F S I=$O(@ORMSG@(I)) Q:'I S SEG=$E(@ORMSG@(I),1,3) Q:SEG="ORC" Q:S EG="MSH" I SEG="OBR" S OBR=I Q "RTN","ORMLR",27,0) "RTN","ORMLR",28,0) S ORDIALOG=+$O(^ORD(101.41,"AB","LR OTHER LAB TESTS",0)) "RTN","ORMLR",29,0) D GETDLG1^ORCD(ORDIALOG) "RTN","ORMLR",30,0) S X=$$FIND^ORM(OBR,5),X=$$ORDITEM^ORM(X) I 'X S ORERR="Invalid test" Q "RTN","ORMLR",31,0) S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=X,X=$$FIND^ORM(OBR,16) "RTN","ORMLR",32,0) S ORDIALOG($$PTR("COLLECTION SAMPLE"),1)=$P(X,";",4) "RTN","ORMLR",33,0) S ORDIALOG($$PTR("SPECIMEN"),1)=$S($L($P(X,";")):+$O(^LAB(61,"C",$P(X,";"),0)) ,1:+$P(X,U,4)) "RTN","ORMLR",34,0) S X=$$FIND^ORM(OBR,28),ORDIALOG($$PTR("LAB URGENCY"),1)=+$P($P(X,U,6),";",2) "RTN","ORMLR",35,0) S X=$$FIND^ORM(OBR,12),ORDIALOG($$PTR("COLLECTION TYPE"),1)=$S(X="L":"LC",X="O ":"WC",X=2:"I",1:"SP") "RTN","ORMLR",36,0) ZC1 S NTE=$O(@ORMSG@(OBR)) I NTE,$E(@ORMSG@(NTE),1,3)="NTE" D "RTN","ORMLR",37,0) "RTN","ORMLR",38,0) . S LCNT=1,^TMP("ORWORD",$J,WP,1,LCNT,0)=$P(@ORMSG@(NTE),"|",4) "RTN","ORMLR",39,0) . S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORWORD",$J,WP,1, LCNT,0)=@ORMSG@(NTE,I) "RTN","ORMLR",40,0) . S ^TMP("ORWORD",$J,WP,1,0)="^^"_LCNT_U_LCNT_U_DT_U "RTN","ORMLR",41,0) . S ORDIALOG(WP,1)="^TMP(""ORWORD"","_$J_","_WP_",1)" "RTN","ORMLR",42,0) S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT "RTN","ORMLR",43,0) S ^OR(100,ORIFN,4)=PKGIFN,$P(^(0),U,5)=+ORDIALOG_";ORD(101.41," "RTN","ORMLR",44,0) D RESPONSE^ORCSAVE ; save ORDIALOG() into ^(4.5) "RTN","ORMLR",45,0) K ^TMP("ORWORD",$J) "RTN","ORMLR",46,0) Q "RTN","ORMLR",47,0) ; SN ; -- New backdoor order: return NA msg w/ORIFN, or DE msg "RTN","ORMLR",49,0) N X,ORDIALOG,ORDG,OBR,NTE,CMMT,OI,LCNT,I,ORSTS,LRSUB,ORNEW,ORP "RTN","ORMLR",50,0) I ORDUZ,'$D(^VA(200,+ORDUZ,0)) S ORERR="Invalid entering person" Q "RTN","ORMLR",51,0) ; I '$G(ORL) S ORERR="Missing or invalid patient location" Q "RTN","ORMLR",52,0) ;S LRSUB=$E($P($P(@ORMSG@(+ORC),"|",4),U,2),3,4),ORDG=$$DGRP(LRSUB) "RTN","ORMLR",53,0) S ORDIALOG="LR OTHER LAB TESTS" ; $S(LRSUB="AP",LRSUB="BB") "RTN","ORMLR",54,0) S ORDIALOG=$O(^ORD(101.41,"AB",ORDIALOG,0)) D GETDLG1^ORCD(ORDIALOG) "RTN","ORMLR",55,0) S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT "RTN","ORMLR",56,0) S CMMT=$$PTR("WORD PROCESSING 1") K ^TMP("ORWORD",$J) "RTN","ORMLR",57,0) SN1 S OBR=$O(@ORMSG@(+ORC)) I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="M issing OBR segment" Q "RTN","ORMLR",58,0) "RTN","ORMLR",59,0) S LRSUB=$P(^ORD(101.43,OI,"LR"),U,6),ORDG=$$DGRP(LRSUB) "RTN","ORMLR",60,0) S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI "RTN","ORMLR",61,0) I LRSUB="BB" S ORDIALOG($$PTR("QUANTITY"),1)=+ORQT G SN2 "RTN","ORMLR",62,0) S X=$$FIND^ORM(OBR,16),ORDIALOG($$PTR("COLLECTION SAMPLE"),1)=$P(X,";",4) "RTN","ORMLR",63,0) S ORDIALOG($$PTR("SPECIMEN"),1)=$S($L($P(X,";")):$O(^LAB(61,"C",$P(X,";"),0)), 1:+$P(X,U,4)) "RTN","ORMLR",64,0) S X=+$P($P($$FIND^ORM(OBR,28),U,6),";",2),ORDIALOG($$PTR("LAB URGENCY"),1)=$S( X:X,1:9) "RTN","ORMLR",65,0) S X=$$FIND^ORM(OBR,12),ORDIALOG($$PTR("COLLECTION TYPE"),1)=$S(X="L":"LC",X="O ":"WC",X=2:"I",1:"SP") "RTN","ORMLR",66,0) SN2 S NTE=$O(@ORMSG@(+OBR)) I NTE,$E(@ORMSG@(NTE),1,3)="NTE" D "RTN","ORMLR",67,0) . S LCNT=1,^TMP("ORWORD",$J,CMMT,1,LCNT,0)=$P(@ORMSG@(NTE),"|",4) . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S LCNT=LCNT+1,^ TMP("ORWORD",$J,CMMT,1,LCNT,0)=@ORMSG@(NTE,I) "RTN","ORMLR",69,0) . S ^TMP("ORWORD",$J,CMMT,1,0)="^^"_LCNT_U_LCNT_U_DT_U,ORDIALOG(CMMT,1)="^TMP( ""ORWORD"",$J,"_CMMT_",1)" "RTN","ORMLR",70,0) SNQ D EN^ORCSAVE K ^TMP("ORWORD",$J) "RTN","ORMLR",71,0) I '$G(ORIFN) S ORERR="Cannot create new order" Q "RTN","ORMLR",72,0) ;Save DG1 and ZCL segments of HL7 message from backdoor orders "RTN","ORMLR",73,0) D BDOSTR^ORWDBA3 "RTN","ORMLR",74,0) D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR),SIGSTS^ORCSAVE2(ORIFN,1) "RTN","ORMLR",75,0) D:ORSTOP DATES^ORCSAVE2(ORIFN,,ORSTOP) ;Start date in order itself "RTN","ORMLR",76,0) S ORSTS=$$STATUS(ORDSTS) D:ORSTS STATUS^ORCSAVE2(ORIFN,ORSTS) "RTN","ORMLR",77,0) I ORDCNTRL="SN",$G(ORL) S ORP(1)=ORIFN_";1^1" D PRINTS^ORWD1(.ORP,+ORL) S ^OR(100,ORIFN,4)=PKGIFN "RTN","ORMLR",79,0) Q "RTN","ORMLR",80,0) ; "RTN","ORMLR",81,0) PTR(NAME) ; -- Returns ien of prompt NAME in Order Dialog file #101.41 "RTN","ORMLR",82,0) Q $O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0)) "RTN","ORMLR",83,0) ; "RTN","ORMLR",84,0) DGRP(DG) ; -- Returns Display Group ptr based on Lab section "RTN","ORMLR",85,0) N Y S:'$L($G(DG)) DG="CH" S Y=$O(^ORD(100.98,"B",DG,0)) "RTN","ORMLR",86,0) S:'Y Y=$O(^ORD(100.98,"B","LAB",0)) "RTN","ORMLR",87,0) Q Y "RTN","ORMLR",88,0) ; XX ; -- Changed: NOT IN USE "RTN","ORMLR",90,0) D XX^ORMLR1 "RTN","ORMLR",91,0) Q "RTN","ORMLR",92,0) ; "RTN","ORMLR",93,0) XR ; -- Changed [ack]: NOT IN USE "RTN","ORMLR",94,0) N ORIG "RTN","ORMLR",95,0) S ^OR(100,+ORIFN,4)=PKGIFN,ORIG=$P(^(3),U,5) "RTN","ORMLR",96,0) D:ORIG STATUS^ORCSAVE2(ORIG,12) "RTN","ORMLR",97,0) D STATUS^ORCSAVE2(+ORIFN,5) ; pending "RTN","ORMLR",98,0) Q "RTN","ORMLR",99,0) ; ZP ; -- Purged "RTN","ORMLR",101,0) Q:'ORIFN Q:'$D(^OR(100,+ORIFN,0)) "RTN","ORMLR",102,0) S $P(^OR(100,+ORIFN,4),";",1,3)=";;" I "^5^6^"[(U_$P($G(^(3)),U,3)_U) D STATUS ^ORCSAVE2(+ORIFN,$S($P(^(4),";",5):2,1:14)) ; Remove pkg reference, sts=lapsed if still active "RTN","ORMLR",103,0) Q "RTN","ORMLR",104,0) ; "RTN","ORMLR",105,0) ZR ; -- Purged as requested [ack] "RTN","ORMLR",106,0) D DELETE^ORCSAVE2(+ORIFN) "RTN","ORMLR",107,0) Q "RTN","ORMLR",108,0) ; "RTN","ORMLR",109,0) ZU ; -- Unable to purge [ack] S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity "RTN","ORMLR",111,0) Q "RTN","ORMLR",112,0) ; "RTN","ORMLR",113,0) SC ; -- Status changed (collected) "RTN","ORMLR",114,0) N ORSTS D DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP) "RTN","ORMLR",115,0) S ORSTS=$$STATUS(ORDSTS) D:ORSTS STATUS^ORCSAVE2(+ORIFN,ORSTS) "RTN","ORMLR",116,0) S:$L($P(OREASON,U,2)) ^OR(100,+ORIFN,8,1,1)=$P(OREASON,U,2) "RTN","ORMLR",117,0) Q "RTN","ORMLR",118,0) ; "RTN","ORMLR",119,0) RE ; -- Completed, w/results "RTN","ORMLR",120,0) N ORSTS,ORX,I,SEG,DONE,X,Y,ORABN,ORFIND,LRSA,LRSB S ORSTS=$$STATUS(ORDSTS) D:ORSTS STATUS^ORCSAVE2(+ORIFN,ORSTS) "RTN","ORMLR",122,0) S ^OR(100,+ORIFN,4)=PKGIFN,ORX="" D ;get Results D/T [from OBR] "RTN","ORMLR",123,0) . N OBR S OBR=+$O(@ORMSG@(+ORC)),X="" "RTN","ORMLR",124,0) . I OBR,$E($G(@ORMSG@(OBR)),1,3)="OBR" S X=$P(@ORMSG@(OBR),"|",23) "RTN","ORMLR",125,0) . S X=+$E($$NOW^XLFDT,1,12) "RTN","ORMLR",126,0) . S $P(^OR(100,+ORIFN,7),U)=X,^OR(100,"ARS",ORVP,9999999-X,+ORIFN)="" "RTN","ORMLR",127,0) D RR^LR7OR1(DFN,PKGIFN) "RTN","ORMLR",128,0) S ORABN="",ORFIND="" "RTN","ORMLR",129,0) I $D(^TMP("LRRR",$J)) D "RTN","ORMLR",130,0) . N IDT,DNAM,ORSLT "RTN","ORMLR",131,0) . S IDT=0 F S IDT=$O(^TMP("LRRR",$J,DFN,"CH",IDT)) Q:'IDT D .. S DNAM=0 F S DNAM=$O(^TMP("LRRR",$J,DFN,"CH",IDT,DNAM)) Q:'DNAM D "RTN","ORMLR",133,0) ... S ORSLT=$G(^TMP("LRRR",$J,DFN,"CH",IDT,DNAM)) "RTN","ORMLR",134,0) ... I '$L($P(ORSLT,U,3)) Q "RTN","ORMLR",135,0) ... S ORABN=1,ORFIND=$S($L(ORFIND):(ORFIND_", "),1:"") "RTN","ORMLR",136,0) ... S ORFIND=ORFIND_$P(ORSLT,U,15)_"="_$P(ORSLT,U,2) "RTN","ORMLR",137,0) . Q "RTN","ORMLR",138,0) K ^TMP("LRRR",$J),^TMP("LRX",$J) "RTN","ORMLR",139,0) S $P(^OR(100,+ORIFN,7),U,2,3)=ORABN_U_ORFIND "RTN","ORMLR",140,0) S:'$G(ORNP) ORNP=+$P($G(^OR(100,+ORIFN,0)),U,4) "RTN","ORMLR",141,0) I $L($T(ADD^ORRCACK)) D ADD^ORRCACK(+ORIFN,ORNP) ;Ack stub for prov "RTN","ORMLR",142,0) Q ; "RTN","ORMLR",144,0) OC ; -- Cancelled "RTN","ORMLR",145,0) G:ORTYPE="ORR" UA S:ORNATR=+$O(^ORD(100.02,"C","A",0)) ORDUZ="" "RTN","ORMLR",146,0) S ^OR(100,+ORIFN,6)=ORNATR_U_ORDUZ_U_ORLOG_U_$P(OREASON,U)_U_$E($P(OREASON,U,2 ),1,80) "RTN","ORMLR",147,0) D UPDATE(1,"DC") "RTN","ORMLR",148,0) Q "RTN","ORMLR",149,0) ; "RTN","ORMLR",150,0) CR ; -- Cancelled [ack] "RTN","ORMLR",151,0) D STATUS^ORCSAVE2(+ORIFN,1) "RTN","ORMLR",152,0) Q "RTN","ORMLR",153,0) "RTN","ORMLR",154,0) UA ; -- Unable to accept [ack] "RTN","ORMLR",155,0) UX ; -- Unable to change [ack]: NOT IN USE "RTN","ORMLR",156,0) S:'ORNATR ORNATR=$O(^ORD(100.02,"C","X",0)) ;rejected "RTN","ORMLR",157,0) S ^OR(100,+ORIFN,6)=ORNATR_U_U_ORLOG_U_$P(OREASON,U)_U_$E($P(OREASON,U,2),1,80 ) "RTN","ORMLR",158,0) D STATUS^ORCSAVE2(+ORIFN,13) "RTN","ORMLR",159,0) UC ; -- Unable to cancel [ack] "RTN","ORMLR",160,0) DE ; -- Data Error [ack] "RTN","ORMLR",161,0) N DA S DA=$P(ORIFN,";",2) Q:'DA "RTN","ORMLR",162,0) S $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ;request rejected "RTN","ORMLR",163,0) S:$L($P(OREASON,U,2)) ^OR(100,+ORIFN,8,DA,1)=$E($P(OREASON,U,2),1,240) Q "RTN","ORMLR",165,0) ; "RTN","ORMLR",166,0) UPDATE(ORSTS,ORACT) ; -- continue processing "RTN","ORMLR",167,0) N DA,ORX,ORCMMT,ORP "RTN","ORMLR",168,0) D DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP) "RTN","ORMLR",169,0) D:$G(ORSTS) STATUS^ORCSAVE2(+ORIFN,ORSTS) "RTN","ORMLR",170,0) S ORCMMT=$E($P(OREASON,U,2),1,240),ORX=$$CREATE^ORX1(ORNATR) D:ORX "RTN","ORMLR",171,0) . S DA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,ORCMMT,ORLOG,ORDUZ) "RTN","ORMLR",172,0) . I DA'>0 S ORERR="Cannot create new order action" Q "RTN","ORMLR",173,0) . D RELEASE^ORCSAVE2(+ORIFN,DA,ORLOG,ORDUZ,ORNATR) "RTN","ORMLR",174,0) . D SIGSTS^ORCSAVE2(+ORIFN,DA) . I $G(ORL) S ORP(1)=+ORIFN_";"_DA_"^1" D PRINTS^ORWD1(.ORP,+ORL) "RTN","ORMLR",176,0) . S $P(^OR(100,+ORIFN,3),U,7)=DA "RTN","ORMLR",177,0) I '$$ACTV^ORX1(ORNATR) S $P(^OR(100,+ORIFN,3),U,7)=0 "RTN","ORMLR",178,0) D:ORACT="DC" CANCEL^ORCSEND(+ORIFN) "RTN","ORMLR",179,0) Q "RTN","ORMLR",180,0) ; "RTN","ORMLR",181,0) REASON() ; -- Get reason from OREASON or NTE segments "RTN","ORMLR",182,0) N NTE,CMMT,X,Y,I,L "RTN","ORMLR",183,0) S NTE=+$O(@ORMSG@(+ORC)),CMMT=$P(OREASON,U,4,5) "RTN","ORMLR",184,0) G:'NTE RQ G:$E(@ORMSG@(NTE),1,3)'="NTE" RQ ; no add'l comments "RTN","ORMLR",185,0) S Y=$P(@ORMSG@(NTE),"|",4),I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S X=$G(@ORMSG@(NTE,I)),L=$L(Y)+1+$L(X) S:L'> 240 Y=Y_" "_X I L>240 S Y=Y_" "_$E(X,1,239-$L(Y)) Q "RTN","ORMLR",187,0) S $P(CMMT,U,2)=Y "RTN","ORMLR",188,0) RQ Q CMMT "RTN","ORMRA") 0^3^B62138554 "RTN","ORMRA",1,0) ORMRA ; SLC/MKB/RV - Process Radiology ORM msgs ;2/21/02 15:44 [05/30/06 12:30 pm] "RTN","ORMRA",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,53,92,110,136,153,174,195,228,243,296* *;Dec 17, 1997;Build 0 "RTN","ORMRA",3,0) ;DBIA 2968 allows for reading ^DIC(34 "RTN","ORMRA",4,0) EN ; -- entry point for RA messages "RTN","ORMRA",5,0) I '$L($T(@ORDCNTRL)) Q ;S ORERR="Invalid order control code" Q "RTN","ORMRA",6,0) id OE/RR order number" Q "RTN","ORMRA",7,0) S OREASON=$S($P(OREASON,U,6)="99RAR":$P(OREASON,U,5),1:$P(OREASON,U,2)) "RTN","ORMRA",8,0) S:'ORDUZ ORDUZ=DUZ S:'ORLOG ORLOG=+$E($$NOW^XLFDT,1,12) "RTN","ORMRA",9,0) D @ORDCNTRL "RTN","ORMRA",10,0) Q "RTN","ORMRA",11,0) ; "RTN","ORMRA",12,0) ZP ; -- Purged "RTN","ORMRA",13,0) Q:'ORIFN Q:'$D(^OR(100,+ORIFN,0)) K ^OR(100,+ORIFN,4) "RTN","ORMRA",14,0) ; - Set status=lapsed, if still active "RTN","ORMRA",15,0) I "^3^5^6^8^"[(U_$P($G(^OR(100,+ORIFN,3)),U,3)_U) D STATUS^ORCSAVE2(ORIFN,14) "RTN","ORMRA",16,0) Q ; "RTN","ORMRA",18,0) ZR ; -- Purged as requested [ack] "RTN","ORMRA",19,0) D DELETE^ORCSAVE2(+ORIFN) "RTN","ORMRA",20,0) Q "RTN","ORMRA",21,0) ; "RTN","ORMRA",22,0) ZU ; -- Unable to purge [ack] "RTN","ORMRA",23,0) S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity "RTN","ORMRA",24,0) Q "RTN","ORMRA",25,0) ; "RTN","ORMRA",26,0) OK ; -- Order accepted, RA order # assigned [ack] "RTN","ORMRA",27,0) N ORSTS,OBR S ^OR(100,+ORIFN,4)=PKGIFN,ORSTS=5 ; 5=pending ; Ck if also scheduled, else quit "RTN","ORMRA",29,0) S OBR=$O(@ORMSG@(+ORC)) G:'OBR OKQ G:$E(@ORMSG@(OBR),1,3)'="OBR" OKQ "RTN","ORMRA",30,0) S ORSTRT=$$FMDATE^ORM($P(@ORMSG@(OBR),"|",37)) "RTN","ORMRA",31,0) D:ORSTRT DATES^ORCSAVE2(+ORIFN,ORSTRT) "RTN","ORMRA",32,0) OKQ D STATUS^ORCSAVE2(ORIFN,ORSTS) "RTN","ORMRA",33,0) ;Save the Radiology pre-certification Account Reference in the PV1 "RTN","ORMRA",34,0) ;segment of the HL7 message from the Radiology package to the Order "RTN","ORMRA",35,0) ;File (#100). Support for Patch OR*3.0*228 "RTN","ORMRA",36,0) I +$$SWSTAT^IBBAPI() D PRECERT^ORWPFSS2 ;IA #4663 "RTN","ORMRA",37,0) Q "RTN","ORMRA",38,0) ; XX ; -- Change order "RTN","ORMRA",40,0) N ORDIALOG,ORDG,ORDA,ORX,ORP S:'$L(ORNATR) ORNATR="S" "RTN","ORMRA",41,0) D DLG Q:$D(ORERR) Q:'$D(ORDIALOG) S ORIFN=+ORIFN "RTN","ORMRA",42,0) S ORDA=$$ACTION^ORCSAVE("XX",ORIFN,ORNP,OREASON,ORLOG,ORDUZ) "RTN","ORMRA",43,0) I ORDA'>0 S ORERR="Cannot create new order action" Q "RTN","ORMRA",44,0) ; -Update sts of order to active, last action to dc/edit: "RTN","ORMRA",45,0) S ORX=+$P($G(^OR(100,ORIFN,3)),U,7) "RTN","ORMRA",46,0) S:$P($G(^OR(100,ORIFN,8,ORX,0)),U,15)="" $P(^(0),U,15)=12 "RTN","ORMRA",47,0) S $P(^OR(100,ORIFN,3),U,7)=ORDA D STATUS^ORCSAVE2(ORIFN,6) "RTN","ORMRA",48,0) D RELEASE^ORCSAVE2(ORIFN,ORDA,ORLOG,ORDUZ,ORNATR) "RTN","ORMRA",49,0) ; -If unsigned edit, leave XX unsigned & mark ORX as Sig Not Req'd S ORSIG=$S($P($G(^OR(100,ORIFN,8,ORX,0)),U,4)'=2:1,1:0) "RTN","ORMRA",51,0) D SIGSTS^ORCSAVE2(ORIFN,ORDA):ORSIG,SIGN^ORCSAVE2(ORIFN,,,5,ORX):'ORSIG "RTN","ORMRA",52,0) ; -Update responses, get/save new order text: "RTN","ORMRA",53,0) K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ORDA) "RTN","ORMRA",54,0) S $P(^OR(100,ORIFN,8,ORDA,0),U,14)=ORDA "RTN","ORMRA",55,0) I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL) "RTN","ORMRA",56,0) Q "RTN","ORMRA",57,0) ; "RTN","ORMRA",58,0) SN ; -- New backdoor order: return NA msg w/ORIFN, or DE msg "RTN","ORMRA",59,0) N ORDIALOG,ORDG,ORP K ^TMP("ORWORD",$J) S:'$L(ORNATR) ORNATR="W" "RTN","ORMRA",60,0) I ORDUZ,'$D(^VA(200,ORDUZ,0)) S ORERR="Invalid entering person" Q I '$D(^VA(200,ORNP,0)) S ORERR="Missing or invalid ordering provider" Q "RTN","ORMRA",62,0) I '$G(ORL) S ORERR="Missing or invalid patient location" Q "RTN","ORMRA",63,0) D DLG Q:$D(ORERR) Q:'$D(ORDIALOG) "RTN","ORMRA",64,0) SNQ D EN^ORCSAVE K ^TMP("ORWORD",$J) "RTN","ORMRA",65,0) I '$G(ORIFN) S ORERR="Cannot create new order" Q "RTN","ORMRA",66,0) ;Save DG1 and ZCL segments of HL7 message from backdoor orders "RTN","ORMRA",67,0) D BDOSTR^ORWDBA3 "RTN","ORMRA",68,0) ;Save the Radiology pre-certification Account Reference in the PV1 "RTN","ORMRA",69,0) ;segment of the HL7 message from the Radiology package to the Order "RTN","ORMRA",70,0) ;File (#100). Support for Patch OR*3.0*228 "RTN","ORMRA",71,0) I +$$SWSTAT^IBBAPI() D PRECERT^ORWPFSS2 ;IA #4663 D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR),SIGSTS^ORCSAVE2(ORIFN,1) "RTN","ORMRA",73,0) D STATUS^ORCSAVE2(ORIFN,5) S ^OR(100,ORIFN,4)=PKGIFN "RTN","ORMRA",74,0) I $G(ORL) S ORP(1)=ORIFN_";1^1" D PRINTS^ORWD1(.ORP,+ORL) ; chart copy "RTN","ORMRA",75,0) Q "RTN","ORMRA",76,0) ; "RTN","ORMRA",77,0) DLG ; -- Build ORDIALOG() from msg "RTN","ORMRA",78,0) N OBR,OI,MODS,J,X,Y,ILOC,MODE,CH,CHI,OBX,NTE,REASON "RTN","ORMRA",79,0) S ORDIALOG=$O(^ORD(101.41,"AB","RA OERR EXAM",0)) "RTN","ORMRA",80,0) D GETDLG1^ORCD(ORDIALOG) "RTN","ORMRA",81,0) S ORDIALOG($$PTR("CATEGORY"),1)=$G(ORCAT) "RTN","ORMRA",82,0) S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT S ORDIALOG($$PTR("URGENCY"),1)=ORURG "RTN","ORMRA",84,0) S:$P(ORC,"|",12) ORDIALOG($$PTR("PROVIDER"),1)=+$P(ORC,"|",12) "RTN","ORMRA",85,0) D1 S OBR=$O(@ORMSG@(+ORC)) I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="Mi ssing OBR segment" Q "RTN","ORMRA",86,0) S OI=$$ORDITEM^ORM($P(@ORMSG@(OBR),"|",5)) "RTN","ORMRA",87,0) I 'OI S ORERR="Invalid procedure" Q "RTN","ORMRA",88,0) S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI "RTN","ORMRA",89,0) S ORDG=$P($G(^ORD(101.43,+OI,"RA")),U,3) S:$L(ORDG) ORDG=+$O(^ORD(100.98,"B",O RDG,0)) I 'ORDG S ORDG=$P(^ORD(101.41,+ORDIALOG,0),U,5) ; Im Type "RTN","ORMRA",90,0) S MODS=$P(@ORMSG@(OBR),"|",19) I $L(MODS) D "RTN","ORMRA",91,0) . F J=1:1:$L(MODS,"~") S X=$P(MODS,"~",J) I $L(X) S Y=$O(^RAMIS(71.2,"B",X,0)) S:Y ORDIALOG($$PTR("MODIFIERS"),J)=Y "RTN","ORMRA",92,0) SG@(OBR),"|",32),U,2) "RTN","ORMRA",93,0) S:ILOC ORDIALOG($$PTR("IMAGING LOCATION"),1)=ILOC "RTN","ORMRA",94,0) S ORDIALOG($$PTR("MODE OF TRANSPORT"),1)=$S(MODE="WALK":"A",MODE="CART":"S",1: $E(MODE)) "RTN","ORMRA",95,0) S:$L(REASON) ORDIALOG($$PTR("STUDY REASON"),1)=REASON "RTN","ORMRA",96,0) I ORDCNTRL="XX" S NTE=+$O(@ORMSG@(OBR)) I NTE,$E($G(@ORMSG@(NTE)),1,3)="NTE" S OREASON=$P(@ORMSG@(NTE),"|",4) ;Tech's Comments "RTN","ORMRA",97,0) D2 ; might the procedure be scheduled at this point ?? Not in spec "RTN","ORMRA",98,0) S CH=$$PTR("WORD PROCESSING 1"),CHI=0 "RTN","ORMRA",99,0) S OBX=OBR F S OBX=$O(@ORMSG@(OBX)) Q:OBX'>0 S J=$E(@ORMSG@(OBX),1,3) Q:J="OR C" Q:J="MSH" I J="OBX" D "RTN","ORMRA",100,0) . N NAME,VALUE,X0 S VALUE=$P(@ORMSG@(OBX),"|",6) "RTN","ORMRA",101,0) "RTN","ORMRA",102,0) . I NAME="CONTRACT/SHARING SOURCE" S X0=$G(^DIC(34,+VALUE,0)) S:$L(X0) ORDIALO G($$PTR(NAME),1)=+VALUE,ORDIALOG($$PTR("CATEGORY"),1)=$P(X0,U,2) Q "RTN","ORMRA",103,0) . I NAME="RESEARCH SOURCE" S ORDIALOG($$PTR(NAME),1)=VALUE,ORDIALOG($$PTR("CAT EGORY"),1)="R" Q "RTN","ORMRA",104,0) . I NAME="PREGNANT" S ORDIALOG($$PTR(NAME),1)=VALUE Q "RTN","ORMRA",105,0) . I NAME="PRE-OP SCHEDULED DATE/TIME" S ORDIALOG($$PTR(NAME),1)=$$FMDATE^ORM(V ALUE) Q "RTN","ORMRA",106,0) . S CHI=CHI+1,^TMP("ORWORD",$J,CH,1,CHI,0)=VALUE "RTN","ORMRA",107,0) S:CHI ^TMP("ORWORD",$J,CH,1,0)="^^"_CHI_U_CHI_U_DT_U,ORDIALOG(CH,1)="^TMP(""OR WORD"",$J,"_CH_",1)" "RTN","ORMRA",108,0) Q "RTN","ORMRA",109,0) ; "RTN","ORMRA",110,0) "RTN","ORMRA",111,0) Q +$O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0)) "RTN","ORMRA",112,0) ; "RTN","ORMRA",113,0) SC ; -- Status changed (scheduled, registered, or unverified) "RTN","ORMRA",114,0) N ORSTS,OBR,OR3 ;110 "RTN","ORMRA",115,0) S ORSTS=$S(ORDSTS="ZR":6,ORDSTS="ZU":6,1:8),OR3=$G(^OR(100,+ORIFN,3)) ;110 "RTN","ORMRA",116,0) G:ORSTS=6 SCQ ;136 Done if active, else get scheduled data "RTN","ORMRA",117,0) S OBR=$O(@ORMSG@(+ORC)) I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="Miss ing OBR segment" Q "RTN","ORMRA",118,0) S ORSTRT=$$FMDATE^ORM($P(@ORMSG@(OBR),"|",37)) "RTN","ORMRA",119,0) D:ORSTRT DATES^ORCSAVE2(+ORIFN,ORSTRT) "RTN","ORMRA",120,0) I $P(OR3,U,3)=3,$P($G(^OR(100,+ORIFN,8,+$P(OR3,U,7),0)),U,2)="HD" D RL ;If sta "RTN","ORMRA",121,0) SCQ D STATUS^ORCSAVE2(ORIFN,ORSTS) "RTN","ORMRA",122,0) Q "RTN","ORMRA",123,0) ; "RTN","ORMRA",124,0) RE ; -- Completed, w/results "RTN","ORMRA",125,0) N I,SEG,OBX "RTN","ORMRA",126,0) D STATUS^ORCSAVE2(ORIFN,2) "RTN","ORMRA",127,0) S OBX="" D ;get Results D/T [from OBR] "RTN","ORMRA",128,0) . N DA,DR,DIE,X,Y,OBR "RTN","ORMRA",129,0) . S DA=+ORIFN,DIE="^OR(100,",OBR=+$O(@ORMSG@(+ORC)),X="" "RTN","ORMRA",130,0) . I OBR,$E($G(@ORMSG@(OBR)),1,3)="OBR" S X=$P(@ORMSG@(OBR),"|",23) "RTN","ORMRA",131,0) "RTN","ORMRA",132,0) S I=+ORC F S I=$O(@ORMSG@(I)) Q:I<1 S SEG=$G(@ORMSG@(I)) Q:$E(SEG,1,3)="ORC" I $E(SEG,1,3)="OBX" S OBX=I_U_SEG Q ;first one "RTN","ORMRA",133,0) S $P(^OR(100,+ORIFN,7),U,2)=$S($P(OBX,"|",9)="A":1,1:"") "RTN","ORMRA",134,0) S:'$G(ORNP) ORNP=+$P($G(^OR(100,+ORIFN,0)),U,4) "RTN","ORMRA",135,0) I $L($T(ADD^ORRCACK)) D ADD^ORRCACK(+ORIFN,ORNP) ;Ack stub for prov "RTN","ORMRA",136,0) Q "RTN","ORMRA",137,0) ; "RTN","ORMRA",138,0) OH ; -- Held "RTN","ORMRA",139,0) D UPDATE(3,"HD") "RTN","ORMRA",140,0) Q "RTN","ORMRA",141,0) ; OC ; -- Cancelled/Unable to accept [ack] "RTN","ORMRA",143,0) UA ; -- Unable to accept [ack] "RTN","ORMRA",144,0) S:'$L(ORNATR) ORNATR="X" ;Rejected "RTN","ORMRA",145,0) S ^OR(100,+ORIFN,6)=$O(^ORD(100.02,"C",ORNATR,0))_U_U_ORLOG_U_U_OREASON "RTN","ORMRA",146,0) D STATUS^ORCSAVE2(ORIFN,13) "RTN","ORMRA",147,0) UD ; -- Unable to discontinue [ack] "RTN","ORMRA",148,0) N DA S DA=+$P(ORIFN,";",2) I DA D "RTN","ORMRA",149,0) . S $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ;Request rejected "RTN","ORMRA",150,0) . S:$L(OREASON) ^OR(100,+ORIFN,8,DA,1)=OREASON "RTN","ORMRA",151,0) Q "RTN","ORMRA",152,0) ; OD ; -- Discontinued "RTN","ORMRA",154,0) S:$G(DGPMT) ORDUZ="" ;auto-dc on movement "RTN","ORMRA",155,0) S ^OR(100,+ORIFN,6)=$S($L(ORNATR):$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_ U_ORLOG_U_U_OREASON "RTN","ORMRA",156,0) D UPDATE(1,"DC") "RTN","ORMRA",157,0) Q "RTN","ORMRA",158,0) ; "RTN","ORMRA",159,0) DR ; -- Discontinued [ack] "RTN","ORMRA",160,0) D STATUS^ORCSAVE2(ORIFN,1) "RTN","ORMRA",161,0) Q "RTN","ORMRA",162,0) ; "RTN","ORMRA",163,0) "RTN","ORMRA",164,0) N ORX,ORDA,ORP D:$G(ORSTS) STATUS^ORCSAVE2(ORIFN,ORSTS) "RTN","ORMRA",165,0) S ORX=$$CREATE^ORX1(ORNATR) D:ORX "RTN","ORMRA",166,0) . S ORDA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,OREASON,ORLOG,ORDUZ) "RTN","ORMRA",167,0) . I ORDA'>0 S ORERR="Cannot create new order action" Q "RTN","ORMRA",168,0) . D RELEASE^ORCSAVE2(+ORIFN,ORDA,ORLOG,ORDUZ,ORNATR) "RTN","ORMRA",169,0) . D SIGSTS^ORCSAVE2(+ORIFN,ORDA) "RTN","ORMRA",170,0) . I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL) "RTN","ORMRA",171,0) . S $P(^OR(100,+ORIFN,3),U,7)=ORDA "RTN","ORMRA",172,0) I 'ORX D ;no new action created "RTN","ORMRA",173,0) . ;I ORACT="DC" S:'$$ACTV^ORX1(ORNATR) $P(^OR(100,+ORIFN,3),U,7)=0 Q "RTN","ORMRA",174,0) "RTN","ORMRA",175,0) I ORACT="DC" D CANCEL^ORCSEND(+ORIFN) S:'$$ACTV^ORX1(ORNATR) $P(^OR(100,+ORIFN ,3),U,7)=0 "RTN","ORMRA",176,0) Q "RTN","ORMRA",177,0) ; "RTN","ORMRA",178,0) RL ;Release hold --entire section added with patch 110 "RTN","ORMRA",179,0) S ^OR(100,+ORIFN,8,$P(OR3,U,7),2)=ORLOG_"^"_ORDUZ ;Set release hold date/time and release hold user "RTN","ORMRA",180,0) S ORNATR=$S($L(ORNATR):ORNATR,1:$P(^OR(100,+ORIFN,8,$P(OR3,U,7),0),U,12)) ;set nature of order for release equal to nature of order for hold if it doesn't ex ist "RTN","ORMRA",181,0) I $G(ORSTS)="" S ORSTS=6 "RTN","ORMRA",182,0) D UPDATE(ORSTS,"RL") "RTN","ORMRA",183,0) "RTN","ORRCLNP") 0^4^B585941 "RTN","ORRCLNP",1,0) ORRCLNP ; SLC/JER - Person functions for CM ; 9/23/04 14:30 "RTN","ORRCLNP",2,0) ;;1.0;CARE MANAGEMENT;**1**;Jul 15, 2003;Build 0 "RTN","ORRCLNP",3,0) EMAIL(USER) ; e-mail address "RTN","ORRCLNP",4,0) Q $$NETNAME^XMXUTIL(USER) "RTN","ORRCLNP",5,0) NAME(USER) ; Person Name "RTN","ORRCLNP",6,0) Q $$NAME^XUSER(USER) "RTN","ORRCLNP",7,0) SSNL4(USER) ; SSN Last4 "RTN","ORRCLNP",8,0) N ORRCY "RTN","ORRCLNP",9,0) S ORRCY=$$GET1^DIQ(200,USER,9) "RTN","ORRCLNP",10,0) "RTN","ORRCLNP",11,0) SEX(USER) ; Person SEX "RTN","ORRCLNP",12,0) Q $$GET1^DIQ(200,USER,4,"I") "RTN","ORRCLNP",13,0) PROVIDER(USER) ; Boolean fn: is user a provider "RTN","ORRCLNP",14,0) Q $S(+$D(^XUSEC("PROVIDER",USER)):1,+$$ISA^USRLM(USER,"PROVIDER"):1,1:0) "RTN","ORRCLNP",15,0) ; "RTN","ORRCLNP",16,0) SYS(PROD) ;RPC to determine if current system is PROD or TEST "RTN","ORRCLNP",17,0) ; **Requires XU*8.0*284 "RTN","ORRCLNP",18,0) ; "RTN","ORRCLNP",19,0) ; Input: NONE "RTN","ORRCLNP",20,0) ; Output: returned in PROD "RTN","ORRCLNP",21,0) "RTN","ORRCLNP",22,0) ; 0 if not production system "RTN","ORRCLNP",23,0) ; "RTN","ORRCLNP",24,0) S PROD=+$$PROD^XUPROD "RTN","ORRCLNP",25,0) Q "RTN","ORRCQLPT") 0^5^B1006284 "RTN","ORRCQLPT",1,0) ORRCQLPT ; SLC/TH - CPRS Query Tools - Libraries ; 25 Jul 2003 9:31 AM "RTN","ORRCQLPT",2,0) ;;1.0;CARE MANAGEMENT;;Jul 15, 2003;Build 0 "RTN","ORRCQLPT",3,0) ; "RTN","ORRCQLPT",4,0) PTDFN(VAL,ID) ; Return patient info given an order, consult, or note "RTN","ORRCQLPT",5,0) N DFN,X,X0,X1,X101 "RTN","ORRCQLPT",6,0) "RTN","ORRCQLPT",7,0) I X="ORD"!(X="CST") S DFN=+$P(^OR(100,+$P(ID,":",2),0),U,2) "RTN","ORRCQLPT",8,0) I X="DOC" S DFN=+$P(^TIU(8925,+$P(ID,":",2),0),U,2) "RTN","ORRCQLPT",9,0) I X="PTC" S DFN=+$P(ID,":",2) "RTN","ORRCQLPT",10,0) ;I X="VST" visits too? "RTN","ORRCQLPT",11,0) Q:'DFN "RTN","ORRCQLPT",12,0) S VAL=DFN "RTN","ORRCQLPT",13,0) Q "RTN","ORRCQLPT",14,0) ; "RTN","ORRCQLPT",15,0) PTDEMOS(ORY,DFN) ; Return patient info "RTN","ORRCQLPT",16,0) ; ORY="^^^^" "RTN","ORRCQLPT",17,0) "RTN","ORRCQLPT",18,0) N VADM,VA,VAERR "RTN","ORRCQLPT",19,0) D DEM^VADPT "RTN","ORRCQLPT",20,0) S ORY=DFN_U_VADM(1)_U_VA("PID")_U_$$FMTHL7^XLFDT(+VADM(3))_U_VADM(4) "RTN","ORRCQLPT",21,0) Q "RTN","ORRCQLPT",22,0) ; "RTN","ORRCQLPT",23,0) TESTPTD(DFN) ; Test PTDEMOS "RTN","ORRCQLPT",24,0) N ORY "RTN","ORRCQLPT",25,0) D PTDEMOS(.ORY,DFN) "RTN","ORRCQLPT",26,0) W !,ORY "RTN","ORRCQLPT",27,0) Q "RTN","ORWORB") "RTN","ORWORB",1,0) ORWORB ; SLC/DEE,REV,CLA,WAT - RPC FUNCTIONS WHICH RETURN USER ALERT ;03/01/23 12:43 "RTN","ORWORB",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,148,173,190,215,243,296,329,33 4,410,377,498,405,596**;Dec 17, 1997;Build 0 "RTN","ORWORB",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified "RTN","ORWORB",4,0) ; "RTN","ORWORB",5,0) ; External reference to ^DPT( supported by IA 10035 "RTN","ORWORB",6,0) ; External reference to ^XTV(8992 supported by IA 2689 "RTN","ORWORB",7,0) ; External reference to ^XTV(8992.1 supported by IA 7063 "RTN","ORWORB",8,0) ; External reference to ^VA(200,5 supported by IA 4329 "RTN","ORWORB",9,0) ; External reference to ^XUSEC( supported by IA 10076 "RTN","ORWORB",10,0) "RTN","ORWORB",11,0) ; External reference to TIUSRVLO supported by IA 2834 "RTN","ORWORB",12,0) ; External reference to VADPT supported by IA 10061 "RTN","ORWORB",13,0) ; External reference to XLFDT supported by IA 10103 "RTN","ORWORB",14,0) ; External reference to XPAR supported by IA 2263 "RTN","ORWORB",15,0) ; External reference to XQALDATA supported by IA 4834 "RTN","ORWORB",16,0) ; External reference to XQALERT supported by IA 10081 "RTN","ORWORB",17,0) ; External reference to XQALBUTL supported by IA 2788 "RTN","ORWORB",18,0) ; "RTN","ORWORB",19,0) Q "RTN","ORWORB",20,0) GETLTXT(ORY,ORAID) ;get the long text for an alert "RTN","ORWORB",21,0) "RTN","ORWORB",22,0) D ALERTDAT^XQALBUTL(ORAID,"ORDATA") "RTN","ORWORB",23,0) S ORY(1)="" "RTN","ORWORB",24,0) I $D(ORDATA(4,1)) N ORI S ORI=0 F S ORI=$O(ORDATA(4,ORI)) Q:'ORI D "RTN","ORWORB",25,0) .S ORY(ORI)=ORDATA(4,ORI) "RTN","ORWORB",26,0) Q "RTN","ORWORB",27,0) ; "RTN","ORWORB",28,0) URGENLST(ORY) ;return array of the urgency for the notification "RTN","ORWORB",29,0) N ORSRV,ORERROR "RTN","ORWORB",30,0) S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U) "RTN","ORWORB",31,0) D GETLST^XPAR(.ORY,"USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORB URGENCY","I",.ORE RROR) Q "RTN","ORWORB",33,0) ; "RTN","ORWORB",34,0) FASTUSER(ORY,ORDEFFLG) ;return current user's notifications across all patients "RTN","ORWORB",35,0) ; ORDEFFLG: setting this to 1 causes the alerts API to exclude deferred alerts for this user "RTN","ORWORB",36,0) ; defaults to 1 if not passed in "RTN","ORWORB",37,0) N STRTDATE,STOPDATE,ORTOT,I,ORURG,URG,ORN,SORT,ORN0,URGLIST,REMLIST,REM,NONORL ST,NONOR "RTN","ORWORB",38,0) N ALRT,ALRTDT,ALRTPT,ALRTMSG,ALRTI,ALRTLOC,ALRTXQA,J,FWDBY,PRE,ALRTDFN,FROMFAS T "RTN","ORWORB",39,0) K ^TMP("ORB",$J),^TMP("ORBG",$J) "RTN","ORWORB",40,0) S STRTDATE="",STOPDATE="",FWDBY="Forwarded by: ",FROMFAST=1 "RTN","ORWORB",41,0) "RTN","ORWORB",42,0) D USERLIST(.ORY,STRTDATE,STOPDATE) "RTN","ORWORB",43,0) Q "RTN","ORWORB",44,0) ; "RTN","ORWORB",45,0) PROUSER(ORY,STRTDATE,STOPDATE,MAXRET,PROONLY) ;return current user's processed notifications for a specified date range "RTN","ORWORB",46,0) Q:'$$GET^XPAR("SYS","OR RTN PROCESSED ALERTS") "RTN","ORWORB",47,0) N FWDBY "RTN","ORWORB",48,0) K ^TMP("ORB",$J),^TMP("ORBG",$J) "RTN","ORWORB",49,0) S FWDBY="Forwarded by: " "RTN","ORWORB",50,0) D GETUSER2^XQALDATA("^TMP(""ORB"",$J)",DUZ,STRTDATE,STOPDATE,MAXRET,PROONLY) "RTN","ORWORB",51,0) D USERLIST(.ORY,STRTDATE,STOPDATE) Q "RTN","ORWORB",53,0) USERLIST(ORY,STRTDATE,STOPDATE) ;process for obtaining user's notifications "RTN","ORWORB",54,0) N ORTOT,I,ORURG,URG,ORN,SORT,ORN0,URGLIST,REMLIST,REM,NONORLST,NONOR "RTN","ORWORB",55,0) N ALRT,ALRTDT,ALRTPT,ALRTMSG,ALRTI,ALRTLOC,ALRTXQA,J,PRE,ALRTDFN,ORRMVD "RTN","ORWORB",56,0) S ORTOT=^TMP("ORB",$J) "RTN","ORWORB",57,0) D URGLIST^ORQORB(.URGLIST) "RTN","ORWORB",58,0) D REMLIST^ORQORB(.REMLIST) "RTN","ORWORB",59,0) D REMNONOR^ORQORB(.NONORLST) "RTN","ORWORB",60,0) S J=0 "RTN","ORWORB",61,0) F I=1:1:ORTOT D "RTN","ORWORB",62,0) .N ORPROV,ORBIRAD .S ALRTDFN="",REM="" "RTN","ORWORB",64,0) .S ALRT=^TMP("ORB",$J,I) "RTN","ORWORB",65,0) .S PRE=$E(ALRT,1,1) "RTN","ORWORB",66,0) .S ALRTXQA=$P(ALRT,U,2) Q:ALRTXQA="" ; XQAID expected "RTN","ORWORB",67,0) .S NONOR="" F S NONOR=$O(NONORLST(NONOR)) Q:NONOR="" D "RTN","ORWORB",68,0) ..I ALRTXQA[NONOR S REM=1 ;allow this type of alert to be Removed "RTN","ORWORB",69,0) .S ALRTMSG=$P($P(ALRT,U),PRE_" ",2) "RTN","ORWORB",70,0) .;S ALRTMSG=$P($P(ALRT,U),PRE,2,99),ALRTMSG=$$TRIM^XLFSTR(ALRTMSG,"L") "RTN","ORWORB",71,0) .I $E(ALRT,4,8)'="-----" D ;not forwarded alert info/comment "RTN","ORWORB",72,0) ..S ORRMVD=0 "RTN","ORWORB",73,0) ..S ORURG="n/a" ..S ALRTI=$P(ALRT," ") "RTN","ORWORB",75,0) ..S ALRTPT="" "RTN","ORWORB",76,0) ..S ALRTLOC="" "RTN","ORWORB",77,0) .. ; *596 ajb "RTN","ORWORB",78,0) . . I $E($P(ALRTXQA,";"),1,3)="TIU" D Q "RTN","ORWORB",79,0) . . . N ALRT,NODE,X,XTVDA,Y S XTVDA=$O(^XTV(8992.1,"B",ALRTXQA,0)) Q:'XTVDA "RTN","ORWORB",80,0) . . . S NODE=$G(^XTV(8992.1,XTVDA,1)) Q:NODE="" ; full text of alert data "RTN","ORWORB",81,0) . . . S $P(ALRT,U,2)=$P($P(NODE,U),":"),$P(ALRT,U,4)=$S(ALRT[" STAT ":"HIGH",1 :"Moderate") "RTN","ORWORB",82,0) . . . S X=$P(ALRTXQA,";",3),$P(Y,"/",1)=$E(X,4,5),$P(Y,"/",2)=$E(X,6,7),$P(Y," /",3)=(1700+$E(X,1,3)) "RTN","ORWORB",83,0) . . . S X=$E($P(X,".",2)_"0000",1,4),$P(Y,"@",2)=$E(X,1,2)_":"_$E(X,3,4),$P(AL "RTN","ORWORB",84,0) . . . S $P(ALRT,U,6)=$P($P(NODE,U),": ",2),$P(ALRT,U,8)=ALRTXQA,$P(ALRT,U,9)=R EM_U "RTN","ORWORB",85,0) . . . S J=J+1,^TMP("ORBG",$J,J)=ALRT "RTN","ORWORB",86,0) .. ; *596 ajb "RTN","ORWORB",87,0) ..I $P(ALRTXQA,",")="OR" D "RTN","ORWORB",88,0) ... N ALRTIEN,ORIEN,P04,ORPOUT "RTN","ORWORB",89,0) ... S ALRTIEN=$O(^XTV(8992.1,"B",ALRTXQA,0)) Q:ALRTIEN'>0 ; direct read ICR # 7063 "RTN","ORWORB",90,0) ... S ORIEN=+$G(^XTV(8992.1,ALRTIEN,2)) ; Q:ORIEN'>0 ; direct read ICR #7063 "RTN","ORWORB",91,0) ... S P04=$P($G(^OR(100,ORIEN,0)),U,4) I +P04 S ORPROV=$$GET1^DIQ(200,P04,.01) "RTN","ORWORB",92,0) ...S ORN=$P($P(ALRTXQA,";"),",",3) "RTN","ORWORB",93,0) "RTN","ORWORB",94,0) ...S ORURG=$S(URG=1:"HIGH",URG=2:"Moderate",1:"low") "RTN","ORWORB",95,0) ...S REM=$G(REMLIST(ORN)) "RTN","ORWORB",96,0) ...S ORN0=^ORD(100.9,ORN,0) "RTN","ORWORB",97,0) ...S ALRTI=$S(ORN=90:"L",$P(ORN0,U,6)="INFODEL":"I",1:"") "RTN","ORWORB",98,0) ...S ALRTDFN=$P(ALRTXQA,",",2) "RTN","ORWORB",99,0) ...S ALRTLOC=$G(^DPT(+$G(ALRTDFN),.1)) "RTN","ORWORB",100,0) ...I $$ISSMIEN^ORBSMART(ORN) D "RTN","ORWORB",101,0) ....N ORSMBY "RTN","ORWORB",102,0) ....D ALTDATA^PXRMCALT(.ORPOUT,ALRTDFN,ALRTXQA) "RTN","ORWORB",103,0) ....I $G(ORPOUT("DATA","RADIOLOGY REPORT FOUND"))=0 D DEL^ORB3FUP1(.ORSMBY,ALR TXQA,0) S ORRMVD=1 Q ....I $L($G(ORPOUT("DATA",1,"DIAGNOSIS")))>0 S ORBIRAD=$G(ORPOUT("DATA",1,"DIA GNOSIS")) "RTN","ORWORB",105,0) ..I ORRMVD Q "RTN","ORWORB",106,0) ..S ALRTI=$S(ALRTI="I":"I",ALRTI="L":"L",1:"") "RTN","ORWORB",107,0) ..I (ALRT["): ")!($G(ORN)=27&(ALRT[") CV")) D ;WAT "RTN","ORWORB",108,0) ...S ALRTPT=$P(ALRT,": ") "RTN","ORWORB",109,0) ...S ALRTPT=$E(ALRTPT,4,$L(ALRTPT)) "RTN","ORWORB",110,0) ...;S ALRTPT=$P(ALRTPT,PRE,2,99),ALRTPT=$$TRIM^XLFSTR(ALRTPT,"L") "RTN","ORWORB",111,0) ...I $G(ORN)=27&(ALRT[") CV") S ALRTMSG=$P($P(ALRT,U),": ",2) ;WAT "RTN","ORWORB",112,0) ...E S ALRTMSG=$P($P(ALRT,U),"): ",2) ;WAT "RTN","ORWORB",113,0) ...I $E(ALRTMSG,1,1)="[" D "RTN","ORWORB",114,0) "RTN","ORWORB",115,0) ....S ALRTMSG=$P(ALRTMSG,"] ",2) "RTN","ORWORB",116,0) ..I '$L($G(ALRTPT)) S ALRTPT="no patient" "RTN","ORWORB",117,0) ..S ALRTDT=$P(ALRTXQA,";",3) "RTN","ORWORB",118,0) ..S ALRTDT=$P(ALRTDT,".")_"."_$E($P(ALRTDT,".",2)_"0000",1,4) "RTN","ORWORB",119,0) ..S ALRTDT=$E(ALRTDT,4,5)_"/"_$E(ALRTDT,6,7)_"/"_($E(ALRTDT,1,3)+1700)_"@"_$E( $P(ALRTDT,".",2),1,2)_":"_$E($P(ALRTDT,".",2),3,4) "RTN","ORWORB",120,0) ..;if SMART alert, append BIRAD results to ALRTMSG "RTN","ORWORB",121,0) ..I $G(ORBIRAD)'="" S ALRTMSG=ALRTMSG_" - RESULTS: "_ORBIRAD "RTN","ORWORB",122,0) ..S J=J+1,^TMP("ORBG",$J,J)=ALRTI_U_ALRTPT_U_ALRTLOC_U_ORURG_U_ALRTDT_U "RTN","ORWORB",123,0) ..S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_ALRTMSG_U_U_ALRTXQA_U_$G(REM)_U "RTN","ORWORB",124,0) .I ORRMVD Q .;if alert forward info/comment: "RTN","ORWORB",126,0) .I $E(ALRTMSG,1,5)="-----" D "RTN","ORWORB",127,0) ..S ALRTMSG=$P(ALRTMSG,"-----",2) "RTN","ORWORB",128,0) ..I $E(ALRTMSG,1,14)=FWDBY D "RTN","ORWORB",129,0) ...S J=J+1,^TMP("ORBG",$J,J)=FWDBY_U_$P($P(ALRTMSG,FWDBY,2),"Generated: ")_$P( $P(ALRTMSG,FWDBY,2),"Generated: ",2) "RTN","ORWORB",130,0) ..E S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_""""_ALRTMSG_"""" "RTN","ORWORB",131,0) .;I $G(ORPROV)'="" S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_ORPROV ; ajb "RTN","ORWORB",132,0) .;if this is for processed alerts, add additional data into pieces 15 through 22 "RTN","ORWORB",133,0) .I $D(^TMP("ORB",$J,J,"PROCESSED")) D "RTN","ORWORB",134,0) ..S $P(^TMP("ORBG",$J,J),U,15)=^TMP("ORB",$J,J,"PROCESSED") .;if this is for pending alerts, add "surrogate for" into piece 15 "RTN","ORWORB",136,0) .I $G(FROMFAST) N ALRTIEN,DUZIEN,SURRFOR D "RTN","ORWORB",137,0) ..S ALRTIEN=$O(^XTV(8992.1,"B",ALRTXQA,0)) Q:'ALRTIEN "RTN","ORWORB",138,0) ..S DUZIEN=$O(^XTV(8992.1,ALRTIEN,20,"B",DUZ,"")) Q:'DUZIEN "RTN","ORWORB",139,0) ..S SURRFOR=+$G(^XTV(8992.1,ALRTIEN,20,DUZIEN,3,1,0)) ; get first "surrogate f or" and return returns 0 if empty "RTN","ORWORB",140,0) ..I SURRFOR S $P(^TMP("ORBG",$J,J),U,15)=$P(^VA(200,SURRFOR,0),U) "RTN","ORWORB",141,0) S ^TMP("ORBG",$J)="" "RTN","ORWORB",142,0) S ORY=$NA(^TMP("ORBG",$J)) "RTN","ORWORB",143,0) K ^TMP("ORB",$J) "RTN","ORWORB",144,0) Q "RTN","ORWORB",145,0) "RTN","ORWORB",146,0) GETDATA(ORY,XQAID,PFLAG) ; return XQADATA for an alert "RTN","ORWORB",147,0) N SHOWADD "RTN","ORWORB",148,0) S ORY="" "RTN","ORWORB",149,0) Q:$G(XQAID)=""!('$D(^XTV(8992,"AXQA",XQAID))) "RTN","ORWORB",150,0) I +$G(PFLAG) S XQADATA=$$GETACT2(XQAID) I 1 "RTN","ORWORB",151,0) E D GETACT^XQALERT(XQAID) "RTN","ORWORB",152,0) S ORY=XQADATA "RTN","ORWORB",153,0) I ($E(XQAID,1,3)="TIU"),(+ORY>0) D "RTN","ORWORB",154,0) . S SHOWADD=1 "RTN","ORWORB",155,0) . S ORY=ORY_$$RESOLVE^TIUSRVLO(+ORY) "RTN","ORWORB",156,0) "RTN","ORWORB",157,0) Q "RTN","ORWORB",158,0) ; "RTN","ORWORB",159,0) GETACT2(ALERTID) ; Returns first XQADATA found, for alerts for other users "RTN","ORWORB",160,0) N XQADATA,XDUZ,XQI,XQX,XQZ,DONE "RTN","ORWORB",161,0) S XQADATA="",XDUZ="",DONE=0 "RTN","ORWORB",162,0) F Q:DONE S XDUZ=$O(^XTV(8992,"AXQA",ALERTID,XDUZ)) Q:'XDUZ D "RTN","ORWORB",163,0) . S XQI=$O(^XTV(8992,"AXQA",ALERTID,XDUZ,0)) "RTN","ORWORB",164,0) . Q:XQI'>0 "RTN","ORWORB",165,0) . S XQX=$G(^XTV(8992,XDUZ,"XQA",XQI,0)) Q:XQX="" "RTN","ORWORB",166,0) . S XQZ=$G(^XTV(8992,XDUZ,"XQA",XQI,1)) "RTN","ORWORB",167,0) "RTN","ORWORB",168,0) . I XQADATA'="" S DONE=1 "RTN","ORWORB",169,0) Q XQADATA "RTN","ORWORB",170,0) ; "RTN","ORWORB",171,0) KILUNSNO(Y,ORVP) ; Delete unsigned order alerts if no unsigned orders remaining "RTN","ORWORB",172,0) S ORVP=ORVP_";DPT(" "RTN","ORWORB",173,0) D UNOTIF^ORCSIGN "RTN","ORWORB",174,0) Q "RTN","ORWORB",175,0) ; "RTN","ORWORB",176,0) UNFLORD(ORY,DFN,XQAID) ; -- auto-unflag orders?/delete alert "RTN","ORWORB",177,0) Q "RTN","ORWORB",178,0) "RTN","ORWORB",179,0) ;Q:'$L(DFN)!('$L(XQAID)) "RTN","ORWORB",180,0) ;N ORI,ORIFN,ORA,XQAKILL,ORN,ORBY,ORAUTO,ORUNF "RTN","ORWORB",181,0) ;S ORN=+$O(^ORD(100.9,"B","FLAGGED ORDERS",0)) "RTN","ORWORB",182,0) ;;S XQAKILL=$$XQAKILL^ORB3F1(ORN) "RTN","ORWORB",183,0) ;D LIST^ORQOR1(.ORBY,DFN,"ALL",12,"","") "RTN","ORWORB",184,0) ;S ORAUTO=+$$GET^XPAR("ALL","ORPF AUTO UNFLAG") "RTN","ORWORB",185,0) ;S ORI=0 F S ORI=$O(ORBY(ORI)) Q:ORI'>0 D "RTN","ORWORB",186,0) ;. I ORAUTO D ; unflag "RTN","ORWORB",187,0) ;. . ;DJE-VM *329 - use GUI RPC call to make it run the proper code, only run it if the user sees it. "RTN","ORWORB",188,0) ;. . ;S ORUNF=+$E($$NOW^XLFDT,1,12)_U_DUZ_"^Auto-Unflagged" ;. . ;S ORIFN=$P(ORBY(ORI),U),ORA=+$P(ORIFN,";",2) "RTN","ORWORB",190,0) ;. . ;I ORIFN,$D(^OR(100,+ORIFN,0)) S $P(^(8,ORA,3),U)=0,$P(^(3),U,6,8)=ORUNF D MSG^ORCFLAG(ORIFN) ; unflag "RTN","ORWORB",191,0) ;. . S ORIFN=+ORBY(ORI) "RTN","ORWORB",192,0) ;. . I $D(^OR(100,ORIFN,0)),'$$FLAGRULE^ORWORR1(ORIFN) D UNFLAG^ORWDXA(.ORUNF, $P(ORBY(ORI),U),"Auto-Unflagged") "RTN","ORWORB",193,0) ;;DJE-VM *329 - ORWDXA is smarter and deletes the appropriate alert(s) "RTN","ORWORB",194,0) ;;I (ORAUTO)!(+$G(ORBY(1))=0) D DELETE^XQALERT "RTN","ORWORB",195,0) ;Q "RTN","ORWORB",196,0) KILEXMED(Y,ORDFN) ; -- Delete expiring meds notification if no expiring meds r emaining "RTN","ORWORB",197,0) N ORDG,ORLST,OROI,LIST S ORDG=$$DG^ORQOR1("RX") "RTN","ORWORB",198,0) "RTN","ORWORB",199,0) S LIST("INPT")=1 "RTN","ORWORB",200,0) S LIST("OUTPT")=1 "RTN","ORWORB",201,0) D AGET^ORWORR(.ORLST,ORDFN,5,ORDG) "RTN","ORWORB",202,0) ;selected code copied from EXPIR^ORB3TIM2 "RTN","ORWORB",203,0) I +(@ORLST@(.1)) D ;if there are orders "RTN","ORWORB",204,0) . K LIST("OUTPT") "RTN","ORWORB",205,0) . S OROI=.5 "RTN","ORWORB",206,0) . N ORSCHFIL,ORBZ "RTN","ORWORB",207,0) . S ORSCHFIL=$$TERMLKUP^ORB31(.ORBZ,"ONE TIME MED") "RTN","ORWORB",208,0) . F S OROI=$O(@ORLST@(OROI)) Q:'OROI D Q:'$G(LIST("INPT")) "RTN","ORWORB",209,0) "RTN","ORWORB",210,0) .. ;skip outpt meds "RTN","ORWORB",211,0) .. Q:$$DGRX^ORQOR2(EXORN)="OUTPATIENT MEDICATIONS" "RTN","ORWORB",212,0) .. ;skip one time meds "RTN","ORWORB",213,0) .. N ONETIME,ORSCH,ORBI S ONETIME=0 "RTN","ORWORB",214,0) .. I $D(ORBZ),(+$G(ORSCHFIL)=51.1) F ORBI=1:1:ORBZ D "RTN","ORWORB",215,0) ... S ORSCH=$P(ORBZ(ORBI),U,2) "RTN","ORWORB",216,0) ... I ORSCH=$$VALUE^ORCSAVE2(EXORN,"SCHEDULE") S ONETIME=1 Q "RTN","ORWORB",217,0) .. Q:+$G(ONETIME)=1 "RTN","ORWORB",218,0) .. ;don't delete notification if there are valid inpt orders "RTN","ORWORB",219,0) .. K LIST("INPT") "RTN","ORWORB",220,0) "RTN","ORWORB",221,0) F S OROI=$O(LIST(OROI)) Q:'$L(OROI) D "RTN","ORWORB",222,0) .S ORNIFN=$O(^ORD(100.9,"B","MEDICATIONS EXPIRING - "_OROI,0)),ORVP=ORDFN_";DP T(" "RTN","ORWORB",223,0) .Q:'$L($G(ORNIFN)) "RTN","ORWORB",224,0) .S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) ; expiring meds notif "RTN","ORWORB",225,0) .I $D(XQAID) D DELETE^XQALERT "RTN","ORWORB",226,0) .I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID "RTN","ORWORB",227,0) Q "RTN","ORWORB",228,0) KILEXOI(Y,ORDFN,ORNIFN) ; -- Delete expiring flagged OI notification if no fla gged expiring OI remaining "RTN","ORWORB",229,0) N ORDG,ORLST S ORDG=$$DG^ORQOR1("ALL") D AGET^ORWORR(.ORLST,ORDFN,5,ORDG) "RTN","ORWORB",231,0) Q:+(@ORLST@(.1)) ;more left "RTN","ORWORB",232,0) N XQAKILL,ORVP "RTN","ORWORB",233,0) S ORVP=ORDFN_";DPT(" "RTN","ORWORB",234,0) S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) ; flagged expiring OI notifications "RTN","ORWORB",235,0) I $D(XQAID) D DELETE^XQALERT "RTN","ORWORB",236,0) I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D D ELETEA^XQALERT K XQAID "RTN","ORWORB",237,0) Q "RTN","ORWORB",238,0) KILUNVOR(Y,ORDFN) ; -- Delete UNVERIFIED ORDER notification if none remaining within current admission/30 days "RTN","ORWORB",239,0) N DFN,ORDG,ORLST,ORBDT,OREDT,ORDDT,VAIN,VAERR,VA200 S ORDG=$$DG^ORQOR1("ALL") S OREDT=$$NOW^XLFDT "RTN","ORWORB",241,0) S ORDDT=$$FMADD^XLFDT(OREDT,"-90") "RTN","ORWORB",242,0) ;get current admission date/time: "RTN","ORWORB",243,0) S DFN=ORDFN,VA200="" D INP^VADPT "RTN","ORWORB",244,0) S ORBDT=$P($G(VAIN(7)),U) "RTN","ORWORB",245,0) S ORBDT=$S('$L($G(ORBDT)):$$FMADD^XLFDT(OREDT,"-30"),1:ORBDT) ;<= if no admis sion use past 30 days "RTN","ORWORB",246,0) S ORBDT=$S(ORDDT>ORBDT:ORDDT,1:ORBDT) ;max past days to use is 90 days "RTN","ORWORB",247,0) D AGET^ORWORR(.ORLST,ORDFN,9,ORDG,ORBDT,OREDT) "RTN","ORWORB",248,0) Q:+(@ORLST@(.1)) ;more left "RTN","ORWORB",249,0) N XQAKILL,ORVP,ORNIFN "RTN","ORWORB",250,0) "RTN","ORWORB",251,0) S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) "RTN","ORWORB",252,0) I $D(XQAID) D DELETE^XQALERT "RTN","ORWORB",253,0) I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D D ELETEA^XQALERT K XQAID "RTN","ORWORB",254,0) Q "RTN","ORWORB",255,0) KILUNVMD(Y,ORDFN) ; -- Delete UNVERIFIED MEDS notification if none remaining w ithin current admission/30 days "RTN","ORWORB",256,0) N DFN,ORDG,ORLST,ORBDT,OREDT,ORDDT S ORDG=$$DG^ORQOR1("RX") "RTN","ORWORB",257,0) S OREDT=$$NOW^XLFDT "RTN","ORWORB",258,0) S ORDDT=$$FMADD^XLFDT(OREDT,"-90") "RTN","ORWORB",259,0) ;get current admission date/time: "RTN","ORWORB",260,0) "RTN","ORWORB",261,0) S ORBDT=$P($G(VAIN(7)),U) "RTN","ORWORB",262,0) S ORBDT=$S('$L($G(ORBDT)):$$FMADD^XLFDT(OREDT,"-30"),1:ORBDT) ;<= if no admis sion use past 30 days "RTN","ORWORB",263,0) S ORBDT=$S(ORDDT>ORBDT:ORDDT,1:ORBDT) ;max past days to use is 90 days "RTN","ORWORB",264,0) D AGET^ORWORR(.ORLST,ORDFN,9,ORDG,ORBDT,OREDT) "RTN","ORWORB",265,0) Q:+(@ORLST@(.1)) ;more left "RTN","ORWORB",266,0) N XQAKILL,ORVP,ORNIFN "RTN","ORWORB",267,0) S ORNIFN=$O(^ORD(100.9,"B","UNVERIFIED MEDICATION ORDER",0)),ORVP=ORDFN_";DPT( " "RTN","ORWORB",268,0) S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) "RTN","ORWORB",269,0) I $D(XQAID) D DELETE^XQALERT "RTN","ORWORB",270,0) ELETEA^XQALERT K XQAID "RTN","ORWORB",271,0) Q "RTN","ORWORB",272,0) ESORD(ORY,XQAID) ;order(s) requiring electronic signature follow-up "RTN","ORWORB",273,0) K XQAKILL "RTN","ORWORB",274,0) N ORPT,ORDG,ORBXQAID,ORY,ORX,ORZ,ORDERS,ORDNUM,ORQUIT,ORBLMDEL "RTN","ORWORB",275,0) S ORBXQAID=XQAID,ORDERS=0,ORQUIT=0 "RTN","ORWORB",276,0) S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid "RTN","ORWORB",277,0) S ORDG=$$DG^ORQOR1("ALL") "RTN","ORWORB",278,0) ;the FLG code for UNSIGNED orders in ORQ1 is '11' "RTN","ORWORB",279,0) ;get unsigned orders - if none exist, delete alert then quit: "RTN","ORWORB",280,0) D EN^ORQ1(ORPT_";DPT(",ORDG,11,"","","",0,0) S ORX="",ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX="" I +$G(^TMP("ORR",$J,ORX,"TOT"))< 1 D DEL^ORB3FUP1(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q "RTN","ORWORB",282,0) ; "RTN","ORWORB",283,0) ;user does not have ORES key, delete user's alert: "RTN","ORWORB",284,0) I '$D(^XUSEC("ORES",DUZ)) S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) K ^TMP("OR R",$J) Q "RTN","ORWORB",285,0) ; "RTN","ORWORB",286,0) ;if prov is NOT linked to pt via attending, primary or teams: "RTN","ORWORB",287,0) I $$PPLINK^ORQPTQ1(DUZ,ORPT)=0 D "RTN","ORWORB",288,0) .S ORX="" F S ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX=""!(ORDERS=1) D "RTN","ORWORB",289,0) ..S ORZ="" F S ORZ=$O(^TMP("ORR",$J,ORX,ORZ)) Q:+ORZ=0!(ORDERS=1) D "RTN","ORWORB",290,0) ...S ORDNUM=^TMP("ORR",$J,ORX,ORZ) ...;quit if this unsigned order's last action was made by the user "RTN","ORWORB",292,0) ...I DUZ=+$$UNSIGNOR^ORQOR2(ORDNUM) S ORDERS=1 "RTN","ORWORB",293,0) .I ORDERS'=1 D ;provider has no outstanding unsigned orders for pt "RTN","ORWORB",294,0) ..S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) ;delete alert for this user "RTN","ORWORB",295,0) K ^TMP("ORR",$J) "RTN","ORWORB",296,0) Q "RTN","ORWORB",297,0) ; "RTN","ORWORB",298,0) TXTFUP(ROOT,DFN,NOTIF,XQADATA) ; Follow-up for text messages "RTN","ORWORB",299,0) ; "RTN","ORWORB",300,0) I NOTIF=67 D CHGRAD "RTN","ORWORB",301,0) Q ; "RTN","ORWORB",303,0) CHGRAD ;GUI follow-up for Imaging Request Changed (#67) "RTN","ORWORB",304,0) S ROOT=$NA(^TMP($J,"RAE4")) "RTN","ORWORB",305,0) K @ROOT "RTN","ORWORB",306,0) D SET1^RAO7PC4 ;DBIA #3563 "RTN","ORWORB",307,0) Q "RTN","ORWORB",308,0) ; "RTN","ORWORB",309,0) GETSORT(ORY) ;return notification sort method^direction for user/division/syste m/pkg "RTN","ORWORB",310,0) S ORY=$$GET^XPAR("ALL","ORB SORT METHOD",1,"I")_U_$$GET^XPAR("ALL","ORB SORT D IRECTION",1,"I") "RTN","ORWORB",311,0) Q ; "RTN","ORWORB",313,0) SETSORT(ORERR,SORT,DIR) ;set notification sort method^direction for user "RTN","ORWORB",314,0) D EN^XPAR(DUZ_";VA(200,","ORB SORT METHOD",1,SORT,.ORERR) "RTN","ORWORB",315,0) I $L($G(DIR)) D EN^XPAR(DUZ_";VA(200,","ORB SORT DIRECTION",1,DIR,.ORERR) "RTN","ORWORB",316,0) Q "RTN","ORX1") 0^10^B28462850 "RTN","ORX1",1,0) ORX1 ; slc/dcm - OE/RR Nature of Order entry points ;12/26/96 09:49 "RTN","ORX1",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,242**;Dec 17, 1997;Build 0 "RTN","ORX1",3,0) ; "RTN","ORX1",4,0) NA(DEFAULT,REQUIRD,FB,DIRA,DC,LIST) ;Function to get Nature of order "RTN","ORX1",5,0) ;DEFAULT [not required] =Free text code or pointer to Nature of order (file 10 "RTN","ORX1",6,0) ; Used for default response. "RTN","ORX1",7,0) ;REQUIRD [not required] =1 to require a response from user, "RTN","ORX1",8,0) ; =0 (default) not to require response. "RTN","ORX1",9,0) ;FB [not required] =F for frontdoor, "RTN","ORX1",10,0) ; =B (default) for backdoor. "RTN","ORX1",11,0) ; Screens on Frontdoor/Backdoor types. "RTN","ORX1",12,0) ; Nature of order entries are setup to be available for "RTN","ORX1",13,0) ; frontdoor or backdoor processing. "RTN","ORX1",14,0) ;DIRA [not required] =prompt for DIR("A") "RTN","ORX1",15,0) ; default:"Reason for Order/Change" "RTN","ORX1",16,0) "RTN","ORX1",17,0) ; =0 (default) includes all other types except for 'DC only'. "RTN","ORX1",18,0) ;LIST [not required] =List of 'Nature of Order' codes (from file 100.02) "RTN","ORX1",19,0) ; allowed. If this is passed, then DC and FB params "RTN","ORX1",20,0) ; are ignored. Format: code1code2code3 "RTN","ORX1",21,0) ;Example: S X=$$NA^ORX1(1,1,,,,"WVPIS") "RTN","ORX1",22,0) ;Returned value: ifn^name^code "RTN","ORX1",23,0) N DIR,X,Y,DIRUT,DUOUT "RTN","ORX1",24,0) S DIR("?",1)="This order/change will be recorded in the patient's electronic r ecord." "RTN","ORX1",25,0) S DIR("?",2)="Depending on the nature of this activity, a notification may be sent to the" "RTN","ORX1",26,0) opy of this" "RTN","ORX1",27,0) S DIR("?",4)="action may be printed on the ward/clinic to be placed in the pat ient's chart." "RTN","ORX1",28,0) S DIR("?",5)="" "RTN","ORX1",29,0) S DIR("?",6)=" Enter '??' for more information." "RTN","ORX1",30,0) S DIR("?")=" " "RTN","ORX1",31,0) S DIR("A")=$S($L($G(DIRA)):DIRA,1:"Reason for Order/Change") "RTN","ORX1",32,0) I '$G(DEFAULT),$L($G(DEFAULT)),$O(^ORD(100.02,"C",DEFAULT,0)) S DEFAULT=$O(^(0 )) "RTN","ORX1",33,0) I $G(DEFAULT) S DIR("B")=$S($D(^ORD(100.02,+DEFAULT,0)):$S('$L($G(LIST)):$P(^( 0),"^"),1:$S($L($G(LIST))&($G(LIST)[$P(^(0),"^",2)):$P(^(0),"^"),1:""),1:""),1: "") K:DIR("B")="" DIR("B") "RTN","ORX1",34,0) S DIR(0)="P^100.02:EMZ" S:'$D(FB) FB="B" S:FB="" FB="B" S:'$D(DC) DC=0 "RTN","ORX1",36,0) I $L($G(LIST)) S DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),LIST[$P(^(0), ""^"",2)" "RTN","ORX1",37,0) I '$L($G(LIST)) S DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),('$P(^(0),"" ^"",6)!(DC)),"_$S(FB="B":"""XB""[$P(^(0),""^"",5)",FB="F":"""XF""[$P(^(0),""^"" ,5)",1:0) "RTN","ORX1",38,0) S DIR("S")=DIR("S")_",'$$SCREEN^XTID(100.02,,Y_"","")" ;inactive VUID "RTN","ORX1",39,0) S DIR("??")="^D NA1^ORX1(DIR(""S""))" "RTN","ORX1",40,0) OT2 D ^DIR "RTN","ORX1",41,0) I 'Y,$G(REQUIRD)=1 W !,"A "_$S($L($G(DIRA)):DIRA,1:"NATURE OF ORDER/CHANGE")_" must be entered",$C(7),! G OT2 "RTN","ORX1",42,0) I Y S $P(Y,"^",3)=$P(^ORD(100.02,+Y,0),"^",2) "RTN","ORX1",43,0) Q Y NA1(SCREEN) ;Executable help for Nature of order "RTN","ORX1",45,0) ;SCREEN=Mumps code that is used like DIC("S") to screen out entries "RTN","ORX1",46,0) N X,X1,Y "RTN","ORX1",47,0) W !?30," Require",?43," Print",?56,"Print on" "RTN","ORX1",48,0) W !?2,"Nature of Order Activity",?29,"E.Signature",?43,"Chart Copy",?56,"Summa ry" "RTN","ORX1",49,0) W !?2,"------------------------",?29,"-----------",?43,"----------",?56,"----- ---" "RTN","ORX1",50,0) S Y=0 F S Y=$O(^ORD(100.02,Y)) Q:Y<1 I $D(^(Y,0)) X:$D(SCREEN) SCREEN I $T S X=^ORD(100.02,Y,0),X1=$G(^(1)) W !,?2,$P(X,"^"),?34,$S($P(X1,"^",4)=2:"x",1:"" ),?47,$S($P(X1,"^",2):"x",1:""),?59,$S($P(X1,"^",3):"x",1:"") "RTN","ORX1",51,0) Q "RTN","ORX1",52,0) NA2(SCREEN) ;Get help for DC Reasons ;SCREEN=Mumps code that is used like DIC("S") to screen out entries "RTN","ORX1",54,0) N X,X1,I "RTN","ORX1",55,0) W !?30," Require",?43," Print",?56,"Print on" "RTN","ORX1",56,0) W !,"Order Reason",?29,"E.Signature",?43,"Chart Copy",?56,"Summary" "RTN","ORX1",57,0) W !,"------------",?29,"-----------",?43,"----------",?56,"--------" "RTN","ORX1",58,0) S I=0 F S I=$O(^ORD(100.03,I)) Q:I<1 I $D(^(I,0)) X:$D(SCREEN) SCREEN I $T S X=^(0) I $P(X,"^",7),$D(^ORD(100.02,$P(X,"^",7),0)) W !,$P(X,"^") S X=^(0),X1= $G(^(1)) D "RTN","ORX1",59,0) . W ?34,$S($P(X1,"^",4)=2:"x",1:""),?47,$S($P(X1,"^",2):"x",1:""),?59,$S($P(X1 ,"^",3):"x",1:"") "RTN","ORX1",60,0) Q "RTN","ORX1",61,0) ; "RTN","ORX1",62,0) "RTN","ORX1",63,0) N Y Q:'$L($G(X)) 0 "RTN","ORX1",64,0) I 'X S X=+$O(^ORD(100.02,"C",X,0)) "RTN","ORX1",65,0) S Y=+$P($G(^ORD(100.02,+X,1)),U) "RTN","ORX1",66,0) Q Y "RTN","ORX1",67,0) ; "RTN","ORX1",68,0) SIGSTS(X) ; -- Returns default signature status for nature X "RTN","ORX1",69,0) N Y S Y="" G:'$L($G(X)) SIGQ "RTN","ORX1",70,0) I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X SIGQ "RTN","ORX1",71,0) S Y=$P($G(^ORD(100.02,+X,1)),U,4) "RTN","ORX1",72,0) SIGQ Q Y "RTN","ORX1",73,0) "RTN","ORX1",74,0) CHART(X) ; -- Returns 1 or 0, print chart copy for nature X "RTN","ORX1",75,0) N Y S Y="" G:'$L($G(X)) CHQ "RTN","ORX1",76,0) I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X CHQ "RTN","ORX1",77,0) S Y=$P($G(^ORD(100.02,+X,1)),U,2) "RTN","ORX1",78,0) CHQ Q Y "RTN","ORX1",79,0) ; "RTN","ORX1",80,0) ACTV(X) ; -- Returns 1 or 0, include action in Active Orders "RTN","ORX1",81,0) N Y S Y="" G:'$L($G(X)) ACTQ "RTN","ORX1",82,0) I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X ACTQ "RTN","ORX1",83,0) S Y=$P($G(^ORD(100.02,+X,1)),U,6) "RTN","ORX1",84,0) "RTN","ORX1",85,0) ; "RTN","ORX1",86,0) DC(DEFAULT,REQ,PKG,DIRA) ;Function to get a DC Reason "RTN","ORX1",87,0) ;DEFAULT=ifn of default reason "RTN","ORX1",88,0) ;REQ=1 to require a response "RTN","ORX1",89,0) ;PKG=ptr to file 9.4 to only get reasons for a specific package "RTN","ORX1",90,0) ;DIRA=Default prompt to be used instead of DIR("A") "RTN","ORX1",91,0) N DIR,X,Y,DIRUT,DUOUT "RTN","ORX1",92,0) S DIR("?",1)="This order/change will be recorded in the patient's electronic r ecord." "RTN","ORX1",93,0) S DIR("?",2)="Depending of the nature of this activity, a notification may be sent to the" "RTN","ORX1",94,0) opy of this" "RTN","ORX1",95,0) S DIR("?",4)="action may be printed on the ward/clinic to be placed in the pat ient's chart." "RTN","ORX1",96,0) S DIR("?",5)="" "RTN","ORX1",97,0) S DIR("?")=" " "RTN","ORX1",98,0) S DIR("A")="Reason" I $L($G(DIRA)) S DIR("A")=DIRA "RTN","ORX1",99,0) I $G(DEFAULT) S DIR("B")=$S($G(DEFAULT):$S($D(^ORD(100.03,+DEFAULT,0)):$P(^(0) ,"^"),1:""),1:"") "RTN","ORX1",100,0) S DIR(0)="P^100.03:EMZ" "RTN","ORX1",101,0) S DIR("S")="I '$P(^(0),""^"",4)"_$S($G(PKG):",$P(^(0),""^"",5)=PKG",1:"") "RTN","ORX1",102,0) S DIR("??")="^D NA2^ORX1(DIR(""S""))" "RTN","ORX1",103,0) OT1 D ^DIR I 'Y,$G(REQ)=1 W !,"A REASON FOR DC must be entered",$C(7),! G OT1 "RTN","ORX1",105,0) Q $S(Y:+Y_"^"_$G(Y(0)),1:Y) "RTN","ORX1",106,0) ; "RTN","ORX1",107,0) EDITDCR ; -- Edit DC Reason "RTN","ORX1",108,0) N X,Y,D,DIC,DIE,DR,DA,DLAYGO W ! "RTN","ORX1",109,0) EDC1 S DIC=100.03,DIC(0)="AELNQM",DIC("A")="Select DC REASON: ",DLAYGO=100.03 "RTN","ORX1",110,0) S DIC("S")="I $P(^(0),U,5)="_+$O(^DIC(9.4,"C","OR",0)),D="B^S" "RTN","ORX1",111,0) S DIC("DR")=".05////"_+$O(^DIC(9.4,"C","OR",0)) D MIX^DIC1 Q:Y'>0 "RTN","ORX1",112,0) S DA=+Y,DIE=DIC,DR=".01;.03;.04;.07" D ^DIE "RTN","ORX1",113,0) W ! G EDC1 "RTN","ORX1",114,0) Q ; "RTN","ORX1",116,0) EDITNAT ; -- Edit allowable Nature of Order fields "RTN","ORX1",117,0) N X,Y,DA,DR,DIE,DIC W ! "RTN","ORX1",118,0) EDN S DIC="^ORD(100.02,",DIC(0)="AEQM",DIC("A")="Select NATURE OF ORDER: " "RTN","ORX1",119,0) S DIC("S")="I '$P(^(0),""^"",4),'$$SCREEN^XTID(100.02,,Y_"","")" ;inactive VUI D "RTN","ORX1",120,0) D ^DIC Q:Y<1 "RTN","ORX1",121,0) S DA=+Y,DIE=DIC,DR=".12;.13;.15;.16" D ^DIE "RTN","ORX1",122,0) W ! G EDN "RTN","ORX1",123,0) Q "RTN","ORY535") 1^11 "RTN","ORY5350") "RTN","ORY53501") 1^13 "RTN","ORY53502") 1^14 "RTN","ORY53503") 1^15 "RTN","ORY53504") 1^16 "RTN","ORY53505") 1^17 "RTN","ORY53506") 1^18 "RTN","ORY53507") 1^19 "RTN","ORY53508") 1^20 "RTN","ORY5351") 1^21 "RTN","ORY5352") 1^22 "RTN","ORY5353") "RTN","ORY5354") 1^24 "RTN","ORY535ES") 1^25 "RTN","ORY535R") 0^^B47784812 "RTN","ORY535R",1,0) ORY535R ;ISL/TDP - Restore-install for patch OR*3*535 ;Sep 12, 2024@13:35:57 "RTN","ORY535R",2,0) ;;3.0;ORDER ENTRY/RESULTS REPORTING;**535**;Dec 17, 1997;Build 20 "RTN","ORY535R",3,0) ; "RTN","ORY535R",4,0) CLRINDX ;Delete the "B" index of file 100.04 "RTN","ORY535R",5,0) N DIK "RTN","ORY535R",6,0) D BMES^XPDUTL("Clearing 'B' indexes for file 100.04") "RTN","ORY535R",7,0) S DIK="^ORD(100.04,",DIK(1)=".01" "RTN","ORY535R",8,0) "RTN","ORY535R",9,0) D MES^XPDUTL(" Completed!") "RTN","ORY535R",10,0) Q "RTN","ORY535R",11,0) ; "RTN","ORY535R",12,0) RSTR ; Initiate restore processes "RTN","ORY535R",13,0) D ACTIV("METFORMIN EGFR - LAB RESULTS",1,0) "RTN","ORY535R",14,0) D ACTIV("GLUCOPHAGE - LAB RESULTS",0,0) "RTN","ORY535R",15,0) D RENAME("^OCXS(860.3,","METFORMIN ORDER","GLUCOPHAGE ORDER") "RTN","ORY535R",16,0) D RECOMPILE "RTN","ORY535R",17,0) D RMVLCL "RTN","ORY535R",18,0) D RMVB "RTN","ORY535R",19,0) "RTN","ORY535R",20,0) D REINDEX "RTN","ORY535R",21,0) ;D RMVPARAM ;Unable to remove entries as the parameter is removed before this routine is run. "RTN","ORY535R",22,0) Q "RTN","ORY535R",23,0) ; "RTN","ORY535R",24,0) ACTIV(ORCHKRL,ORACTIV,PST) ; Inactivate Order Check Rule "RTN","ORY535R",25,0) ; ORCHKRL = Name of Order Check Rule in file 860.2 "RTN","ORY535R",26,0) ; ORACTIV = Status of Order Check Rule. 0 = Active, 1 = Inactive, No value def aults to Active "RTN","ORY535R",27,0) ; PST = Indicates METFORMIN EGFR - LAB RESULTS from Post-init code (1 = yes, 0 = no) "RTN","ORY535R",28,0) N ORACT,ORACT1,ORCHKRLIEN Q:$G(ORCHKRL)="" "RTN","ORY535R",30,0) S ORACTIV=+$G(ORACTIV) D "RTN","ORY535R",31,0) . I ORACTIV=1 S ORACT="Inactivating ",ORACT1="inactivated." "RTN","ORY535R",32,0) . E S ORACT="Activating ",ORACT1="activated." "RTN","ORY535R",33,0) S ORCHKRLIEN=$O(^OCXS(860.2,"B",ORCHKRL,0)) "RTN","ORY535R",34,0) I 'ORCHKRLIEN D Q "RTN","ORY535R",35,0) . I PST Q ;METFORMIN EGFR - LAB RESULTS won't exist yet on initial install "RTN","ORY535R",36,0) . D BMES^XPDUTL(" "_ORCHKRL_" does not exist in the ORDER CHECK") "RTN","ORY535R",37,0) . D MES^XPDUTL(" RULE (#860.2) file.") "RTN","ORY535R",38,0) . Q "RTN","ORY535R",39,0) I +$G(^OCXS(860.2,ORCHKRLIEN,"INACT"))=ORACTIV D Q . D BMES^XPDUTL(" "_ORCHKRL_" is already "_ORACT1_" ABORTING action!") "RTN","ORY535R",41,0) . Q "RTN","ORY535R",42,0) D BMES^XPDUTL(ORACT_ORCHKRL_" in the ORDER CHECK") "RTN","ORY535R",43,0) D MES^XPDUTL(" RULE (#860.2) file.") "RTN","ORY535R",44,0) S ^OCXS(860.2,ORCHKRLIEN,"INACT")=ORACTIV "RTN","ORY535R",45,0) D BMES^XPDUTL(" "_ORCHKRL_" has been "_ORACT1) "RTN","ORY535R",46,0) Q "RTN","ORY535R",47,0) ; "RTN","ORY535R",48,0) RENAME(FILE,OROLD,ORNEW) ; Rename file entry "RTN","ORY535R",49,0) N CNT,DA,DIC,DIE,DO,DR,FILENM,TEXT,X,Y "RTN","ORY535R",50,0) Q:$G(FILE)="" Q:$G(OROLD)="" "RTN","ORY535R",52,0) Q:$G(ORNEW)="" "RTN","ORY535R",53,0) S (DIC,DIE)=FILE "RTN","ORY535R",54,0) S DIC(0)="X" "RTN","ORY535R",55,0) S X=OROLD "RTN","ORY535R",56,0) D ^DIC Q:Y<1 "RTN","ORY535R",57,0) S DA=+Y "RTN","ORY535R",58,0) I 'DA Q "RTN","ORY535R",59,0) S DIE="^OCXS(860.3,",DR=".01///"_ORNEW "RTN","ORY535R",60,0) D ^DIE "RTN","ORY535R",61,0) S FILENM=FILE S DO="" "RTN","ORY535R",63,0) D DO^DIC1 "RTN","ORY535R",64,0) I DO(2)'=-1 D "RTN","ORY535R",65,0) . S FILENM=$P(DO,U,1)_" (#"_$P(DO,U,2)_")" "RTN","ORY535R",66,0) S CNT=1 "RTN","ORY535R",67,0) S TEXT(CNT)="Renamed "_FILENM_" file entry "_OROLD_" to "_ORNEW_"." "RTN","ORY535R",68,0) I $L(TEXT(CNT))>66 D "RTN","ORY535R",69,0) . N DONE "RTN","ORY535R",70,0) . S DONE=0 "RTN","ORY535R",71,0) . S X=$L(TEXT(CNT)) "RTN","ORY535R",72,0) . F Y=66:-1:1 D Q:DONE .. I $E(TEXT(CNT),Y)'=" " Q "RTN","ORY535R",74,0) .. S TEXT(CNT+1)=$E(TEXT(CNT),Y+1,X) "RTN","ORY535R",75,0) .. S TEXT(CNT)=$E(TEXT(CNT),1,Y) "RTN","ORY535R",76,0) .. S CNT=CNT+1 "RTN","ORY535R",77,0) .. I $L(TEXT(CNT))<66 S DONE=1 "RTN","ORY535R",78,0) S CNT=1 "RTN","ORY535R",79,0) D BMES^XPDUTL($G(TEXT(CNT))) "RTN","ORY535R",80,0) F S CNT=$O(TEXT(CNT)) Q:+CNT=0 D MES^XPDUTL(" "_$G(TEXT(CNT))) "RTN","ORY535R",81,0) Q "RTN","ORY535R",82,0) RMVB ;Remove the bad "B" new-style field index in the NAME (#.01) field "RTN","ORY535R",83,0) ; of the ORDER CHECK OVERRIDE REASONS (#100.04) file N MSG,OUTPUT "RTN","ORY535R",85,0) D BMES^XPDUTL("Deleting New-Style ""B"" index from the Data Dictionary for the ") "RTN","ORY535R",86,0) D MES^XPDUTL("NAME (#.01) field in the ORDER CHECK OVERRIDE REASONS (#100.04) file ...") "RTN","ORY535R",87,0) D MES^XPDUTL("") "RTN","ORY535R",88,0) D DELIXN^DDMOD(100.04,"B","KW","OUTPUT","MSG") "RTN","ORY535R",89,0) I $D(MSG("DIERR")) D Q "RTN","ORY535R",90,0) . N ERRCODE,ERRTXT,X,Y "RTN","ORY535R",91,0) . D MES^XPDUTL(" An error occurred while deleting the New-Style ""B"" field index!!!") "RTN","ORY535R",92,0) . S X=0 "RTN","ORY535R",93,0) "RTN","ORY535R",94,0) .. S ERRCODE=+$G(MSG("DIERR",X)) "RTN","ORY535R",95,0) .. I ERRCODE>0 D MES^XPDUTL(" ERROR CODE: "_ERRCODE) "RTN","ORY535R",96,0) .. S Y=0 "RTN","ORY535R",97,0) .. F S Y=$O(MSG("DIERR",X,"TEXT",Y)) Q:+Y=0 D "RTN","ORY535R",98,0) ... D MES^XPDUTL(" "_$G(MSG("DIERR",X,"TEXT",1))) "RTN","ORY535R",99,0) D BMES^XPDUTL(" Completed!") "RTN","ORY535R",100,0) Q "RTN","ORY535R",101,0) ; "RTN","ORY535R",102,0) REINDEX ;Reindex "B" cross reference in file 100.04 "RTN","ORY535R",103,0) N DIK "RTN","ORY535R",104,0) "RTN","ORY535R",105,0) S DIK="^ORD(100.04,",DIK(1)=".01" "RTN","ORY535R",106,0) D ENALL^DIK "RTN","ORY535R",107,0) D MES^XPDUTL(" Completed!") "RTN","ORY535R",108,0) Q "RTN","ORY535R",109,0) ; "RTN","ORY535R",110,0) RECOMPILE ;Recompile the Order Check System "RTN","ORY535R",111,0) N OCXOETIM "RTN","ORY535R",112,0) D BMES^XPDUTL("---Recompiling Order Check Routines---------------------------- -------") "RTN","ORY535R",113,0) D AUTO^OCXOCMP "RTN","ORY535R",114,0) D BMES^XPDUTL(" ---Recompiling Complete---") Q "RTN","ORY535R",116,0) ; "RTN","ORY535R",117,0) RMVLCL ;Remove Local entries from the ORDER CHECK OVERRIDE REASONS (#100.04) fi le "RTN","ORY535R",118,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,CNT,DA,DIK "RTN","ORY535R",119,0) ;S MSG(1)=" Patch OR*3*535 created an option to add local Order Check Overri de" "RTN","ORY535R",120,0) ;S MSG(2)=" Reasons in file 100.04. Now that patch OR*3*535 is being backed out," "RTN","ORY535R",121,0) ;S MSG(3)=" you have the option to keep the locally created Order Check Over ride" "RTN","ORY535R",122,0) ;S MSG(4)=" Reasons and by default the new NATIONAL (#.05) field. Answer YES to" "RTN","ORY535R",123,0) "RTN","ORY535R",124,0) ;RMV1 ;S %=2,%Y="" "RTN","ORY535R",125,0) ;D BMES^XPDUTL("Do you want to delete locally created Order Check Override Rea sons in file 100.04") "RTN","ORY535R",126,0) ;D YN^DICN "RTN","ORY535R",127,0) ;D MES^XPDUTL(%Y) "RTN","ORY535R",128,0) RMV1 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","ORY535R",129,0) D MES^XPDUTL("") "RTN","ORY535R",130,0) I DTIME>30 S DIR("T")=30 "RTN","ORY535R",131,0) S DIR("?",1)=" Patch OR*3*535 created an option to add local Order Check Ove rride" "RTN","ORY535R",132,0) S DIR("?",2)=" Reasons in file 100.04. Now that patch OR*3*535 is being back ed out," S DIR("?",3)=" you have the option to keep the locally created Order Check O verride" "RTN","ORY535R",134,0) S DIR("?",4)=" Reasons and by default the new NATIONAL (#.05) field. Answer YES to" "RTN","ORY535R",135,0) S DIR("?")=" remove the local entries. Default response is NO." "RTN","ORY535R",136,0) S DIR(0)="Y" "RTN","ORY535R",137,0) S MSG(1)="Delete locally created Order Check Override Reasons in file 100.04." "RTN","ORY535R",138,0) S MSG(2)="Answering YES results in the NATIONAL (#.05) field in the ORDER CHEC K" "RTN","ORY535R",139,0) S MSG(3)="OVERRIDE REASONS (#100.04) file to be removed as well. Proceed?" "RTN","ORY535R",140,0) S DIR("B")="NO" "RTN","ORY535R",141,0) D MES^XPDUTL(.MSG) "RTN","ORY535R",142,0) "RTN","ORY535R",143,0) D MES^XPDUTL($S(Y=1:"YES",Y=0:"NO",Y="":"NO",1:Y)) "RTN","ORY535R",144,0) I Y["^" D BMES^XPDUTL(" Exiting is not allowed!!"),MES^XPDUTL("") G RMV1 "RTN","ORY535R",145,0) I +Y=0 D Q "RTN","ORY535R",146,0) . D BMES^XPDUTL(" Skipping deletion of the locally created Order Check Overr ide") "RTN","ORY535R",147,0) . D MES^XPDUTL(" Reasons and leaving the new NATIONAL (#.05) field installed .") "RTN","ORY535R",148,0) ;I %<1 D "RTN","ORY535R",149,0) ;. I %=0,%Y["?" D MES^XPDUTL(""),MES^XPDUTL(.MSG) "RTN","ORY535R",150,0) ;. I %=-1 D BMES^XPDUTL(" Exiting is not allowed!!!") "RTN","ORY535R",151,0) ;. G RMV1 "RTN","ORY535R",152,0) "RTN","ORY535R",153,0) D BMES^XPDUTL("Removing local Order Check Override Reasons...") "RTN","ORY535R",154,0) S DIK="^ORD(100.04," "RTN","ORY535R",155,0) S (CNT,DA)=0 "RTN","ORY535R",156,0) F S DA=$O(^ORD(100.04,DA)) Q:+DA=0 D "RTN","ORY535R",157,0) . I +$P($G(^ORD(100.04,DA,0)),U,5)=1 Q "RTN","ORY535R",158,0) . D MES^XPDUTL(" Deleting '"_$P($G(^ORD(100.04,DA,0)),U,1)_"'") "RTN","ORY535R",159,0) . D ^DIK "RTN","ORY535R",160,0) . S CNT=CNT+1 "RTN","ORY535R",161,0) D BMES^XPDUTL(" --- "_CNT_" local Order Check Override Reasons removed!") "RTN","ORY535R",162,0) RMVNTL ;Remove National (#.05) field from the ORDER CHECK OVERRIDE REASONS (#10 0.04) file and any related data from file entries N OVRD,VAL4,VAL5 "RTN","ORY535R",164,0) D BMES^XPDUTL("Removing NATIONAL (#.05) field from the ORDER CHECK OVERRIDE") "RTN","ORY535R",165,0) D MES^XPDUTL("REASONS (#100.04) file ...") "RTN","ORY535R",166,0) S DIK="^DD(100.04," "RTN","ORY535R",167,0) S DA=.05 "RTN","ORY535R",168,0) S DA(1)=100.04 "RTN","ORY535R",169,0) D ^DIK "RTN","ORY535R",170,0) S OVRD=0 "RTN","ORY535R",171,0) F S OVRD=$O(^ORD(100.04,OVRD)) Q:+OVRD=0 D "RTN","ORY535R",172,0) . S VAL5=$G(^ORD(100.04,OVRD,0)) "RTN","ORY535R",173,0) . S VAL4=$P(VAL5,U,1,4) . I VAL4=VAL5 Q "RTN","ORY535R",175,0) . S ^ORD(100.04,OVRD,0)=VAL4 "RTN","ORY535R",176,0) D BMES^XPDUTL(" ... COMPLETED!") "RTN","ORY535R",177,0) Q "RTN","ORY535R",178,0) ; "RTN","ORY535R",179,0) RMVPARAM ;Remove entries made related to the ORK METFORMIN EGFR parameter. "RTN","ORY535R",180,0) N DA,DIK,ORENTITY,ORINSTANCE,ORPARAM "RTN","ORY535R",181,0) S ORPARAM=$O(^XTV(8989.51,"B","ORK METFORMIN EGFR","")) "RTN","ORY535R",182,0) I ORPARAM<1 Q "RTN","ORY535R",183,0) D BMES^XPDUTL("Removing ORK METFORMIN EGFR parameter entries for all entities. ..") "RTN","ORY535R",184,0) "RTN","ORY535R",185,0) S ORENTITY="" "RTN","ORY535R",186,0) F S ORENTITY=$O(^XTV(8989.5,"AC",ORPARAM,ORENTITY)) Q:ORENTITY="" D "RTN","ORY535R",187,0) . S ORINSTANCE=0 "RTN","ORY535R",188,0) . F S ORINSTANCE=$O(^XTV(8989.5,"AC",ORPARAM,ORENTITY,ORINSTANCE)) Q:+ORINSTA NCE=0 D "RTN","ORY535R",189,0) . . S DA=0 "RTN","ORY535R",190,0) . . F S DA=$O(^XTV(8989.5,"AC",ORPARAM,ORENTITY,ORINSTANCE,DA)) Q:+DA=0 D "RTN","ORY535R",191,0) . . . D ^DIK "RTN","ORY535R",192,0) D BMES^XPDUTL(" ... Complete!") "RTN","ORY535R",193,0) Q "SEC","^DIC",100.04,100.04,0,"AUDIT") @ @ "SEC","^DIC",100.04,100.04,0,"DEL") @ "SEC","^DIC",100.04,100.04,0,"LAYGO") @ "SEC","^DIC",100.04,100.04,0,"RD") @ "SEC","^DIC",100.04,100.04,0,"WR") @ "VER") 8.0^22.2 "^DD",100.04,100.04,0) FIELD^^.04^4 "^DD",100.04,100.04,0,"DDA") N "^DD",100.04,100.04,0,"DT") 3221005 "^DD",100.04,100.04,0,"IX","B",100.04,.01) "^DD",100.04,100.04,0,"NM","ORDER CHECK OVERRIDE REASONS") OR "^DD",100.04,100.04,.01,0) NAME^RF^^0;1^K:$L(X)>100!($L(X)<3)!'(X'?1P.E) X "^DD",100.04,100.04,.01,1,1,0) 100.04^B "^DD",100.04,100.04,.01,1,1,1) S ^ORD(100.04,"B",$E(X,1,30),DA)="" "^DD",100.04,100.04,.01,1,1,2) K ^ORD(100.04,"B",$E(X,1,30),DA) "^DD",100.04,100.04,.01,3) Answer must be 3-100 characters in length. "^DD",100.04,100.04,.01,21,0) ^^1^1^3170407^^ "^DD",100.04,100.04,.01,21,1,0) Enter the pre-determine allergy/order check reason. "^DD",100.04,100.04,.01,"DT") 3170407 "^DD",100.04,100.04,.02,0) SYNONYM^RF^^0;2^K:$L(X)>10!($L(X)<3) X "^DD",100.04,100.04,.02,3) Answer must be 3-10 characters in length. ^^1^1^3170407^^ "^DD",100.04,100.04,.02,21,1,0) Shorten characters synonym for order check. "^DD",100.04,100.04,.02,"DT") 3170407 "^DD",100.04,100.04,.03,0) TYPE^RS^A:ALLERGY;O:ORDER CHECK;B:BOTH;R:REMOTE COMMENT;^0;3^Q "^DD",100.04,100.04,.03,3) Enter an 'A' if used only for Allergy Checks, an 'O' if used only for Order Che cks, a 'B' if used for both types of checks. "^DD",100.04,100.04,.03,21,0) ^.001^1^1^3170407^^^ "^DD",100.04,100.04,.03,21,1,0) Indicates the type of Order Check. "^DD",100.04,100.04,.03,"DT") 3170407 "^DD",100.04,100.04,.04,0) ACTIVE^RSt11^^0;4^ "^DD",100.04,100.04,.04,3) Enter 'Yes' if this entry is currently active. "^DD",100.04,100.04,.04,21,0) "^DD",100.04,100.04,.04,21,1,0) Field used to determine if entry is currently active. "^DD",100.04,100.04,.04,"DT") 3210916 "^DD",100.8,100.8,0) FIELD^^2^2 "^DD",100.8,100.8,0,"DDA") N "^DD",100.8,100.8,0,"DT") 3010429 "^DD",100.8,100.8,0,"IX","B",100.8,.01) "^DD",100.8,100.8,0,"NM","ORDER CHECKS") "^DD",100.8,100.8,0,"PT",100.05,5) "^DD",100.8,100.8,0,"PT",100.09,.01) "^DD",100.8,100.8,0,"PT",100.32,.01) "^DD",100.8,100.8,0,"PT",860.22,2) "^DD",100.8,100.8,0,"VRPK") OR "^DD",100.8,100.8,.01,0) NAME^RF^^0;1^K:$L(X)>45!($L(X)<3)!'(X'?1P.E) X "^DD",100.8,100.8,.01,.1) ORDER CHECK NAME "^DD",100.8,100.8,.01,1,0) ^.1 "^DD",100.8,100.8,.01,1,1,0) 100.8^B "^DD",100.8,100.8,.01,1,1,1) S ^ORD(100.8,"B",$E(X,1,30),DA)="" "^DD",100.8,100.8,.01,1,1,2) K ^ORD(100.8,"B",$E(X,1,30),DA) "^DD",100.8,100.8,.01,3) Answer must be 3-45 characters in length. "^DD",100.8,100.8,.01,21,0) ^^1^1^2970731^ "^DD",100.8,100.8,.01,21,1,0) This is the name of the order check. "^DD",100.8,100.8,.01,23,0) "^DD",100.8,100.8,.01,23,1,0) This is the name of the order check. It is used in identifying how to "^DD",100.8,100.8,.01,23,2,0) process order checks within OE/RR-CPRS. "^DD",100.8,100.8,.01,"DT") 2970731 "^DD",100.8,100.8,2,0) DESCRIPTION^100.82^^1;0 "^DD",100.8,100.8,2,21,0) ^^1^1^3010430^ "^DD",100.8,100.8,2,21,1,0) This field describes the order check. "^DD",100.8,100.82,0) DESCRIPTION SUB-FIELD^^.01^1 "^DD",100.8,100.82,0,"DT") 3010429 "^DD",100.8,100.82,0,"NM","DESCRIPTION") "^DD",100.8,100.82,0,"UP") 100.8 "^DD",100.8,100.82,.01,0) "^DD",100.8,100.82,.01,21,0) ^^1^1^3010429^ "^DD",100.8,100.82,.01,21,1,0) This text describes the order check. "^DD",100.8,100.82,.01,"DT") 3010429 "^DIC",100.04,100.04,0) ORDER CHECK OVERRIDE REASONS^100.04 "^DIC",100.04,100.04,0,"GL") ^ORD(100.04, "^DIC",100.04,100.04,"%",0) ^1.005^^0 "^DIC",100.04,100.04,"%D",0) ^^2^2^3170407^^ "^DIC",100.04,100.04,"%D",1,0) The file contains pre-defined override reasons that can be used "^DIC",100.04,100.04,"%D",2,0) when order checks are overridden. "^DIC",100.04,"B","ORDER CHECK OVERRIDE REASONS",100.04) "^DIC",100.8,100.8,0) "^DIC",100.8,100.8,0,"GL") ^ORD(100.8, "^DIC",100.8,100.8,"%D",0) ^^2^2^2970807^^^^ "^DIC",100.8,100.8,"%D",1,0) This file contains the order checks which are used within OE/RR-CPRS to "^DIC",100.8,100.8,"%D",2,0) perform real-time order checking within the OE/RR-CPRS ordering dialogs. "^DIC",100.8,"B","ORDER CHECKS",100.8) $END KID OR*3.0*535b