ORY389 ;SP/WAT,RFR - PRE/POST INSTALL FOR OR*3*389 ;01/06/16 05:57
;;3.0;ORDER ENTRY/RESULTS REPORTING;**389**;Dec 17, 1997;Build 17
Q
POST ;post
D BMES^XPDUTL("Configuring order dialogs...")
D UPDDGMAP
D DLGBULL
D PARVAL
D BMES^XPDUTL("DONE")
N ORPOST,ORSTNUM,XPDIDTOT
S ORPOST=1,ORSTNUM=1,XPDIDTOT=4
D QUEUE("re-index file #100","INDEX^ORY389(""?"")","OE/RR ADD C AND D INDEX TO FILE #100",.ORSTNUM)
D QUEUE("find consult quick orders","CONSULT^ORY389","OE/RR FIND CONSULT QUICK ORDERS",.ORSTNUM)
D QUEUE("supply orderable item report","SODLGCON^ORY389","OE/RR SUPPLY ORDERABLE ITEM REPORT",.ORSTNUM)
D QUEUE("outpatient pharmacy quick order report","EN^ORY389A","OE/RR PSO QO REPORT",.ORSTNUM)
Q
;
RESTART ;index redux
N DIC,Y,X,DTOUT,DUOUT
S DIC="^OR(100,",DIC(0)="AEQX",DIC("A")="ENTER THE STARTING ORDER NUMBER FROM THE STATUS EMAIL: "
D ^DIC
Q:+Y<1
W !,"Queueing re-index..."
D QUEUE("re-index file #100","INDEX^ORY389("_+Y_")","OE/RR ADD C AND D INDEX TO FILE #100")
Q
;
QUEUE(ORMSG,ZTRTN,ZTDESC,ORCURITM) ;CREATE A SPECIFIED TASK
;PARAMETERS: ORMSG => STRING CONTAINING THE TEXT TO OUTPUT TO THE SCREEN
; ZTRTN => STRING CONTAINING THE ROUTINE TASKMAN SHOULD EXECUTE
; ZTDESC => STRING CONTAINING THE TASK'S DESCRIPTION
; ORCURITM => REFERENCE TO THE VARIABLE STORING THE NUMBER OF THE CURRENT ITEM
N ZTDTH,ZTIO,ZTSK
D BMES^XPDUTL("Queueing "_ORMSG_"...")
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
S ZTIO=""
D ^%ZTLOAD
I +$G(ZTSK)=0 D
.I $G(ORPOST) D BMES^XPDUTL("Unable to queue the "_ORMSG_"; file a Remedy ticket for assistance.")
.E W "ERROR",!,"Unable to queue the "_ORMSG_"; file a Remedy ticket for assistance.",!
E D
.I $G(ORPOST) D
..D BMES^XPDUTL("DONE - Task #"_ZTSK)
..D UPDATE^XPDID(ORCURITM)
..S ORCURITM=ORCURITM+1
.E W "DONE",!,"Task #"_ZTSK,!
Q
;
INDEX(ORIFN) ;create indices
;100,2 DIALOG
;100,7 ITEM ORDERED
N ORNODE,ORDLG,ORITEM,ORREP,ORSTAT,ORRECP
F S ORIFN=$O(^OR(100,ORIFN),-1) H:'(ORIFN#10000) 1 D Q:$G(ORIFN)=""!($G(ZTSTOP)=1)
.Q:+ORIFN'>0
.I $D(^OR(100,ORIFN,0))'=0 D
..S ORNODE=^OR(100,ORIFN,0)
..S ORDLG=$P(ORNODE,U,5)
..S:$G(ORDLG)'="" ^OR(100,"C",$E(ORDLG,1,30),ORIFN)=""
.I $D(^OR(100,ORIFN,3))'=0 D
..S ORNODE=^OR(100,ORIFN,3),ORDLG=""
..S ORDLG=$P(ORNODE,U,4)
..S:$G(ORDLG)'="" ^OR(100,"D",$E(ORDLG,1,30),ORIFN)=""
.I ORIFN#1000=0,($$S^%ZTLOAD) N X S ZTSTOP=1,X=$$S^%ZTLOAD("Received shutdown request")
;SEND STATUS EMAIL
I +$G(ZTSTOP)=0 D
.S ORREP(1)="The file #100 re-index process from OR*3.0*389 was successfully completed."
E D
.K ORREP
.S ORREP(1)="The file #100 re-index process from OR*3.0*389 has unexpectedly stopped."
.S ORREP(2)="If you or the system manager did not stop the process, please check the"
.S ORREP(3)="error log and file a Remedy ticket for assistance."
.S ORREP(4)=""
.S ORREP(5)="To requeue the cleanup/conversion process, run RESTART^ORY389 from the"
.S ORREP(6)="programmer prompt and when asked for the starting order number, enter"
.S ORREP(7)=ORIFN+1
S ORRECP(DUZ)=""
S ORSTAT=$$MAIL^ORUTL("ORREP(","PATCH OR*3.0*389 ORDER RE-INDEX STATUS",.ORRECP)
I +ORSTAT,($G(ZTSTOP)=1) D
.S ^XTMP("ORY389",0)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,0)_U_$$NOW^XLFDT_U_"OR*3*389 POST-INSTALL DATA"
.S ^XTMP("ORY389","ORDER")=(ORIFN+1)
S ZTREQ="@"
Q
;
CONSULT ;find GMRC QO's to show the EAD default value/WAT
K ^TMP("OREAD",$J)
N ORGMRPKG,DA,DA1,QONAME,RESPONSE,OREAD,COUNT,TOTAL,ORDISABL,ORSTAT,ORLABEL
S (QONAME,DA,DA1)="",COUNT=1
S ORGMRPKG=$O(^DIC(9.4,"B","CONSULT/REQUEST TRACKING",""))
S OREAD=$O(^ORD(101.41,"B","OR GTX EARLIEST DATE","")),ORLABEL="EARLIEST DATE"
I $G(OREAD)="" S OREAD=$O(^ORD(101.41,"B","OR GTX CLINICALLY INDICATED DATE","")),ORLABEL="CLINICALLY INDICATED DATE"
I +$G(OREAD)'>0 S ^TMP("OREAD",$J,COUNT)=(" OR GTX "_ORLABEL_" not found in ORDERABLE ITEMS file ") G XM Q
S ^TMP("OREAD",$J,COUNT)="Contains Consult and Procedure quick orders with a default value stored",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="in the "_ORLABEL_" field. These quick orders should be",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="reviewed in advance of the installation of CPRS GUI v30.B (OR*3*350)",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="and GMRC*3.0*81.",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="These patches rename the Earliest Date field and introduce a new parameter.",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="The new ORCDGMRC CLIN IND DATE DEFAULT parameter can be set for the",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="DIVISION, SYSTEM, and PACKAGE levels. The PACKAGE setting for the parameter",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="is null, which will force a provider to actively choose a value for",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="the date field. Local settings may be chosen for the DIVISION and SYSTEM",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="levels. Refer to the parameter definition and the OR*3.0*389/350 patch",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="descriptions for further information.",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="Data format of the entries in this message are as follows:",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="IEN from file 101.41^Quick Order Name^"_ORLABEL_" value",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="If you change the value of the parameter, any quick orders in this list",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="that should reflect the new value, should have the "_ORLABEL,COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="field edited accordingly.",COUNT=COUNT+1
S ^TMP("OREAD",$J,COUNT)="",COUNT=COUNT+1
F S QONAME=$O(^ORD(101.41,"B",QONAME)) Q:QONAME="" D
.F S DA=$O(^ORD(101.41,"B",QONAME,DA)) Q:DA="" D
..Q:$P(^ORD(101.41,DA,0),U,4)'="Q"
..Q:$P(^ORD(101.41,DA,0),U,7)'=+$G(ORGMRPKG)
..;now find the EAD in the items for this QO and show that value
..F S DA1=$O(^ORD(101.41,DA,6,DA1)) Q:DA1="" D
...Q:DA1<1
...S RESPONSE=$P(^ORD(101.41,DA,6,DA1,0),U,2)
...Q:RESPONSE'=+OREAD
...S ORDISABL=$P(^ORD(101.41,DA,0),U,3)
...S ORDISABL=$S($L($G(ORDISABL))>0:"YES",1:"")
...S ^TMP("OREAD",$J,COUNT)=DA_"^"_QONAME_"^"_^ORD(101.41,DA,6,DA1,1)_"^"_$G(ORDISABL),COUNT=COUNT+1
I COUNT'>18 S ^TMP("OREAD",$J,COUNT)="No Consult or Procedure quick orders found with a default value stored."
S TOTAL=0 S:COUNT>18 TOTAL=COUNT-19 S ^TMP("OREAD",$J,COUNT)="TOTAL NUMBER OF QOs FOUND: "_TOTAL,COUNT=COUNT+1
XM S ORSTAT=$$MAIL^ORUTL("^TMP(""OREAD"",$J,","CONSULT/PROCEDURE QOs EARLIEST APPROPRIATE DATE DEFAULT VALUE",,"ORY389CQORECIPS")
S ZTREQ="@"
Q
;
SODLGCON ;LOOP THROUGH ALL ORDERABLE ITEMS AND REPORT ON THOSE THAT ARE SUPPLY (TASKED)
N ORCHK,ORDATE,ORDGIEN,ORDLGIDX,ORDLGIEN,ORDRGIEN,OREXIT,ORFIELDS,ORGROUP,ORIDX,ORTEXT
N ORITMHDR,ORITMIEN,ORLINE,ORPHOI,ORQIEN,ORQORDER,ORRESULT,ORDDHDR,ORIEN,ORISSUP,ORSTAT
N ORCHNKBR,ORGO,ORDLG
I '$D(ZTQUEUED) W "Assembling the supply orderable item report...",!
S ORGO=1,ORTEXT=$NA(^TMP($J,"ORSODLGCON")) K @ORTEXT
S ORDLG("ORDERABLE ITEM")=+$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
I ORDLG("ORDERABLE ITEM")=0 D
.S @ORTEXT@(1)="Unable to find the OR GTX ORDERABLE ITEM dialog in the ORDER DIALOG file"
.S @ORTEXT@(2)="(#101.41). Please log a Remedy ticket for assistance.",@ORTEXT=2
S ORDLG("ADDITIVE")=+$O(^ORD(101.41,"B","OR GTX ADDITIVE",0))
I ORDLG("ADDITIVE")=0 D
.S:+$G(@ORTEXT)>0 @ORTEXT=@ORTEXT+1,@ORTEXT@(@ORTEXT)=""
.S @ORTEXT=$G(@ORTEXT)+1,@ORTEXT@(@ORTEXT)="Unable to find the OR GTX ADDITIVE dialog in the ORDER DIALOG file (#101.41)."
.S @ORTEXT=@ORTEXT+1,@ORTEXT@(@ORTEXT)="Please log a Remedy ticket for assistance."
I ORGO D
.S @ORTEXT@(1)="The following orderable items resolve to a supply dispense item.",@ORTEXT@(2)=""
.S @ORTEXT@(3)="ORDERABLE ITEM",@ORTEXT@(4)=$$REPEAT^XLFSTR("-",72),@ORTEXT=4
.;CREATE ORDERABLE ITEM INDEX OF QUICK ORDERS
.S ORQORDER=$NA(^TMP($J,"ORQORDER")) K @ORQORDER
.S ORQIEN=0 F S ORQIEN=$O(^ORD(101.41,ORQIEN)) Q:'+$G(ORQIEN) D
..Q:$P($G(^ORD(101.41,ORQIEN,0)),U,4)'="Q"
..S ORDLGIDX="" F S ORDLGIDX=$O(ORDLG(ORDLGIDX)) Q:$G(ORDLGIDX)="" D
...S ORDLGIEN=0 F S ORDLGIEN=$O(^ORD(101.41,ORQIEN,6,"D",ORDLG(ORDLGIDX),ORDLGIEN)) Q:'+ORDLGIEN D
....S ORITMIEN=$G(^ORD(101.41,ORQIEN,6,ORDLGIEN,1))
....Q:+ORITMIEN'=ORITMIEN
....S @ORQORDER@(ORITMIEN,$P(^ORD(101.41,ORQIEN,0),U,1))=ORQIEN
.S ORCHNKBR=$$REPEAT^XLFSTR("*",30)
.S ORIEN=0 F S ORIEN=$O(^ORD(101.43,ORIEN)) Q:+$G(ORIEN)=0!($G(ZTSTOP)) D
..I ORIEN#1000=0 D Q:$G(ZTSTOP)
...I $$S^%ZTLOAD D
....N X
....S ZTSTOP=1,X=$$S^%ZTLOAD("Received shutdown request")
..S ORDATE=$P($G(^ORD(101.43,ORIEN,.1)),U,1),OREXIT=0
..I ORDATE'="",(+ORDATE<DT) S OREXIT=1
..Q:+$G(OREXIT)=1
..S ORPHOI=$P($G(^ORD(101.43,ORIEN,0)),U,2)
..Q:$P(ORPHOI,";",2)'="99PSP"
..S ORCHK=0
..D DRGIEN^PSS50P7(+ORPHOI,,"ORSUPPLY")
..Q:+^TMP($J,"ORSUPPLY",0)<1
..S (ORITMHDR,ORDDHDR,ORISSUP)=0
..S ORDRGIEN=0 F S ORDRGIEN=$O(^TMP($J,"ORSUPPLY",ORDRGIEN)) Q:'+$G(ORDRGIEN) D
...D ZERO^PSS50(ORDRGIEN,,,,,"ORDRUG")
...Q:+^TMP($J,"ORDRUG",0)<1
...I $$ISSUPPLY(ORDRGIEN) D
....I 'ORITMHDR D WRAP^ORUTL($P(^ORD(101.43,ORIEN,0),U,1),ORTEXT) S ORITMHDR=1
....I 'ORDDHDR D WRAP^ORUTL("DISPENSE ITEM(S): "_^TMP($J,"ORDRUG",ORDRGIEN,.01),ORTEXT) I 1 S ORDDHDR=1
....E D WRAP^ORUTL($$REPEAT^XLFSTR(" ",18)_^TMP($J,"ORDRUG",ORDRGIEN,.01),ORTEXT)
....S ORISSUP=1
..I ORISSUP D
...D QUICK(ORIEN,ORTEXT)
...D REMIND(ORIEN,ORTEXT,"101.43^ORD(101.43,")
...S @ORTEXT=@ORTEXT+1,@ORTEXT@(@ORTEXT)=ORCHNKBR
.I +$G(ZTSTOP)=0 D
..S @ORTEXT=@ORTEXT+1,@ORTEXT@(@ORTEXT)=$$REPEAT^XLFSTR(" ",32)_"[END OF REPORT]"
.E D
..S @ORTEXT=@ORTEXT+1,@ORTEXT@(@ORTEXT)=""
..S @ORTEXT=@ORTEXT+1,@ORTEXT@(@ORTEXT)="The quick order dialog report process has unexpectedly stopped."
..S @ORTEXT=@ORTEXT+1,@ORTEXT@(@ORTEXT)="If you or the system manager did not stop the process, please check the"
..S @ORTEXT=@ORTEXT+1,@ORTEXT@(@ORTEXT)="error log and file a Remedy ticket for assistance."
..S @ORTEXT=@ORTEXT+1,@ORTEXT@(@ORTEXT)=""
I 'ORGO!($G(ZTSTOP)) D
.S @ORTEXT=@ORTEXT+1,@ORTEXT@(@ORTEXT)="To rerun the report, execute SODLGCON^ORY389 from the programmer prompt."
K ^TMP($J,"FDATA"),^TMP($J,"DLG FIND")
S ORSTAT=$$MAIL^ORUTL($P(ORTEXT,")",1)_",","SUPPLY ORDERABLE ITEM REPORT",,"ORY389SOIRECIPS")
K @ORTEXT,@ORQORDER
I $D(ZTQUEUED) S ZTREQ="@"
E W !,"Report successfully generated.",!
Q
ISSUPPLY(ORDRGIEN) ;DETERMINE IF DRUG IS A SUPPLY ITEM
;PARAMETERS: ORDRGIEN=>DRUG IEN IN ^TMP($J,"ORDRUG") GLOBAL
Q:"^XA^XX^"[(U_$E(^TMP($J,"ORDRUG",ORDRGIEN,2),1,2)_U)!(^TMP($J,"ORDRUG",ORDRGIEN,2)="DX900"&($G(^TMP($J,"ORDRUG",ORDRGIEN,3))["S")) 1
Q 0
QUICK(ORIEN,ORTEXT) ;FIND QUICK ORDERS THAT REFERENCE THE ORDERABLE ITEM
;PARAMETERS: ORIEN =>ORDERABLE ITEM IEN
; ORTEXT=>NAME OF ARRAY TO STORE OUTPUT TEXT IN
N ORQO,ORHEADER
S ORHEADER=0
S ORQO="" F S ORQO=$O(@ORQORDER@(ORIEN,ORQO)) Q:$G(ORQO)="" D
.I 'ORHEADER D WRAP^ORUTL("QUICK ORDERS: "_ORQO,ORTEXT) I 1 S ORHEADER=1
.E D WRAP^ORUTL($$REPEAT^XLFSTR(" ",14)_ORQO,ORTEXT)
.D REMIND(@ORQORDER@(ORIEN,ORQO),ORTEXT,"101.41^ORD(101.41,",18)
.D MENU(@ORQORDER@(ORIEN,ORQO),ORTEXT,18)
Q
REMIND(ORITMIEN,ORTEXT,ORFILE,ORINDENT) ;FIND CLINICAL REMINDERS THAT REFERENCE THE ORDERABLE ITEM/QUICK ORDER DIALOG
;PARAMETERS: ORITMIEN=>ORDERABLE ITEM/QUICK ORDER DIALOG IEN
; ORTEXT =>NAME OF ARRAY TO STORE OUTPUT TEXT IN
; ORFILE =>DELIMITED STRING WITH FILE_NUMBER^FILE_GLOBAL_ROOT
; ORINDENT=>NUMBER OF SPACES TO INDENT TEXT; DEFAULT IS 0
K ^TMP($J,"FDATA")
D BLDLIST^PXRMFRPT(+ORFILE,$P(ORFILE,U,2),ORITMIEN,"FDATA")
D MSG(ORTEXT,$G(ORINDENT,0))
Q
MSG(TEXTOUT,ORINDENT) ;PROCESS DATA FROM BLDLIST^PXRMFRPT
;PARAMETERS: TEXTOUT =>TEXT TO OUTPUT TO THE SCREEN
; ORINDENT=>NUMBER OF SPACES TO INDENT TEXT; DEFAULT IS 0
N DTYP,FILENUM,IND,NAME,NL,NOUT,RNUM,FI,FIEN,IEN,TEXT,TYPE,SUBHEAD
N OUTPUT
S ORINDENT=$$REPEAT^XLFSTR(" ",$G(ORINDENT,0))
S FILENUM=0
F S FILENUM=$O(^TMP($J,"FDATA",FILENUM)) Q:FILENUM="" D
.S FIEN=0
.F S FIEN=$O(^TMP($J,"FDATA",FILENUM,FIEN)) Q:FIEN="" D
..F TYPE="DEF","TERM","DIALOG","ROC" D
...I '$D(^TMP($J,"FDATA",FILENUM,FIEN,TYPE)) Q
...S RNUM=$S(TYPE="DEF":811.9,TYPE="TERM":811.5,TYPE="DIALOG":801.41,TYPE="ROC":801)
...S OUTPUT=ORINDENT_"REMINDER "_$S(TYPE="DEF":"DEFINITIONS:",TYPE="TERM":"TERMS:",TYPE="DIALOG":"DIALOGS:",TYPE="ROC":"ORDER CHECKS:",1:"")
...S IEN=0
...F S IEN=$O(^TMP($J,"FDATA",FILENUM,FIEN,TYPE,IEN)) Q:IEN="" D
....S NAME=$$GET1^DIQ(RNUM,IEN,.01)
....I TYPE="DIALOG" D
.....S DTYP=$P(^PXRMD(801.41,IEN,0),U,4)
.....S OUTPUT=$G(OUTPUT,ORINDENT)_" Dialog "_$S(DTYP="E":"element",DTYP="G":"group",DTYP="S":"result group",1:"item")
.....S OUTPUT=OUTPUT_" "_NAME_$S($P(^PXRMD(801.41,IEN,0),U,3)=1:" (Disable)",1:"")_" (IEN="_IEN_")"
.....S OUTPUT=OUTPUT_", used in the "
.....N ORITMS
.....S FI=0 F S FI=$O(^TMP($J,"FDATA",FILENUM,FIEN,TYPE,IEN,FI)) Q:FI="" S ORITMS=$S($G(ORITMS)'="":ORITMS_", ",1:"")_$S(FI=15:"Finding Item field",FI=17:"Orderable Item field",FI=18:"Additional Finding field",FI=119:"MH Test field",1:"")
.....D WRAP^ORUTL(OUTPUT_$G(ORITMS),TEXTOUT)
....I TYPE'="DIALOG" D
.....S OUTPUT=$G(OUTPUT,ORINDENT)_" "_NAME_" (IEN="_IEN_", "
.....S (FI,SUBHEAD)=0
.....F S FI=$O(^TMP($J,"FDATA",FILENUM,FIEN,TYPE,IEN,FI)) Q:FI="" D
......I 'SUBHEAD D
.......S OUTPUT=OUTPUT_$S(TYPE="ROC":"Rule Name ",1:"Finding number ")_FI_", "
.......S SUBHEAD=1
......E S OUTPUT=OUTPUT_FI_", "
.....D WRAP^ORUTL($E(OUTPUT,1,*-2)_")",TEXTOUT)
Q
;PARAMETERS: ORQIEN=>QUICK ORDER DIALOG IEN
; ORTEXT=>NAME OF ARRAY TO STORE OUTPUT TEXT IN
; ORINDENT=>NUMBER OF SPACES TO INDENT TEXT; DEFAULT IS 0
N ORIDX,HEADER,OUTPUT
S ORINDENT=$G(ORINDENT,0)
S (ORIDX,HEADER)=0 F S ORIDX=$O(^ORD(101.41,"AD",ORQIEN,ORIDX)) Q:+ORIDX=0 D
.I 'HEADER S OUTPUT=$$REPEAT^XLFSTR(" ",ORINDENT)_"ORDER MENUS: ",HEADER=1
.E S OUTPUT=$$REPEAT^XLFSTR(" ",ORINDENT+13)
.D WRAP^ORUTL($G(OUTPUT)_$P($G(^ORD(101.41,ORIDX,0)),U,1),ORTEXT)
Q
UPDDGMAP ;Update the Pharmacy Display Group child mappings
;find the IENs of the PHARMACY, CLINIC MEDICATIONS and CLINIC INFUSIONS display groups
N ORPHDG,ORCMDG,ORCIDG,ORZZ,ORFND,ORI,ORCSUP
S ORPHDG=$O(^ORD(100.98,"B","PHARMACY",0))
S ORCMDG=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",0))
S ORCIDG=$O(^ORD(100.98,"B","CLINIC INFUSIONS",0))
S ORCSUP=$O(^ORD(100.98,"B","SUPPLIES/DEVICES",0))
S ORFND=0,ORI=0 F S ORI=$O(^ORD(100.98,2,1,ORI)) Q:'ORI D
.I $G(^ORD(100.98,2,1,ORI,0))=ORCMDG S ORFND=1
I 'ORFND S ORZZ(1,100.981,"+2,"_ORPHDG_",",.01)=ORCMDG
S ORFND=0,ORI=0 F S ORI=$O(^ORD(100.98,2,1,ORI)) Q:'ORI D
.I $G(^ORD(100.98,2,1,ORI,0))=ORCIDG S ORFND=1
I 'ORFND S ORZZ(1,100.981,"+3,"_ORPHDG_",",.01)=ORCIDG
S ORFND=0,ORI=0 F S ORI=$O(^ORD(100.98,2,1,ORI)) Q:'ORI D
.I $G(^ORD(100.98,2,1,ORI,0))=ORCSUP S ORFND=1
I 'ORFND S ORZZ(1,100.981,"+4,"_ORPHDG_",",.01)=ORCSUP
D UPDATE^DIE("","ORZZ(1)")
Q
;
SENDDSPG(ANAME) ; Return true if the current display group should be sent
I ANAME="CLINIC ORDERS" Q 1
I ANAME="CLINIC INFUSIONS" Q 1
I ANAME="CLINIC MEDICATIONS" Q 1
I ANAME="SUPPLIES/DEVICES" Q 1
Q 0
;
SENDDLG(ANAME) ; Return true if the current order dialog should be sent
I ANAME="PSJ OR CLINIC OE" Q 1
I ANAME="CLINIC OR PAT FLUID OE" Q 1
I ANAME="PSO SUPPLY" Q 1
Q 0
;
DLGBULL ; send bulletin about modified dialogs <on first install>
N I,ORD
F I="PSJ OR CLINIC OE","CLINIC OR PAT FLUID OE","PSO SUPPLY" S ORD(I)=""
D EN^ORYDLG(389,.ORD)
Q
;
PARVAL ;add Clin. Inf, Clin Meds display group to SEQUENCE parameter
N X
D DEL^XPAR("PKG","ORWOR CATEGORY SEQUENCE",69)
I $D(^ORD(100.98,"B","CLINIC MEDICATIONS")) D
. S X=0,X=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",X)) Q:'X D
. . D PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",69,X)
D DEL^XPAR("PKG","ORWOR CATEGORY SEQUENCE",59)
I $D(^ORD(100.98,"B","CLINIC INFUSIONS")) D
. S X=0,X=$O(^ORD(100.98,"B","CLINIC INFUSIONS",X)) Q:'X D
. . D PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",59,X)
D DEL^XPAR("PKG","ORWOR CATEGORY SEQUENCE",130)
I $D(^ORD(100.98,"B","SUPPLIES/DEVICES")) D
. S X=0,X=$O(^ORD(100.98,"B","SUPPLIES/DEVICES",X)) Q:'X D
. . D PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",130,X)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY389 16608 printed Oct 16, 2024@18:42:12 Page 2
ORY389 ;SP/WAT,RFR - PRE/POST INSTALL FOR OR*3*389 ;01/06/16 05:57
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**389**;Dec 17, 1997;Build 17
+2 QUIT
POST ;post
+1 DO BMES^XPDUTL("Configuring order dialogs...")
+2 DO UPDDGMAP
+3 DO DLGBULL
+4 DO PARVAL
+5 DO BMES^XPDUTL("DONE")
+6 NEW ORPOST,ORSTNUM,XPDIDTOT
+7 SET ORPOST=1
SET ORSTNUM=1
SET XPDIDTOT=4
+8 DO QUEUE("re-index file #100","INDEX^ORY389(""?"")","OE/RR ADD C AND D INDEX TO FILE #100",.ORSTNUM)
+9 DO QUEUE("find consult quick orders","CONSULT^ORY389","OE/RR FIND CONSULT QUICK ORDERS",.ORSTNUM)
+10 DO QUEUE("supply orderable item report","SODLGCON^ORY389","OE/RR SUPPLY ORDERABLE ITEM REPORT",.ORSTNUM)
+11 DO QUEUE("outpatient pharmacy quick order report","EN^ORY389A","OE/RR PSO QO REPORT",.ORSTNUM)
+12 QUIT
+13 ;
RESTART ;index redux
+1 NEW DIC,Y,X,DTOUT,DUOUT
+2 SET DIC="^OR(100,"
SET DIC(0)="AEQX"
SET DIC("A")="ENTER THE STARTING ORDER NUMBER FROM THE STATUS EMAIL: "
+3 DO ^DIC
+4 if +Y<1
QUIT
+5 WRITE !,"Queueing re-index..."
+6 DO QUEUE("re-index file #100","INDEX^ORY389("_+Y_")","OE/RR ADD C AND D INDEX TO FILE #100")
+7 QUIT
+8 ;
QUEUE(ORMSG,ZTRTN,ZTDESC,ORCURITM) ;CREATE A SPECIFIED TASK
+1 ;PARAMETERS: ORMSG => STRING CONTAINING THE TEXT TO OUTPUT TO THE SCREEN
+2 ; ZTRTN => STRING CONTAINING THE ROUTINE TASKMAN SHOULD EXECUTE
+3 ; ZTDESC => STRING CONTAINING THE TASK'S DESCRIPTION
+4 ; ORCURITM => REFERENCE TO THE VARIABLE STORING THE NUMBER OF THE CURRENT ITEM
+5 NEW ZTDTH,ZTIO,ZTSK
+6 DO BMES^XPDUTL("Queueing "_ORMSG_"...")
+7 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
+8 SET ZTIO=""
+9 DO ^%ZTLOAD
+10 IF +$GET(ZTSK)=0
Begin DoDot:1
+11 IF $GET(ORPOST)
DO BMES^XPDUTL("Unable to queue the "_ORMSG_"; file a Remedy ticket for assistance.")
+12 IF '$TEST
WRITE "ERROR",!,"Unable to queue the "_ORMSG_"; file a Remedy ticket for assistance.",!
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 IF $GET(ORPOST)
Begin DoDot:2
+15 DO BMES^XPDUTL("DONE - Task #"_ZTSK)
+16 DO UPDATE^XPDID(ORCURITM)
+17 SET ORCURITM=ORCURITM+1
End DoDot:2
+18 IF '$TEST
WRITE "DONE",!,"Task #"_ZTSK,!
End DoDot:1
+19 QUIT
+20 ;
INDEX(ORIFN) ;create indices
+1 ;100,2 DIALOG
+2 ;100,7 ITEM ORDERED
+3 NEW ORNODE,ORDLG,ORITEM,ORREP,ORSTAT,ORRECP
+4 FOR
SET ORIFN=$ORDER(^OR(100,ORIFN),-1)
if '(ORIFN#10000)
HANG 1
Begin DoDot:1
+5 if +ORIFN'>0
QUIT
+6 IF $DATA(^OR(100,ORIFN,0))'=0
Begin DoDot:2
+7 SET ORNODE=^OR(100,ORIFN,0)
+8 SET ORDLG=$PIECE(ORNODE,U,5)
+9 if $GET(ORDLG)'=""
SET ^OR(100,"C",$EXTRACT(ORDLG,1,30),ORIFN)=""
End DoDot:2
+10 IF $DATA(^OR(100,ORIFN,3))'=0
Begin DoDot:2
+11 SET ORNODE=^OR(100,ORIFN,3)
SET ORDLG=""
+12 SET ORDLG=$PIECE(ORNODE,U,4)
+13 if $GET(ORDLG)'=""
SET ^OR(100,"D",$EXTRACT(ORDLG,1,30),ORIFN)=""
End DoDot:2
+14 IF ORIFN#1000=0
IF ($$S^%ZTLOAD)
NEW X
SET ZTSTOP=1
SET X=$$S^%ZTLOAD("Received shutdown request")
End DoDot:1
if $GET(ORIFN)=""!($GET(ZTSTOP)=1)
QUIT
+15 ;SEND STATUS EMAIL
+16 IF +$GET(ZTSTOP)=0
Begin DoDot:1
+17 SET ORREP(1)="The file #100 re-index process from OR*3.0*389 was successfully completed."
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 KILL ORREP
+20 SET ORREP(1)="The file #100 re-index process from OR*3.0*389 has unexpectedly stopped."
+21 SET ORREP(2)="If you or the system manager did not stop the process, please check the"
+22 SET ORREP(3)="error log and file a Remedy ticket for assistance."
+23 SET ORREP(4)=""
+24 SET ORREP(5)="To requeue the cleanup/conversion process, run RESTART^ORY389 from the"
+25 SET ORREP(6)="programmer prompt and when asked for the starting order number, enter"
+26 SET ORREP(7)=ORIFN+1
End DoDot:1
+27 SET ORRECP(DUZ)=""
+28 SET ORSTAT=$$MAIL^ORUTL("ORREP(","PATCH OR*3.0*389 ORDER RE-INDEX STATUS",.ORRECP)
+29 IF +ORSTAT
IF ($GET(ZTSTOP)=1)
Begin DoDot:1
+30 SET ^XTMP("ORY389",0)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,0)_U_$$NOW^XLFDT_U_"OR*3*389 POST-INSTALL DATA"
+31 SET ^XTMP("ORY389","ORDER")=(ORIFN+1)
End DoDot:1
+32 SET ZTREQ="@"
+33 QUIT
+34 ;
CONSULT ;find GMRC QO's to show the EAD default value/WAT
+1 KILL ^TMP("OREAD",$JOB)
+2 NEW ORGMRPKG,DA,DA1,QONAME,RESPONSE,OREAD,COUNT,TOTAL,ORDISABL,ORSTAT,ORLABEL
+3 SET (QONAME,DA,DA1)=""
SET COUNT=1
+4 SET ORGMRPKG=$ORDER(^DIC(9.4,"B","CONSULT/REQUEST TRACKING",""))
+5 SET OREAD=$ORDER(^ORD(101.41,"B","OR GTX EARLIEST DATE",""))
SET ORLABEL="EARLIEST DATE"
+6 IF $GET(OREAD)=""
SET OREAD=$ORDER(^ORD(101.41,"B","OR GTX CLINICALLY INDICATED DATE",""))
SET ORLABEL="CLINICALLY INDICATED DATE"
+7 IF +$GET(OREAD)'>0
SET ^TMP("OREAD",$JOB,COUNT)=(" OR GTX "_ORLABEL_" not found in ORDERABLE ITEMS file ")
GOTO XM
QUIT
+8 SET ^TMP("OREAD",$JOB,COUNT)="Contains Consult and Procedure quick orders with a default value stored"
SET COUNT=COUNT+1
+9 SET ^TMP("OREAD",$JOB,COUNT)="in the "_ORLABEL_" field. These quick orders should be"
SET COUNT=COUNT+1
+10 SET ^TMP("OREAD",$JOB,COUNT)="reviewed in advance of the installation of CPRS GUI v30.B (OR*3*350)"
SET COUNT=COUNT+1
+11 SET ^TMP("OREAD",$JOB,COUNT)="and GMRC*3.0*81."
SET COUNT=COUNT+1
+12 SET ^TMP("OREAD",$JOB,COUNT)="These patches rename the Earliest Date field and introduce a new parameter."
SET COUNT=COUNT+1
+13 SET ^TMP("OREAD",$JOB,COUNT)="The new ORCDGMRC CLIN IND DATE DEFAULT parameter can be set for the"
SET COUNT=COUNT+1
+14 SET ^TMP("OREAD",$JOB,COUNT)="DIVISION, SYSTEM, and PACKAGE levels. The PACKAGE setting for the parameter"
SET COUNT=COUNT+1
+15 SET ^TMP("OREAD",$JOB,COUNT)="is null, which will force a provider to actively choose a value for"
SET COUNT=COUNT+1
+16 SET ^TMP("OREAD",$JOB,COUNT)="the date field. Local settings may be chosen for the DIVISION and SYSTEM"
SET COUNT=COUNT+1
+17 SET ^TMP("OREAD",$JOB,COUNT)="levels. Refer to the parameter definition and the OR*3.0*389/350 patch"
SET COUNT=COUNT+1
+18 SET ^TMP("OREAD",$JOB,COUNT)="descriptions for further information."
SET COUNT=COUNT+1
+19 SET ^TMP("OREAD",$JOB,COUNT)="Data format of the entries in this message are as follows:"
SET COUNT=COUNT+1
+20 SET ^TMP("OREAD",$JOB,COUNT)="IEN from file 101.41^Quick Order Name^"_ORLABEL_" value"
SET COUNT=COUNT+1
+21 SET ^TMP("OREAD",$JOB,COUNT)=""
SET COUNT=COUNT+1
+22 SET ^TMP("OREAD",$JOB,COUNT)="If you change the value of the parameter, any quick orders in this list"
SET COUNT=COUNT+1
+23 SET ^TMP("OREAD",$JOB,COUNT)="that should reflect the new value, should have the "_ORLABEL
SET COUNT=COUNT+1
+24 SET ^TMP("OREAD",$JOB,COUNT)="field edited accordingly."
SET COUNT=COUNT+1
+25 SET ^TMP("OREAD",$JOB,COUNT)=""
SET COUNT=COUNT+1
+26 FOR
SET QONAME=$ORDER(^ORD(101.41,"B",QONAME))
if QONAME=""
QUIT
Begin DoDot:1
+27 FOR
SET DA=$ORDER(^ORD(101.41,"B",QONAME,DA))
if DA=""
QUIT
Begin DoDot:2
+28 if $PIECE(^ORD(101.41,DA,0),U,4)'="Q"
QUIT
+29 if $PIECE(^ORD(101.41,DA,0),U,7)'=+$GET(ORGMRPKG)
QUIT
+30 ;now find the EAD in the items for this QO and show that value
+31 FOR
SET DA1=$ORDER(^ORD(101.41,DA,6,DA1))
if DA1=""
QUIT
Begin DoDot:3
+32 if DA1<1
QUIT
+33 SET RESPONSE=$PIECE(^ORD(101.41,DA,6,DA1,0),U,2)
+34 if RESPONSE'=+OREAD
QUIT
+35 SET ORDISABL=$PIECE(^ORD(101.41,DA,0),U,3)
+36 SET ORDISABL=$SELECT($LENGTH($GET(ORDISABL))>0:"YES",1:"")
+37 SET ^TMP("OREAD",$JOB,COUNT)=DA_"^"_QONAME_"^"_^ORD(101.41,DA,6,DA1,1)_"^"_$GET(ORDISABL)
SET COUNT=COUNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+38 IF COUNT'>18
SET ^TMP("OREAD",$JOB,COUNT)="No Consult or Procedure quick orders found with a default value stored."
+39 SET TOTAL=0
if COUNT>18
SET TOTAL=COUNT-19
SET ^TMP("OREAD",$JOB,COUNT)="TOTAL NUMBER OF QOs FOUND: "_TOTAL
SET COUNT=COUNT+1
XM SET ORSTAT=$$MAIL^ORUTL("^TMP(""OREAD"",$J,","CONSULT/PROCEDURE QOs EARLIEST APPROPRIATE DATE DEFAULT VALUE",,"ORY389CQORECIPS")
+1 SET ZTREQ="@"
+2 QUIT
+3 ;
SODLGCON ;LOOP THROUGH ALL ORDERABLE ITEMS AND REPORT ON THOSE THAT ARE SUPPLY (TASKED)
+1 NEW ORCHK,ORDATE,ORDGIEN,ORDLGIDX,ORDLGIEN,ORDRGIEN,OREXIT,ORFIELDS,ORGROUP,ORIDX,ORTEXT
+2 NEW ORITMHDR,ORITMIEN,ORLINE,ORPHOI,ORQIEN,ORQORDER,ORRESULT,ORDDHDR,ORIEN,ORISSUP,ORSTAT
+3 NEW ORCHNKBR,ORGO,ORDLG
+4 IF '$DATA(ZTQUEUED)
WRITE "Assembling the supply orderable item report...",!
+5 SET ORGO=1
SET ORTEXT=$NAME(^TMP($JOB,"ORSODLGCON"))
KILL @ORTEXT
+6 SET ORDLG("ORDERABLE ITEM")=+$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
+7 IF ORDLG("ORDERABLE ITEM")=0
Begin DoDot:1
+8 SET @ORTEXT@(1)="Unable to find the OR GTX ORDERABLE ITEM dialog in the ORDER DIALOG file"
+9 SET @ORTEXT@(2)="(#101.41). Please log a Remedy ticket for assistance."
SET @ORTEXT=2
End DoDot:1
+10 SET ORDLG("ADDITIVE")=+$ORDER(^ORD(101.41,"B","OR GTX ADDITIVE",0))
+11 IF ORDLG("ADDITIVE")=0
Begin DoDot:1
+12 if +$GET(@ORTEXT)>0
SET @ORTEXT=@ORTEXT+1
SET @ORTEXT@(@ORTEXT)=""
+13 SET @ORTEXT=$GET(@ORTEXT)+1
SET @ORTEXT@(@ORTEXT)="Unable to find the OR GTX ADDITIVE dialog in the ORDER DIALOG file (#101.41)."
+14 SET @ORTEXT=@ORTEXT+1
SET @ORTEXT@(@ORTEXT)="Please log a Remedy ticket for assistance."
End DoDot:1
+15 IF ORGO
Begin DoDot:1
+16 SET @ORTEXT@(1)="The following orderable items resolve to a supply dispense item."
SET @ORTEXT@(2)=""
+17 SET @ORTEXT@(3)="ORDERABLE ITEM"
SET @ORTEXT@(4)=$$REPEAT^XLFSTR("-",72)
SET @ORTEXT=4
+18 ;CREATE ORDERABLE ITEM INDEX OF QUICK ORDERS
+19 SET ORQORDER=$NAME(^TMP($JOB,"ORQORDER"))
KILL @ORQORDER
+20 SET ORQIEN=0
FOR
SET ORQIEN=$ORDER(^ORD(101.41,ORQIEN))
if '+$GET(ORQIEN)
QUIT
Begin DoDot:2
+21 if $PIECE($GET(^ORD(101.41,ORQIEN,0)),U,4)'="Q"
QUIT
+22 SET ORDLGIDX=""
FOR
SET ORDLGIDX=$ORDER(ORDLG(ORDLGIDX))
if $GET(ORDLGIDX)=""
QUIT
Begin DoDot:3
+23 SET ORDLGIEN=0
FOR
SET ORDLGIEN=$ORDER(^ORD(101.41,ORQIEN,6,"D",ORDLG(ORDLGIDX),ORDLGIEN))
if '+ORDLGIEN
QUIT
Begin DoDot:4
+24 SET ORITMIEN=$GET(^ORD(101.41,ORQIEN,6,ORDLGIEN,1))
+25 if +ORITMIEN'=ORITMIEN
QUIT
+26 SET @ORQORDER@(ORITMIEN,$PIECE(^ORD(101.41,ORQIEN,0),U,1))=ORQIEN
End DoDot:4
End DoDot:3
End DoDot:2
+27 SET ORCHNKBR=$$REPEAT^XLFSTR("*",30)
+28 SET ORIEN=0
FOR
SET ORIEN=$ORDER(^ORD(101.43,ORIEN))
if +$GET(ORIEN)=0!($GET(ZTSTOP))
QUIT
Begin DoDot:2
+29 IF ORIEN#1000=0
Begin DoDot:3
+30 IF $$S^%ZTLOAD
Begin DoDot:4
+31 NEW X
+32 SET ZTSTOP=1
SET X=$$S^%ZTLOAD("Received shutdown request")
End DoDot:4
End DoDot:3
if $GET(ZTSTOP)
QUIT
+33 SET ORDATE=$PIECE($GET(^ORD(101.43,ORIEN,.1)),U,1)
SET OREXIT=0
+34 IF ORDATE'=""
IF (+ORDATE<DT)
SET OREXIT=1
+35 if +$GET(OREXIT)=1
QUIT
+36 SET ORPHOI=$PIECE($GET(^ORD(101.43,ORIEN,0)),U,2)
+37 if $PIECE(ORPHOI,";",2)'="99PSP"
QUIT
+38 SET ORCHK=0
+39 DO DRGIEN^PSS50P7(+ORPHOI,,"ORSUPPLY")
+40 if +^TMP($JOB,"ORSUPPLY",0)<1
QUIT
+41 SET (ORITMHDR,ORDDHDR,ORISSUP)=0
+42 SET ORDRGIEN=0
FOR
SET ORDRGIEN=$ORDER(^TMP($JOB,"ORSUPPLY",ORDRGIEN))
if '+$GET(ORDRGIEN)
QUIT
Begin DoDot:3
+43 DO ZERO^PSS50(ORDRGIEN,,,,,"ORDRUG")
+44 if +^TMP($JOB,"ORDRUG",0)<1
QUIT
+45 IF $$ISSUPPLY(ORDRGIEN)
Begin DoDot:4
+46 IF 'ORITMHDR
DO WRAP^ORUTL($PIECE(^ORD(101.43,ORIEN,0),U,1),ORTEXT)
SET ORITMHDR=1
+47 IF 'ORDDHDR
DO WRAP^ORUTL("DISPENSE ITEM(S): "_^TMP($JOB,"ORDRUG",ORDRGIEN,.01),ORTEXT)
IF 1
SET ORDDHDR=1
+48 IF '$TEST
DO WRAP^ORUTL($$REPEAT^XLFSTR(" ",18)_^TMP($JOB,"ORDRUG",ORDRGIEN,.01),ORTEXT)
+49 SET ORISSUP=1
End DoDot:4
End DoDot:3
+50 IF ORISSUP
Begin DoDot:3
+51 DO QUICK(ORIEN,ORTEXT)
+52 DO REMIND(ORIEN,ORTEXT,"101.43^ORD(101.43,")
+53 SET @ORTEXT=@ORTEXT+1
SET @ORTEXT@(@ORTEXT)=ORCHNKBR
End DoDot:3
End DoDot:2
+54 IF +$GET(ZTSTOP)=0
Begin DoDot:2
+55 SET @ORTEXT=@ORTEXT+1
SET @ORTEXT@(@ORTEXT)=$$REPEAT^XLFSTR(" ",32)_"[END OF REPORT]"
End DoDot:2
+56 IF '$TEST
Begin DoDot:2
+57 SET @ORTEXT=@ORTEXT+1
SET @ORTEXT@(@ORTEXT)=""
+58 SET @ORTEXT=@ORTEXT+1
SET @ORTEXT@(@ORTEXT)="The quick order dialog report process has unexpectedly stopped."
+59 SET @ORTEXT=@ORTEXT+1
SET @ORTEXT@(@ORTEXT)="If you or the system manager did not stop the process, please check the"
+60 SET @ORTEXT=@ORTEXT+1
SET @ORTEXT@(@ORTEXT)="error log and file a Remedy ticket for assistance."
+61 SET @ORTEXT=@ORTEXT+1
SET @ORTEXT@(@ORTEXT)=""
End DoDot:2
End DoDot:1
+62 IF 'ORGO!($GET(ZTSTOP))
Begin DoDot:1
+63 SET @ORTEXT=@ORTEXT+1
SET @ORTEXT@(@ORTEXT)="To rerun the report, execute SODLGCON^ORY389 from the programmer prompt."
End DoDot:1
+64 KILL ^TMP($JOB,"FDATA"),^TMP($JOB,"DLG FIND")
+65 SET ORSTAT=$$MAIL^ORUTL($PIECE(ORTEXT,")",1)_",","SUPPLY ORDERABLE ITEM REPORT",,"ORY389SOIRECIPS")
+66 KILL @ORTEXT,@ORQORDER
+67 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+68 IF '$TEST
WRITE !,"Report successfully generated.",!
+69 QUIT
ISSUPPLY(ORDRGIEN) ;DETERMINE IF DRUG IS A SUPPLY ITEM
+1 ;PARAMETERS: ORDRGIEN=>DRUG IEN IN ^TMP($J,"ORDRUG") GLOBAL
+2 if "^XA^XX^"[(U_$EXTRACT(^TMP($JOB,"ORDRUG",ORDRGIEN,2),1,2)_U)!(^TMP($JOB,"ORDRUG",ORDRGIEN,2)="DX900"&($GET(^TMP($JOB,"ORDRUG",ORDRGIEN,3))["S"))
QUIT 1
+3 QUIT 0
QUICK(ORIEN,ORTEXT) ;FIND QUICK ORDERS THAT REFERENCE THE ORDERABLE ITEM
+1 ;PARAMETERS: ORIEN =>ORDERABLE ITEM IEN
+2 ; ORTEXT=>NAME OF ARRAY TO STORE OUTPUT TEXT IN
+3 NEW ORQO,ORHEADER
+4 SET ORHEADER=0
+5 SET ORQO=""
FOR
SET ORQO=$ORDER(@ORQORDER@(ORIEN,ORQO))
if $GET(ORQO)=""
QUIT
Begin DoDot:1
+6 IF 'ORHEADER
DO WRAP^ORUTL("QUICK ORDERS: "_ORQO,ORTEXT)
IF 1
SET ORHEADER=1
+7 IF '$TEST
DO WRAP^ORUTL($$REPEAT^XLFSTR(" ",14)_ORQO,ORTEXT)
+8 DO REMIND(@ORQORDER@(ORIEN,ORQO),ORTEXT,"101.41^ORD(101.41,",18)
+9 DO MENU(@ORQORDER@(ORIEN,ORQO),ORTEXT,18)
End DoDot:1
+10 QUIT
REMIND(ORITMIEN,ORTEXT,ORFILE,ORINDENT) ;FIND CLINICAL REMINDERS THAT REFERENCE THE ORDERABLE ITEM/QUICK ORDER DIALOG
+1 ;PARAMETERS: ORITMIEN=>ORDERABLE ITEM/QUICK ORDER DIALOG IEN
+2 ; ORTEXT =>NAME OF ARRAY TO STORE OUTPUT TEXT IN
+3 ; ORFILE =>DELIMITED STRING WITH FILE_NUMBER^FILE_GLOBAL_ROOT
+4 ; ORINDENT=>NUMBER OF SPACES TO INDENT TEXT; DEFAULT IS 0
+5 KILL ^TMP($JOB,"FDATA")
+6 DO BLDLIST^PXRMFRPT(+ORFILE,$PIECE(ORFILE,U,2),ORITMIEN,"FDATA")
+7 DO MSG(ORTEXT,$GET(ORINDENT,0))
+8 QUIT
MSG(TEXTOUT,ORINDENT) ;PROCESS DATA FROM BLDLIST^PXRMFRPT
+1 ;PARAMETERS: TEXTOUT =>TEXT TO OUTPUT TO THE SCREEN
+2 ; ORINDENT=>NUMBER OF SPACES TO INDENT TEXT; DEFAULT IS 0
+3 NEW DTYP,FILENUM,IND,NAME,NL,NOUT,RNUM,FI,FIEN,IEN,TEXT,TYPE,SUBHEAD
+4 NEW OUTPUT
+5 SET ORINDENT=$$REPEAT^XLFSTR(" ",$GET(ORINDENT,0))
+6 SET FILENUM=0
+7 FOR
SET FILENUM=$ORDER(^TMP($JOB,"FDATA",FILENUM))
if FILENUM=""
QUIT
Begin DoDot:1
+8 SET FIEN=0
+9 FOR
SET FIEN=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN))
if FIEN=""
QUIT
Begin DoDot:2
+10 FOR TYPE="DEF","TERM","DIALOG","ROC"
Begin DoDot:3
+11 IF '$DATA(^TMP($JOB,"FDATA",FILENUM,FIEN,TYPE))
QUIT
+12 SET RNUM=$SELECT(TYPE="DEF":811.9,TYPE="TERM":811.5,TYPE="DIALOG":801.41,TYPE="ROC":801)
+13 SET OUTPUT=ORINDENT_"REMINDER "_$SELECT(TYPE="DEF":"DEFINITIONS:",TYPE="TERM":"TERMS:",TYPE="DIALOG":"DIALOGS:",TYPE="ROC":"ORDER CHECKS:",1:"")
+14 SET IEN=0
+15 FOR
SET IEN=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,TYPE,IEN))
if IEN=""
QUIT
Begin DoDot:4
+16 SET NAME=$$GET1^DIQ(RNUM,IEN,.01)
+17 IF TYPE="DIALOG"
Begin DoDot:5
+18 SET DTYP=$PIECE(^PXRMD(801.41,IEN,0),U,4)
+19 SET OUTPUT=$GET(OUTPUT,ORINDENT)_" Dialog "_$SELECT(DTYP="E":"element",DTYP="G":"group",DTYP="S":"result group",1:"item")
+20 SET OUTPUT=OUTPUT_" "_NAME_$SELECT($PIECE(^PXRMD(801.41,IEN,0),U,3)=1:" (Disable)",1:"")_" (IEN="_IEN_")"
+21 SET OUTPUT=OUTPUT_", used in the "
+22 NEW ORITMS
+23 SET FI=0
FOR
SET FI=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,TYPE,IEN,FI))
if FI=""
QUIT
SET ORITMS=$SELECT($GET(ORITMS)'="":ORITMS_", ",1:"")_$SELECT(FI=15:"Finding Item field",FI=17:"Orderable Item field",FI=18:"Additional Finding field",FI=119:"MH Test field",1:"")
+24 DO WRAP^ORUTL(OUTPUT_$GET(ORITMS),TEXTOUT)
End DoDot:5
+25 IF TYPE'="DIALOG"
Begin DoDot:5
+26 SET OUTPUT=$GET(OUTPUT,ORINDENT)_" "_NAME_" (IEN="_IEN_", "
+27 SET (FI,SUBHEAD)=0
+28 FOR
SET FI=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,TYPE,IEN,FI))
if FI=""
QUIT
Begin DoDot:6
+29 IF 'SUBHEAD
Begin DoDot:7
+30 SET OUTPUT=OUTPUT_$SELECT(TYPE="ROC":"Rule Name ",1:"Finding number ")_FI_", "
+31 SET SUBHEAD=1
End DoDot:7
+32 IF '$TEST
SET OUTPUT=OUTPUT_FI_", "
End DoDot:6
+33 DO WRAP^ORUTL($EXTRACT(OUTPUT,1,*-2)_")",TEXTOUT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 QUIT
+1 ;PARAMETERS: ORQIEN=>QUICK ORDER DIALOG IEN
+2 ; ORTEXT=>NAME OF ARRAY TO STORE OUTPUT TEXT IN
+3 ; ORINDENT=>NUMBER OF SPACES TO INDENT TEXT; DEFAULT IS 0
+4 NEW ORIDX,HEADER,OUTPUT
+5 SET ORINDENT=$GET(ORINDENT,0)
+6 SET (ORIDX,HEADER)=0
FOR
SET ORIDX=$ORDER(^ORD(101.41,"AD",ORQIEN,ORIDX))
if +ORIDX=0
QUIT
Begin DoDot:1
+7 IF 'HEADER
SET OUTPUT=$$REPEAT^XLFSTR(" ",ORINDENT)_"ORDER MENUS: "
SET HEADER=1
+8 IF '$TEST
SET OUTPUT=$$REPEAT^XLFSTR(" ",ORINDENT+13)
+9 DO WRAP^ORUTL($GET(OUTPUT)_$PIECE($GET(^ORD(101.41,ORIDX,0)),U,1),ORTEXT)
End DoDot:1
+10 QUIT
UPDDGMAP ;Update the Pharmacy Display Group child mappings
+1 ;find the IENs of the PHARMACY, CLINIC MEDICATIONS and CLINIC INFUSIONS display groups
+2 NEW ORPHDG,ORCMDG,ORCIDG,ORZZ,ORFND,ORI,ORCSUP
+3 SET ORPHDG=$ORDER(^ORD(100.98,"B","PHARMACY",0))
+4 SET ORCMDG=$ORDER(^ORD(100.98,"B","CLINIC MEDICATIONS",0))
+5 SET ORCIDG=$ORDER(^ORD(100.98,"B","CLINIC INFUSIONS",0))
+6 SET ORCSUP=$ORDER(^ORD(100.98,"B","SUPPLIES/DEVICES",0))
+7 SET ORFND=0
SET ORI=0
FOR
SET ORI=$ORDER(^ORD(100.98,2,1,ORI))
if 'ORI
QUIT
Begin DoDot:1
+8 IF $GET(^ORD(100.98,2,1,ORI,0))=ORCMDG
SET ORFND=1
End DoDot:1
+9 IF 'ORFND
SET ORZZ(1,100.981,"+2,"_ORPHDG_",",.01)=ORCMDG
+10 SET ORFND=0
SET ORI=0
FOR
SET ORI=$ORDER(^ORD(100.98,2,1,ORI))
if 'ORI
QUIT
Begin DoDot:1
+11 IF $GET(^ORD(100.98,2,1,ORI,0))=ORCIDG
SET ORFND=1
End DoDot:1
+12 IF 'ORFND
SET ORZZ(1,100.981,"+3,"_ORPHDG_",",.01)=ORCIDG
+13 SET ORFND=0
SET ORI=0
FOR
SET ORI=$ORDER(^ORD(100.98,2,1,ORI))
if 'ORI
QUIT
Begin DoDot:1
+14 IF $GET(^ORD(100.98,2,1,ORI,0))=ORCSUP
SET ORFND=1
End DoDot:1
+15 IF 'ORFND
SET ORZZ(1,100.981,"+4,"_ORPHDG_",",.01)=ORCSUP
+16 DO UPDATE^DIE("","ORZZ(1)")
+17 QUIT
+18 ;
SENDDSPG(ANAME) ; Return true if the current display group should be sent
+1 IF ANAME="CLINIC ORDERS"
QUIT 1
+2 IF ANAME="CLINIC INFUSIONS"
QUIT 1
+3 IF ANAME="CLINIC MEDICATIONS"
QUIT 1
+4 IF ANAME="SUPPLIES/DEVICES"
QUIT 1
+5 QUIT 0
+6 ;
SENDDLG(ANAME) ; Return true if the current order dialog should be sent
+1 IF ANAME="PSJ OR CLINIC OE"
QUIT 1
+2 IF ANAME="CLINIC OR PAT FLUID OE"
QUIT 1
+3 IF ANAME="PSO SUPPLY"
QUIT 1
+4 QUIT 0
+5 ;
DLGBULL ; send bulletin about modified dialogs <on first install>
+1 NEW I,ORD
+2 FOR I="PSJ OR CLINIC OE","CLINIC OR PAT FLUID OE","PSO SUPPLY"
SET ORD(I)=""
+3 DO EN^ORYDLG(389,.ORD)
+4 QUIT
+5 ;
PARVAL ;add Clin. Inf, Clin Meds display group to SEQUENCE parameter
+1 NEW X
+2 DO DEL^XPAR("PKG","ORWOR CATEGORY SEQUENCE",69)
+3 IF $DATA(^ORD(100.98,"B","CLINIC MEDICATIONS"))
Begin DoDot:1
+4 SET X=0
SET X=$ORDER(^ORD(100.98,"B","CLINIC MEDICATIONS",X))
if 'X
QUIT
Begin DoDot:2
+5 DO PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",69,X)
End DoDot:2
End DoDot:1
+6 DO DEL^XPAR("PKG","ORWOR CATEGORY SEQUENCE",59)
+7 IF $DATA(^ORD(100.98,"B","CLINIC INFUSIONS"))
Begin DoDot:1
+8 SET X=0
SET X=$ORDER(^ORD(100.98,"B","CLINIC INFUSIONS",X))
if 'X
QUIT
Begin DoDot:2
+9 DO PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",59,X)
End DoDot:2
End DoDot:1
+10 DO DEL^XPAR("PKG","ORWOR CATEGORY SEQUENCE",130)
+11 IF $DATA(^ORD(100.98,"B","SUPPLIES/DEVICES"))
Begin DoDot:1
+12 SET X=0
SET X=$ORDER(^ORD(100.98,"B","SUPPLIES/DEVICES",X))
if 'X
QUIT
Begin DoDot:2
+13 DO PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",130,X)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
