ORY405 ;SLC/JLC - ENVIRONMENTAL CHECK ROUTINE ;May 5, 2022@16:30:00
;;3.0;ORDER ENTRY/RESULTS REPORTING;**405**;Dec 17, 1997;Build 211
;
PRE ;Preinstall routine for V32
D INDPR^ORY405NV ;IND
D REMOPT
Q
;
POST ;Post install routine for V32
D RPSO,QQOPU
D ORDRSN,OVRDRSN
D MES^XPDUTL("")
D EN^ORY405NV
D INDPT^ORY405NV ;IND
D CLINMED^ORY405NV ; Remove the Route and Days supply prompts from PSJ OR CLINIC OE
D ADDMENU
D PARS
D RI10097
Q
;
QQOPU ;
N ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTIO,TEXT,ZTSK
S ZTDESC="Update to Outpatient Meds Quick Orders"
S TEXT=ZTDESC_" has been queued, task number "
S ZTRTN="QOPICKUP^ORY405"
S ZTIO=""
S ZTDTH=$$NOW^XLFDT
D ^%ZTLOAD
I $D(ZTSK) S TEXT=TEXT_ZTSK D MES^XPDUTL(.TEXT)
Q
;
QOPICKUP ;Clean up any PICKUP entries in Quick Orders that are set to "C" for Clinic Pickup
N ARRAY,DIALOG,INPUT,PROMPT,SUB
K ^XTMP("OR PU QO LIST")
S ^XTMP("OR PU QO LIST",0)=$$FMADD^XLFDT($$NOW^XLFDT,30)_U_$$NOW^XLFDT
S PROMPT=$O(^ORD(101.41,"B","OR GTX ROUTING",""))
S SUB="OR PU QO"
K ^TMP($J,SUB)
S INPUT("PSO OERR")=""
D FINDQO^ORQOUTL(.ARRAY,.INPUT,SUB,0,1,0,0)
S DIALOG="" F S DIALOG=$O(^TMP($J,SUB,DIALOG)) Q:'DIALOG D
.I $D(^TMP($J,SUB,DIALOG,"ORDIALOG",PROMPT)) D
..I $G(^TMP($J,SUB,DIALOG,"ORDIALOG",PROMPT,1))'="C" Q
..D QOEMPTY(DIALOG,PROMPT)
..S ^XTMP("OR PU QO LIST","LIST",DIALOG)=""
D QOREPORT
Q
;
QOEMPTY(ORQO,ORPROMPT) ;Empty the prompt for this qo
N ORSUB S ORSUB=$O(^ORD(101.41,ORQO,6,"D",ORPROMPT,""))
S ^ORD(101.41,ORQO,6,ORSUB,1)=""
Q
;
QOREPORT ;Send a mailman message of updated QOs
K ^TMP("OR MSG",$J),XMY
N CNT,XMDUZ,XMSUB,XMTEXT,XMY,XMMG
S CNT=0,XMDUZ="CPRS, SEARCH",XMSUB="CLINIC PICKUP QUICK ORDER CONVERSION",XMTEXT="^TMP(""OR MSG"",$J,",XMY(DUZ)="",XMY("G.OR CACS")=""
S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="The following report lists Outpatient Medication Quick Orders where the "
S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="pickup was set to CLINIC. These Quick Orders have had the pickup prompt "
S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="cleared of this value."
S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=""
I $D(^XTMP("OR PU QO LIST")) D
.N ORFLAG S ORFLAG=0
.N ORI S ORI=0 F S ORI=$O(^XTMP("OR PU QO LIST","LIST",ORI)) Q:'ORI D
..I ORFLAG=0 D
...S ORFLAG=1
...S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="QO NAME QO DISPLAY TEXT"
...S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="==============================================================================="
..S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=$$PAD^ORCHTAB($P(^ORD(101.41,ORI,0),U,1),30)_$P(^ORD(101.41,ORI,0),U,2)
I CNT=4 S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="None Found"
D ^XMD
Q
;
REMOPT ;
D BMES^XPDUTL("Removing the following options from menu ORCM MGMT")
I $$DELETE^XPDMENU("ORCM MGMT","OR SUPPLY UTIL MENU") D BMES^XPDUTL(" OR SUPPLY UTIL MENU")
I $$DELETE^XPDMENU("ORCM MGMT","OR IV ADD FREQ UTILITY") D BMES^XPDUTL(" OR IV ADD FREQ UTILITY")
I $$DELETE^XPDMENU("ORCM MGMT","OR QO FREETEXT REPORT") D BMES^XPDUTL(" OR QO FREETEXT REPORT")
I $$DELETE^XPDMENU("ORCM MGMT","OR CONVERT INP TO IV") D BMES^XPDUTL(" OR CONVERT INP TO IV")
I $$DELETE^XPDMENU("ORCM MGMT","OR CONV INPT QO TO CLIN ORD QO") D BMES^XPDUTL(" OR CONV INPT QO TO CLIN ORD QO")
I $$DELETE^XPDMENU("ORCM MGMT","OR QO CASE REPORT") D BMES^XPDUTL(" OR QO CASE REPORT")
I $$DELETE^XPDMENU("ORCM MGMT","OR MEDICATION QO CHECKER") D BMES^XPDUTL(" OR MEDICATION QO CHECKER")
I $$DELETE^XPDMENU("ORCM MGMT","ORCM GMRC CSV CHECK") D BMES^XPDUTL(" ORCM GMRC CSV CHECK")
I $$DELETE^XPDMENU("ORCM MGMT","ORCM UPD INDICATION QO") D BMES^XPDUTL(" ORCM UPD INDICATION QO")
I $$DELETE^XPDMENU("ORCM MGMT","ORCM UPDATE TITRATION QO") D BMES^XPDUTL(" ORCM UPDATE TITRATION QO")
Q
;
SENDDLG(ANAME) ; Return true if the current order dialog should be sent
I ANAME="PSH OERR" Q 1
I ANAME="PSO OERR" Q 1
I ANAME="OR GTX ROUTING" Q 1
I ANAME="OR GTX TITRATION" Q 1
Q 0
;
ORDRSN ;Add a new Order Reason of Allergy/Adverse Drug Reaction
N DA,FDAMSG,FILE,ORERR,ORDRSN,ORFDA,ORSYN,ORACT,ORERR,ORPKG,ORNAT,ORIEN
S ORIEN=""
S FDAMSG=""
S ORDRSN="Allergy/Adverse Drug Reaction"
S ORSYN="ADR"
S ORACT="ACTIVE"
S ORPKG="ORDER ENTRY/RESULTS REPORTING"
S ORNAT="REJECTED"
S FILE=100.03
D BMES^XPDUTL("Adding "_ORDRSN_" to ORDER REASON (#100.03) file.")
S DA=$$FIND1^DIC(FILE,"","X",ORDRSN)
I DA>0 D ;Update existing entry
. S ORFDA(100.03,DA_",",.01)=ORDRSN
. S ORFDA(100.03,DA_",",.03)=ORSYN
. S ORFDA(100.03,DA_",",.04)=ORACT
. S ORFDA(100.03,DA_",",.05)=ORPKG
. S ORFDA(100.03,DA_",",.07)=ORNAT
. L +^ORD(100.03,DA):$S($G(DILOCKTM)>0:DILOCKTM,1:5)
. D FILE^DIE("E","ORFDA","FDAMSG")
. L -^ORD(100.03,DA)
. I $D(FDAMSG("DIERR")) D Q
.. N ERR,TEXT,SWTCH
.. D BMES^XPDUTL("Failed to update entry "_ORDRSN_" (#"_DA_")!!")
.. D MES^XPDUTL(" Please contact support!")
.. S (ERR,SWTCH)=0 F S ERR=$O(FDAMSG("DIERR",ERR)) Q:+ERR=0 D
... S TEXT=$G(FDAMSG("DIERR",ERR,"TEXT",1))
... I TEXT'="" D
.... I SWTCH=0 S SWTCH=1 D MES^XPDUTL("Following error(s) were received:")
.... D MES^XPDUTL(" "_TEXT)
. D BMES^XPDUTL("Successfully updated "_ORDRSN_" (#"_DA_")!")
. K FDAMSG
I DA=0 D ;Add new entry
. N ERR,SWTCH
. K FDAMSG
. S FDAMSG=""
. S ORFDA(100.03,"+1,",.01)=ORDRSN
. S ORFDA(100.03,"+1,",.03)=ORSYN
. S ORFDA(100.03,"+1,",.04)=ORACT
. S ORFDA(100.03,"+1,",.05)=ORPKG
. S ORFDA(100.03,"+1,",.07)=ORNAT
. D UPDATE^DIE("E","ORFDA","ORIEN","FDAMSG")
. I +ORIEN(1)>0 D
.. D BMES^XPDUTL(ORDRSN_" has been successfully added to the")
.. D MES^XPDUTL(" ORDER REASON (#100.03) file!")
.. I $D(FDAMSG("DIERR")) D
... S (ERR,SWTCH)=0 F S ERR=$O(FDAMSG("DIERR",ERR)) Q:+ERR=0 D
.... S TEXT=$G(FDAMSG("DIERR",ERR,"TEXT",1))
.... I TEXT'="" D
..... I SWTCH=0 S SWTCH=1 D MES^XPDUTL(" The Following error(s) were recorded, please contact support:")
..... D MES^XPDUTL(" "_TEXT)
. I +ORIEN(1)<1 D
.. D BMES^XPDUTL("Failed to add "_ORDRSN_"!!")
.. D MES^XPDUTL(" Please contact support!")
.. S (ERR,SWTCH)=0 F S ERR=$O(FDAMSG("DIERR",ERR)) Q:+ERR=0 D
... S TEXT=$G(FDAMSG("DIERR",ERR,"TEXT",1))
... I TEXT'="" D
.... I SWTCH=0 S SWTCH=1 D MES^XPDUTL("Following error(s) were received:")
.... D MES^XPDUTL(" "_TEXT)
. K FDAMSG
I DA="" D ;Failure
. D BMES^XPDUTL("Failed to add "_ORDRSN_"!!")
. D MES^XPDUTL(" Please contact support!")
D BMES^XPDUTL("")
Q
;
OVRDRSN ;Add the Order Check Override Reasons (#100.04) file entries
N ACTIVE,DA,FAILURE,FDA,FDAIEN,FDAMSG,FILE,LINE,MSG,NAME,ORERR,SUCCESS
N SYNONYM,TEXT,TYPE
S FAILURE=" Failed to add the following entry, please contact support:"
S SUCCESS=" SUCCESSFULLY ADDED: "
D BMES^XPDUTL("Starting add/update of the ORDER CHECK OVERRIDE REASON (#100.04) file.")
D MES^XPDUTL("")
S FILE=100.04
F LINE=1:1 Q:$L($T(ORDRCHK+LINE))<3 D
. K FDA,FDAIEN,FDAMSG,MSG,ORERR
. S FDAIEN(1)=LINE
. S FDAMSG=""
. S TEXT=$P($T(ORDRCHK+LINE),";;",2)
. S NAME=$P(TEXT,U,1)
. S SYNONYM=$P(TEXT,U,2)
. S TYPE=$P(TEXT,U,3)
. S ACTIVE=$P(TEXT,U,4)
. S DA=$$FIND1^DIC(FILE,,"X",NAME)
. S MSG(2)=" "_$S($L(NAME," ")>8:$P(NAME," ",1,8),1:NAME)
. I $L(NAME," ")>8 S MSG(3)=" "_$P(NAME," ",9,9999)
. I DA>0 D Q ;Update existing entry
.. S FDA(100.04,DA_",",.01)=NAME
.. S FDA(100.04,DA_",",.02)=SYNONYM
.. S FDA(100.04,DA_",",.03)=TYPE
.. S FDA(100.04,DA_",",.04)=ACTIVE
.. L +^ORD(100.04,DA):$S($G(DILOCKTM)>0:DILOCKTM,1:5)
.. D FILE^DIE("E","FDA","FDAMSG")
.. L -^ORD(100.04,DA)
.. I $D(FDAMSG("DIERR")) D Q
... N ERR,MSGCNT,SWTCH
... S MSG(1)=" Failed to update entry #"_DA_":"
... S (ERR,SWTCH)=0 F S ERR=$O(FDAMSG("DIERR",ERR)) Q:+ERR=0 D
.... S TEXT=$G(FDAMSG("DIERR",ERR,"TEXT",1))
.... I TEXT'="" D
..... I SWTCH=0 D
...... S SWTCH=1,MSGCNT=3
...... I $D(MSG(3)) S MSGCNT=4
...... S MSG(MSGCNT)=" Following errors were received:"
...... S MSGCNT=MSGCNT+1
..... S MSG(MSGCNT)=" "_TEXT
... D BMES^XPDUTL(.MSG)
.. S MSG(1)=" Successfully updated entry #"_DA_":"
.. D BMES^XPDUTL(.MSG)
. I DA=0 D Q ;Add new entry
.. S FDA(100.04,"+1,",.01)=NAME
.. S FDA(100.04,"+1,",.02)=SYNONYM
.. S FDA(100.04,"+1,",.03)=TYPE
.. S FDA(100.04,"+1,",.04)=ACTIVE
.. D UPDATE^DIE("","FDA","FDAIEN","FDAMSG")
.. I +FDAIEN(1)>0 D
... S MSG(1)=SUCCESS
.. I +FDAIEN(1)<1 D
... N ERR,MSGCNT,SWTCH
... S MSG(1)=FAILURE
... S (ERR,SWTCH)=0 F S ERR=$O(FDAMSG("DIERR",ERR)) Q:+ERR=0 D
.... S TEXT=$G(FDAMSG("DIERR",ERR,"TEXT",1))
.... I TEXT'="" D
..... I SWTCH=0 D
...... S SWTCH=1,MSGCNT=3
...... I $D(MSG(3)) S MSGCNT=4
...... S MSG(MSGCNT)=" Following errors were received:"
...... S MSGCNT=MSGCNT+1
..... S MSG(MSGCNT)=" "_TEXT
.. D BMES^XPDUTL(.MSG)
. I DA="" D ;Failure
.. S MSG(1)=FAILURE
.. D BMES^XPDUTL(.MSG)
D BMES^XPDUTL("COMPLETED add/update of the ORDER CHECK OVERRIDE REASON (#100.04) file.")
Q
;
ORDRCHK ;Order Check Override Reasons
;;Benefit of Therapy Outweighs Risk^BEN^B^1
;;Patient tolerating current therapy with this medication^PAT^B^1
;;Previous Adverse Reaction signs/symptoms managed by patient^PRE^B^1
;;Renewal of Current Therapy^REN^B^1
;;Will Monitor Closely for Adverse Effects^WILL^B^1
;;Documentation of Allergy/Adverse Reaction is in Error^DOCAA^B^1
;;Documentation of Allergy/Adverse Reaction is to different agent in same drug class^DOAD^B^1
;;Patient report per interview is inconsistent with remote allergy data.^REM^B^1
Q
;
RPSO ;remove package PSO from the DONE entry in file #101.42
D BMES^XPDUTL("Removing PSO from the entry DONE of the ORDER URGENCY (#101.42) file.")
N IEN,DA,DIK
S IEN=$O(^ORD(101.42,"S.PSO","DONE",""))
Q:'IEN
S DA=0 F S DA=$O(^ORD(101.42,IEN,1,DA)) Q:'DA I ^(DA,0)="PSO" D Q
.S DA(1)=IEN,DIK="^ORD(101.42,"_DA(1)_",1," D ^DIK Q
Q
;
N ORSUCC,OROPT
;
D BMES^XPDUTL("Adding the following options to menu OR VIMM MENU")
F OROPT="PXV EDIT SEQUENCE^SEQ^20","PXV EDIT DEFAULT RESPONSES^DEF^22","PXV SKIN TEST READING CPT^SKC^40" D
. S ORSUCC=$$ADD^XPDMENU("OR VIMM MENU",$P(OROPT,U,1),$P(OROPT,U,2),$P(OROPT,U,3))
. I ORSUCC D BMES^XPDUTL(" "_$P(OROPT,U,1))
. I 'ORSUCC D BMES^XPDUTL(" Error adding "_$P(OROPT,U,1)_" to OR VIMM MENU.")
;
D BMES^XPDUTL("Adding the following options to menu ORCM REPORT/CONV UTILITIES")
I $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","ORCM GMRC CSV CHECK","CS",5) D BMES^XPDUTL(" ORCM GMRC CSV CHECK")
I $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR MEDICATION QO CHECKER","MR",10) D BMES^XPDUTL(" OR MEDICATION QO CHECKER")
I $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR QO CASE REPORT","CA",25) D BMES^XPDUTL(" OR QO CASE REPORT")
I $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR CONV INPT QO TO CLIN ORD QO","CO",30) D BMES^XPDUTL(" OR CONV INPT QO TO CLIN ORD QO")
I $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR CONVERT INP TO IV","CV",35) D BMES^XPDUTL(" OR CONVERT INP TO IV")
I $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR QO FREETEXT REPORT","DF",40) D BMES^XPDUTL(" OR QO FREETEXT REPORT")
I $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR IV ADD FREQ UTILITY","FR",45) D BMES^XPDUTL(" OR IV ADD FREQ UTILITY")
I $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR SUPPLY UTIL MENU","SP",50) D BMES^XPDUTL(" OR SUPPLY UTIL MENU")
Q
;
PARS ; set Parameter values
;
N ORINST,ORLIST,ORI,ORX,ORIMM,ORIMMS,ORERR
;
D BMES^XPDUTL("Setting OR IMM REMINDER DIALOG values.")
S ORINST=0 ;largest instance
D GETLST^XPAR(.ORLIST,"SYS","OR IMM REMINDER DIALOG")
S ORI=0
F S ORI=$O(ORLIST(ORI)) Q:'ORI D
. S ORX=$G(ORLIST(ORI))
. I $P(ORX,U,2)="" Q
. S ORIMMS($P(ORX,U,2))="" ; list of immunizations already defined
. I $P(ORX,U,1)>ORINST S ORINST=$P(ORX,U,1)
;
; See if other COVID-19 Imms need to be added
S ORIMM=0
F S ORIMM=$O(^AUTTIMM(ORIMM)) Q:'ORIMM D ;ICR 1990
. S ORX=$G(^AUTTIMM(ORIMM,0))
. I $P(ORX,U,1)'["COVID-19" Q
. I $P(ORX,U,3)'=211,$P(ORX,U,7) Q ;exclude inactive (except Novavax)
. I $D(ORIMMS(ORIMM)) Q ;already defined
. S ORINST=ORINST+1
. K ORERR
. D EN^XPAR("SYS","OR IMM REMINDER DIALOG",ORINST,"`"_ORIMM,.ORERR)
. I +$G(ORERR)>0 D MES^XPDUTL(" ERROR #"_$P(ORERR,U)_": "_$P(ORERR,U,2))
D MES^XPDUTL(" DONE")
D BMES^XPDUTL("Setting OR RTN PROCESSED ALERTS value.")
I $$GET^XPAR("SYS","OR RTN PROCESSED ALERTS")]"" D BMES^XPDUTL("OR RTN PROCESSED ALERTS value is already set") Q
K ORERR
D EN^XPAR("SYS","OR RTN PROCESSED ALERTS",1,"YES",.ORERR)
I +$G(ORERR)>0 D MES^XPDUTL(" ERROR #"_$P(ORERR,U)_": "_$P(ORERR,U,2))
D MES^XPDUTL(" DONE")
;
Q
RI10097 ;;re-index 100.97
N DIK
D BMES^XPDUTL("Re-indexing 100.97, 'E' cross-reference...")
K ^OR(100.97,"E")
S DIK="^OR(100.97,",DIK(1)="8^E" D ENALL^DIK
D BMES^XPDUTL("Completed re-indexing of 100.97")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY405 13044 printed Dec 13, 2024@02:41:48 Page 2
ORY405 ;SLC/JLC - ENVIRONMENTAL CHECK ROUTINE ;May 5, 2022@16:30:00
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**405**;Dec 17, 1997;Build 211
+2 ;
PRE ;Preinstall routine for V32
+1 ;IND
DO INDPR^ORY405NV
+2 DO REMOPT
+3 QUIT
+4 ;
POST ;Post install routine for V32
+1 DO RPSO
DO QQOPU
+2 DO ORDRSN
DO OVRDRSN
+3 DO MES^XPDUTL("")
+4 DO EN^ORY405NV
+5 ;IND
DO INDPT^ORY405NV
+6 ; Remove the Route and Days supply prompts from PSJ OR CLINIC OE
DO CLINMED^ORY405NV
+7 DO ADDMENU
+8 DO PARS
+9 DO RI10097
+10 QUIT
+11 ;
QQOPU ;
+1 NEW ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTIO,TEXT,ZTSK
+2 SET ZTDESC="Update to Outpatient Meds Quick Orders"
+3 SET TEXT=ZTDESC_" has been queued, task number "
+4 SET ZTRTN="QOPICKUP^ORY405"
+5 SET ZTIO=""
+6 SET ZTDTH=$$NOW^XLFDT
+7 DO ^%ZTLOAD
+8 IF $DATA(ZTSK)
SET TEXT=TEXT_ZTSK
DO MES^XPDUTL(.TEXT)
+9 QUIT
+10 ;
QOPICKUP ;Clean up any PICKUP entries in Quick Orders that are set to "C" for Clinic Pickup
+1 NEW ARRAY,DIALOG,INPUT,PROMPT,SUB
+2 KILL ^XTMP("OR PU QO LIST")
+3 SET ^XTMP("OR PU QO LIST",0)=$$FMADD^XLFDT($$NOW^XLFDT,30)_U_$$NOW^XLFDT
+4 SET PROMPT=$ORDER(^ORD(101.41,"B","OR GTX ROUTING",""))
+5 SET SUB="OR PU QO"
+6 KILL ^TMP($JOB,SUB)
+7 SET INPUT("PSO OERR")=""
+8 DO FINDQO^ORQOUTL(.ARRAY,.INPUT,SUB,0,1,0,0)
+9 SET DIALOG=""
FOR
SET DIALOG=$ORDER(^TMP($JOB,SUB,DIALOG))
if 'DIALOG
QUIT
Begin DoDot:1
+10 IF $DATA(^TMP($JOB,SUB,DIALOG,"ORDIALOG",PROMPT))
Begin DoDot:2
+11 IF $GET(^TMP($JOB,SUB,DIALOG,"ORDIALOG",PROMPT,1))'="C"
QUIT
+12 DO QOEMPTY(DIALOG,PROMPT)
+13 SET ^XTMP("OR PU QO LIST","LIST",DIALOG)=""
End DoDot:2
End DoDot:1
+14 DO QOREPORT
+15 QUIT
+16 ;
QOEMPTY(ORQO,ORPROMPT) ;Empty the prompt for this qo
+1 NEW ORSUB
SET ORSUB=$ORDER(^ORD(101.41,ORQO,6,"D",ORPROMPT,""))
+2 SET ^ORD(101.41,ORQO,6,ORSUB,1)=""
+3 QUIT
+4 ;
QOREPORT ;Send a mailman message of updated QOs
+1 KILL ^TMP("OR MSG",$JOB),XMY
+2 NEW CNT,XMDUZ,XMSUB,XMTEXT,XMY,XMMG
+3 SET CNT=0
SET XMDUZ="CPRS, SEARCH"
SET XMSUB="CLINIC PICKUP QUICK ORDER CONVERSION"
SET XMTEXT="^TMP(""OR MSG"",$J,"
SET XMY(DUZ)=""
SET XMY("G.OR CACS")=""
+4 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="The following report lists Outpatient Medication Quick Orders where the "
+5 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="pickup was set to CLINIC. These Quick Orders have had the pickup prompt "
+6 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="cleared of this value."
+7 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=""
+8 IF $DATA(^XTMP("OR PU QO LIST"))
Begin DoDot:1
+9 NEW ORFLAG
SET ORFLAG=0
+10 NEW ORI
SET ORI=0
FOR
SET ORI=$ORDER(^XTMP("OR PU QO LIST","LIST",ORI))
if 'ORI
QUIT
Begin DoDot:2
+11 IF ORFLAG=0
Begin DoDot:3
+12 SET ORFLAG=1
+13 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="QO NAME QO DISPLAY TEXT"
+14 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="==============================================================================="
End DoDot:3
+15 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=$$PAD^ORCHTAB($PIECE(^ORD(101.41,ORI,0),U,1),30)_$PIECE(^ORD(101.41,ORI,0),U,2)
End DoDot:2
End DoDot:1
+16 IF CNT=4
SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="None Found"
+17 DO ^XMD
+18 QUIT
+19 ;
REMOPT ;
+1 DO BMES^XPDUTL("Removing the following options from menu ORCM MGMT")
+2 IF $$DELETE^XPDMENU("ORCM MGMT","OR SUPPLY UTIL MENU")
DO BMES^XPDUTL(" OR SUPPLY UTIL MENU")
+3 IF $$DELETE^XPDMENU("ORCM MGMT","OR IV ADD FREQ UTILITY")
DO BMES^XPDUTL(" OR IV ADD FREQ UTILITY")
+4 IF $$DELETE^XPDMENU("ORCM MGMT","OR QO FREETEXT REPORT")
DO BMES^XPDUTL(" OR QO FREETEXT REPORT")
+5 IF $$DELETE^XPDMENU("ORCM MGMT","OR CONVERT INP TO IV")
DO BMES^XPDUTL(" OR CONVERT INP TO IV")
+6 IF $$DELETE^XPDMENU("ORCM MGMT","OR CONV INPT QO TO CLIN ORD QO")
DO BMES^XPDUTL(" OR CONV INPT QO TO CLIN ORD QO")
+7 IF $$DELETE^XPDMENU("ORCM MGMT","OR QO CASE REPORT")
DO BMES^XPDUTL(" OR QO CASE REPORT")
+8 IF $$DELETE^XPDMENU("ORCM MGMT","OR MEDICATION QO CHECKER")
DO BMES^XPDUTL(" OR MEDICATION QO CHECKER")
+9 IF $$DELETE^XPDMENU("ORCM MGMT","ORCM GMRC CSV CHECK")
DO BMES^XPDUTL(" ORCM GMRC CSV CHECK")
+10 IF $$DELETE^XPDMENU("ORCM MGMT","ORCM UPD INDICATION QO")
DO BMES^XPDUTL(" ORCM UPD INDICATION QO")
+11 IF $$DELETE^XPDMENU("ORCM MGMT","ORCM UPDATE TITRATION QO")
DO BMES^XPDUTL(" ORCM UPDATE TITRATION QO")
+12 QUIT
+13 ;
SENDDLG(ANAME) ; Return true if the current order dialog should be sent
+1 IF ANAME="PSH OERR"
QUIT 1
+2 IF ANAME="PSO OERR"
QUIT 1
+3 IF ANAME="OR GTX ROUTING"
QUIT 1
+4 IF ANAME="OR GTX TITRATION"
QUIT 1
+5 QUIT 0
+6 ;
ORDRSN ;Add a new Order Reason of Allergy/Adverse Drug Reaction
+1 NEW DA,FDAMSG,FILE,ORERR,ORDRSN,ORFDA,ORSYN,ORACT,ORERR,ORPKG,ORNAT,ORIEN
+2 SET ORIEN=""
+3 SET FDAMSG=""
+4 SET ORDRSN="Allergy/Adverse Drug Reaction"
+5 SET ORSYN="ADR"
+6 SET ORACT="ACTIVE"
+7 SET ORPKG="ORDER ENTRY/RESULTS REPORTING"
+8 SET ORNAT="REJECTED"
+9 SET FILE=100.03
+10 DO BMES^XPDUTL("Adding "_ORDRSN_" to ORDER REASON (#100.03) file.")
+11 SET DA=$$FIND1^DIC(FILE,"","X",ORDRSN)
+12 ;Update existing entry
IF DA>0
Begin DoDot:1
+13 SET ORFDA(100.03,DA_",",.01)=ORDRSN
+14 SET ORFDA(100.03,DA_",",.03)=ORSYN
+15 SET ORFDA(100.03,DA_",",.04)=ORACT
+16 SET ORFDA(100.03,DA_",",.05)=ORPKG
+17 SET ORFDA(100.03,DA_",",.07)=ORNAT
+18 LOCK +^ORD(100.03,DA):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
+19 DO FILE^DIE("E","ORFDA","FDAMSG")
+20 LOCK -^ORD(100.03,DA)
+21 IF $DATA(FDAMSG("DIERR"))
Begin DoDot:2
+22 NEW ERR,TEXT,SWTCH
+23 DO BMES^XPDUTL("Failed to update entry "_ORDRSN_" (#"_DA_")!!")
+24 DO MES^XPDUTL(" Please contact support!")
+25 SET (ERR,SWTCH)=0
FOR
SET ERR=$ORDER(FDAMSG("DIERR",ERR))
if +ERR=0
QUIT
Begin DoDot:3
+26 SET TEXT=$GET(FDAMSG("DIERR",ERR,"TEXT",1))
+27 IF TEXT'=""
Begin DoDot:4
+28 IF SWTCH=0
SET SWTCH=1
DO MES^XPDUTL("Following error(s) were received:")
+29 DO MES^XPDUTL(" "_TEXT)
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+30 DO BMES^XPDUTL("Successfully updated "_ORDRSN_" (#"_DA_")!")
+31 KILL FDAMSG
End DoDot:1
+32 ;Add new entry
IF DA=0
Begin DoDot:1
+33 NEW ERR,SWTCH
+34 KILL FDAMSG
+35 SET FDAMSG=""
+36 SET ORFDA(100.03,"+1,",.01)=ORDRSN
+37 SET ORFDA(100.03,"+1,",.03)=ORSYN
+38 SET ORFDA(100.03,"+1,",.04)=ORACT
+39 SET ORFDA(100.03,"+1,",.05)=ORPKG
+40 SET ORFDA(100.03,"+1,",.07)=ORNAT
+41 DO UPDATE^DIE("E","ORFDA","ORIEN","FDAMSG")
+42 IF +ORIEN(1)>0
Begin DoDot:2
+43 DO BMES^XPDUTL(ORDRSN_" has been successfully added to the")
+44 DO MES^XPDUTL(" ORDER REASON (#100.03) file!")
+45 IF $DATA(FDAMSG("DIERR"))
Begin DoDot:3
+46 SET (ERR,SWTCH)=0
FOR
SET ERR=$ORDER(FDAMSG("DIERR",ERR))
if +ERR=0
QUIT
Begin DoDot:4
+47 SET TEXT=$GET(FDAMSG("DIERR",ERR,"TEXT",1))
+48 IF TEXT'=""
Begin DoDot:5
+49 IF SWTCH=0
SET SWTCH=1
DO MES^XPDUTL(" The Following error(s) were recorded, please contact support:")
+50 DO MES^XPDUTL(" "_TEXT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+51 IF +ORIEN(1)<1
Begin DoDot:2
+52 DO BMES^XPDUTL("Failed to add "_ORDRSN_"!!")
+53 DO MES^XPDUTL(" Please contact support!")
+54 SET (ERR,SWTCH)=0
FOR
SET ERR=$ORDER(FDAMSG("DIERR",ERR))
if +ERR=0
QUIT
Begin DoDot:3
+55 SET TEXT=$GET(FDAMSG("DIERR",ERR,"TEXT",1))
+56 IF TEXT'=""
Begin DoDot:4
+57 IF SWTCH=0
SET SWTCH=1
DO MES^XPDUTL("Following error(s) were received:")
+58 DO MES^XPDUTL(" "_TEXT)
End DoDot:4
End DoDot:3
End DoDot:2
+59 KILL FDAMSG
End DoDot:1
+60 ;Failure
IF DA=""
Begin DoDot:1
+61 DO BMES^XPDUTL("Failed to add "_ORDRSN_"!!")
+62 DO MES^XPDUTL(" Please contact support!")
End DoDot:1
+63 DO BMES^XPDUTL("")
+64 QUIT
+65 ;
OVRDRSN ;Add the Order Check Override Reasons (#100.04) file entries
+1 NEW ACTIVE,DA,FAILURE,FDA,FDAIEN,FDAMSG,FILE,LINE,MSG,NAME,ORERR,SUCCESS
+2 NEW SYNONYM,TEXT,TYPE
+3 SET FAILURE=" Failed to add the following entry, please contact support:"
+4 SET SUCCESS=" SUCCESSFULLY ADDED: "
+5 DO BMES^XPDUTL("Starting add/update of the ORDER CHECK OVERRIDE REASON (#100.04) file.")
+6 DO MES^XPDUTL("")
+7 SET FILE=100.04
+8 FOR LINE=1:1
if $LENGTH($TEXT(ORDRCHK+LINE))<3
QUIT
Begin DoDot:1
+9 KILL FDA,FDAIEN,FDAMSG,MSG,ORERR
+10 SET FDAIEN(1)=LINE
+11 SET FDAMSG=""
+12 SET TEXT=$PIECE($TEXT(ORDRCHK+LINE),";;",2)
+13 SET NAME=$PIECE(TEXT,U,1)
+14 SET SYNONYM=$PIECE(TEXT,U,2)
+15 SET TYPE=$PIECE(TEXT,U,3)
+16 SET ACTIVE=$PIECE(TEXT,U,4)
+17 SET DA=$$FIND1^DIC(FILE,,"X",NAME)
+18 SET MSG(2)=" "_$SELECT($LENGTH(NAME," ")>8:$PIECE(NAME," ",1,8),1:NAME)
+19 IF $LENGTH(NAME," ")>8
SET MSG(3)=" "_$PIECE(NAME," ",9,9999)
+20 ;Update existing entry
IF DA>0
Begin DoDot:2
+21 SET FDA(100.04,DA_",",.01)=NAME
+22 SET FDA(100.04,DA_",",.02)=SYNONYM
+23 SET FDA(100.04,DA_",",.03)=TYPE
+24 SET FDA(100.04,DA_",",.04)=ACTIVE
+25 LOCK +^ORD(100.04,DA):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
+26 DO FILE^DIE("E","FDA","FDAMSG")
+27 LOCK -^ORD(100.04,DA)
+28 IF $DATA(FDAMSG("DIERR"))
Begin DoDot:3
+29 NEW ERR,MSGCNT,SWTCH
+30 SET MSG(1)=" Failed to update entry #"_DA_":"
+31 SET (ERR,SWTCH)=0
FOR
SET ERR=$ORDER(FDAMSG("DIERR",ERR))
if +ERR=0
QUIT
Begin DoDot:4
+32 SET TEXT=$GET(FDAMSG("DIERR",ERR,"TEXT",1))
+33 IF TEXT'=""
Begin DoDot:5
+34 IF SWTCH=0
Begin DoDot:6
+35 SET SWTCH=1
SET MSGCNT=3
+36 IF $DATA(MSG(3))
SET MSGCNT=4
+37 SET MSG(MSGCNT)=" Following errors were received:"
+38 SET MSGCNT=MSGCNT+1
End DoDot:6
+39 SET MSG(MSGCNT)=" "_TEXT
End DoDot:5
End DoDot:4
+40 DO BMES^XPDUTL(.MSG)
End DoDot:3
QUIT
+41 SET MSG(1)=" Successfully updated entry #"_DA_":"
+42 DO BMES^XPDUTL(.MSG)
End DoDot:2
QUIT
+43 ;Add new entry
IF DA=0
Begin DoDot:2
+44 SET FDA(100.04,"+1,",.01)=NAME
+45 SET FDA(100.04,"+1,",.02)=SYNONYM
+46 SET FDA(100.04,"+1,",.03)=TYPE
+47 SET FDA(100.04,"+1,",.04)=ACTIVE
+48 DO UPDATE^DIE("","FDA","FDAIEN","FDAMSG")
+49 IF +FDAIEN(1)>0
Begin DoDot:3
+50 SET MSG(1)=SUCCESS
End DoDot:3
+51 IF +FDAIEN(1)<1
Begin DoDot:3
+52 NEW ERR,MSGCNT,SWTCH
+53 SET MSG(1)=FAILURE
+54 SET (ERR,SWTCH)=0
FOR
SET ERR=$ORDER(FDAMSG("DIERR",ERR))
if +ERR=0
QUIT
Begin DoDot:4
+55 SET TEXT=$GET(FDAMSG("DIERR",ERR,"TEXT",1))
+56 IF TEXT'=""
Begin DoDot:5
+57 IF SWTCH=0
Begin DoDot:6
+58 SET SWTCH=1
SET MSGCNT=3
+59 IF $DATA(MSG(3))
SET MSGCNT=4
+60 SET MSG(MSGCNT)=" Following errors were received:"
+61 SET MSGCNT=MSGCNT+1
End DoDot:6
+62 SET MSG(MSGCNT)=" "_TEXT
End DoDot:5
End DoDot:4
End DoDot:3
+63 DO BMES^XPDUTL(.MSG)
End DoDot:2
QUIT
+64 ;Failure
IF DA=""
Begin DoDot:2
+65 SET MSG(1)=FAILURE
+66 DO BMES^XPDUTL(.MSG)
End DoDot:2
End DoDot:1
+67 DO BMES^XPDUTL("COMPLETED add/update of the ORDER CHECK OVERRIDE REASON (#100.04) file.")
+68 QUIT
+69 ;
ORDRCHK ;Order Check Override Reasons
+1 ;;Benefit of Therapy Outweighs Risk^BEN^B^1
+2 ;;Patient tolerating current therapy with this medication^PAT^B^1
+3 ;;Previous Adverse Reaction signs/symptoms managed by patient^PRE^B^1
+4 ;;Renewal of Current Therapy^REN^B^1
+5 ;;Will Monitor Closely for Adverse Effects^WILL^B^1
+6 ;;Documentation of Allergy/Adverse Reaction is in Error^DOCAA^B^1
+7 ;;Documentation of Allergy/Adverse Reaction is to different agent in same drug class^DOAD^B^1
+8 ;;Patient report per interview is inconsistent with remote allergy data.^REM^B^1
+9 QUIT
+10 ;
RPSO ;remove package PSO from the DONE entry in file #101.42
+1 DO BMES^XPDUTL("Removing PSO from the entry DONE of the ORDER URGENCY (#101.42) file.")
+2 NEW IEN,DA,DIK
+3 SET IEN=$ORDER(^ORD(101.42,"S.PSO","DONE",""))
+4 if 'IEN
QUIT
+5 SET DA=0
FOR
SET DA=$ORDER(^ORD(101.42,IEN,1,DA))
if 'DA
QUIT
IF ^(DA,0)="PSO"
Begin DoDot:1
+6 SET DA(1)=IEN
SET DIK="^ORD(101.42,"_DA(1)_",1,"
DO ^DIK
QUIT
End DoDot:1
QUIT
+7 QUIT
+8 ;
+1 NEW ORSUCC,OROPT
+2 ;
+3 DO BMES^XPDUTL("Adding the following options to menu OR VIMM MENU")
+4 FOR OROPT="PXV EDIT SEQUENCE^SEQ^20","PXV EDIT DEFAULT RESPONSES^DEF^22","PXV SKIN TEST READING CPT^SKC^40"
Begin DoDot:1
+5 SET ORSUCC=$$ADD^XPDMENU("OR VIMM MENU",$PIECE(OROPT,U,1),$PIECE(OROPT,U,2),$PIECE(OROPT,U,3))
+6 IF ORSUCC
DO BMES^XPDUTL(" "_$PIECE(OROPT,U,1))
+7 IF 'ORSUCC
DO BMES^XPDUTL(" Error adding "_$PIECE(OROPT,U,1)_" to OR VIMM MENU.")
End DoDot:1
+8 ;
+9 DO BMES^XPDUTL("Adding the following options to menu ORCM REPORT/CONV UTILITIES")
+10 IF $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","ORCM GMRC CSV CHECK","CS",5)
DO BMES^XPDUTL(" ORCM GMRC CSV CHECK")
+11 IF $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR MEDICATION QO CHECKER","MR",10)
DO BMES^XPDUTL(" OR MEDICATION QO CHECKER")
+12 IF $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR QO CASE REPORT","CA",25)
DO BMES^XPDUTL(" OR QO CASE REPORT")
+13 IF $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR CONV INPT QO TO CLIN ORD QO","CO",30)
DO BMES^XPDUTL(" OR CONV INPT QO TO CLIN ORD QO")
+14 IF $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR CONVERT INP TO IV","CV",35)
DO BMES^XPDUTL(" OR CONVERT INP TO IV")
+15 IF $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR QO FREETEXT REPORT","DF",40)
DO BMES^XPDUTL(" OR QO FREETEXT REPORT")
+16 IF $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR IV ADD FREQ UTILITY","FR",45)
DO BMES^XPDUTL(" OR IV ADD FREQ UTILITY")
+17 IF $$ADD^XPDMENU("ORCM REPORT/CONV UTILITIES","OR SUPPLY UTIL MENU","SP",50)
DO BMES^XPDUTL(" OR SUPPLY UTIL MENU")
+18 QUIT
+19 ;
PARS ; set Parameter values
+1 ;
+2 NEW ORINST,ORLIST,ORI,ORX,ORIMM,ORIMMS,ORERR
+3 ;
+4 DO BMES^XPDUTL("Setting OR IMM REMINDER DIALOG values.")
+5 ;largest instance
SET ORINST=0
+6 DO GETLST^XPAR(.ORLIST,"SYS","OR IMM REMINDER DIALOG")
+7 SET ORI=0
+8 FOR
SET ORI=$ORDER(ORLIST(ORI))
if 'ORI
QUIT
Begin DoDot:1
+9 SET ORX=$GET(ORLIST(ORI))
+10 IF $PIECE(ORX,U,2)=""
QUIT
+11 ; list of immunizations already defined
SET ORIMMS($PIECE(ORX,U,2))=""
+12 IF $PIECE(ORX,U,1)>ORINST
SET ORINST=$PIECE(ORX,U,1)
End DoDot:1
+13 ;
+14 ; See if other COVID-19 Imms need to be added
+15 SET ORIMM=0
+16 ;ICR 1990
FOR
SET ORIMM=$ORDER(^AUTTIMM(ORIMM))
if 'ORIMM
QUIT
Begin DoDot:1
+17 SET ORX=$GET(^AUTTIMM(ORIMM,0))
+18 IF $PIECE(ORX,U,1)'["COVID-19"
QUIT
+19 ;exclude inactive (except Novavax)
IF $PIECE(ORX,U,3)'=211
IF $PIECE(ORX,U,7)
QUIT
+20 ;already defined
IF $DATA(ORIMMS(ORIMM))
QUIT
+21 SET ORINST=ORINST+1
+22 KILL ORERR
+23 DO EN^XPAR("SYS","OR IMM REMINDER DIALOG",ORINST,"`"_ORIMM,.ORERR)
+24 IF +$GET(ORERR)>0
DO MES^XPDUTL(" ERROR #"_$PIECE(ORERR,U)_": "_$PIECE(ORERR,U,2))
End DoDot:1
+25 DO MES^XPDUTL(" DONE")
+26 DO BMES^XPDUTL("Setting OR RTN PROCESSED ALERTS value.")
+27 IF $$GET^XPAR("SYS","OR RTN PROCESSED ALERTS")]""
DO BMES^XPDUTL("OR RTN PROCESSED ALERTS value is already set")
QUIT
+28 KILL ORERR
+29 DO EN^XPAR("SYS","OR RTN PROCESSED ALERTS",1,"YES",.ORERR)
+30 IF +$GET(ORERR)>0
DO MES^XPDUTL(" ERROR #"_$PIECE(ORERR,U)_": "_$PIECE(ORERR,U,2))
+31 DO MES^XPDUTL(" DONE")
+32 ;
+33 QUIT
RI10097 ;;re-index 100.97
+1 NEW DIK
+2 DO BMES^XPDUTL("Re-indexing 100.97, 'E' cross-reference...")
+3 KILL ^OR(100.97,"E")
+4 SET DIK="^OR(100.97,"
SET DIK(1)="8^E"
DO ENALL^DIK
+5 DO BMES^XPDUTL("Completed re-indexing of 100.97")
+6 QUIT
