ORY377O ;SLC/AGP - CPRS VERSION 31 QUICK ORDER CONVERSION ;02/07/19 10:59
;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
Q
AUTODC ;
N DA,DIC,DIE,ERR,EVENT,EVENTS,FDA,IENS,IEN,NAME,NODE,OI,OIS,ORMGR,DR,TEXT,X,Y
;get list orderable items
S NAME="" F S NAME=$O(^ORD(101.43,"S.DIET",NAME)) Q:NAME="" I $P(NAME," ")="NPO" D
.S IEN=0 F S IEN=$O(^ORD(101.43,"S.DIET",NAME,IEN)) Q:IEN'>0 S OIS(IEN)=NAME
; get list of Auto DC rules
S IEN=0 F S IEN=$O(^ORD(100.6,IEN)) Q:IEN'>0 D
.S NODE=$G(^ORD(100.6,IEN,0)) I "OST"'[$P(NODE,U,2) Q
.S EVENTS(IEN)=$P(NODE,U)
;process EVENTS array and update the file
S IEN=0 F S IEN=$O(EVENTS(IEN)) Q:IEN'>0 D
.K DA
.S EVENT=EVENTS(IEN),DA(1)=IEN
.K FDA
.S X=IEN
.S OI=0 F S OI=$O(OIS(OI)) Q:OI'>0 D
..S NAME=OIS(OI)
..I $D(^ORD(100.6,DA(1),8,"B",OI)) Q
..S TEXT(1)=" Adding OI "_NAME_" to "
..S TEXT(2)=" Auto-DC Rule: "_EVENT
..D MES^XPDUTL(.TEXT)
..S DIC="^ORD(100.6,"_DA(1)_",8,",X=OI,DIC(0)="L"
..L +^ORD(100.6,DA(1)):DILOCKTM
..E D MES^XPDUTL(" Cannot get lock on entry: "_EVENT) Q
..S ORMGR=1
..D FILE^DICN
..I Y=-1 D Q
...L -^ORD(100.6,DA(1))
...K TEXT
...S TEXT(1)=" Error adding OI "_NAME_" to "
...S TEXT(2)=" Auto-DC Rule: "_EVENT
...D MES^XPDUTL(.TEXT)
..;update lock field
..I $P($G(^ORD(100.6,DA(1),8,$P(Y,U),0)),U)=X S $P(^ORD(100.6,DA(1),8,$P(Y,U),0),U,2)=1
..L -^ORD(100.6,DA(1))
Q
;
EN ;
;I $$PATCH^XPDUTL("OR*3.0*377") Q
D TASK("PROCESS^ORY377O","Update to Dietetic Quick Orders")
D TASK("PSOQOUPD^ORY377O","Update to Outpatient Meds Quick Orders")
D TASK("RADQOUPD^ORY377O","Update to Radiology Quick Orders")
Q
;
TASK(ZTRTN,ZTDESC) ;
N ZTDTH,ZTSAVE,ZTIO,TEXT,ZTSK
S TEXT=" "_ZTDESC_" has been queued, task number "
S ZTIO=""
S ZTDTH=$$NOW^XLFDT
D ^%ZTLOAD
I $D(ZTSK) S TEXT=TEXT_ZTSK D MES^XPDUTL(.TEXT)
Q
;
GETTYPE(TYPE) ;
N RESULT S RESULT=$S(TYPE="Q":"Quick Order",TYPE="M":"Menu",TYPE="D":"Dialog",TYPE="O":"Order Set",TYPE="A":"Action",1:"")
Q RESULT
;
PROCESS ;
N ARRAY,CNT,DIALOG,ERRORS,IEN,INPUT,ISTUBE,LIST,NUM,NODE,ORDIEN,PROMPT,PROMPTS,PTR,PTRS,SUB
K ^XTMP("OR QO DIALOG CONVERSION CPRS 31")
S ^XTMP("OR QO DIALOG CONVERSION CPRS 31",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"CPRS 31 Quick Order Conversion"
S SUB="OR FHW QO"
K ^TMP($J,SUB)
S INPUT("FHW1")=""
S INPUT("FHW OP MEAL")=""
S INPUT("FHW8")=""
D FINDQO^ORQOUTL(.ARRAY,.INPUT,SUB,1,1)
S DIALOG="" F S DIALOG=$O(INPUT(DIALOG)) Q:DIALOG="" D
.S PROMPT=$S(DIALOG="FHW1":"OR GTX STOP DATE/TIME",1:"") I PROMPT="" Q
.S PTR=$O(^ORD(101.41,"B",PROMPT,"")) Q:PTR'>0
.S PTRS("STOP")=PTR
.S PROMPT="OR GTX CANCEL FUTURE ORDERS"
.S PTR=$O(^ORD(101.41,"B",PROMPT,"")) Q:PTR'>0
.S PTRS("CANCEL")=PTR
.S IEN=0 F S IEN=$O(^TMP($J,SUB,IEN)) Q:IEN'>0 D
..S ORDIEN=+$G(^TMP($J,SUB,IEN,"ORDIALOG")) I ORDIEN'>0 Q
..S ISTUBE=$S($P($G(^ORD(101.41,ORDIEN,0)),U)="FHW8":1,1:0)
..S PTR=$S(ISTUBE=1:PTRS("CANCEL"),ISTUBE=0:PTRS("STOP"),1:"") I PTR'>0 Q
..I $G(^TMP($J,SUB,IEN,"ORDIALOG",PTR,1))="" Q
..S NUM=+$P($G(^TMP($J,SUB,IEN,"ORDIALOG",PTR)),U)
..S NODE=$G(^TMP($J,SUB,IEN))
..S LIST($P(NODE,U),IEN)=NODE
..K ^TMP($J,"OR DESC")
..D EN^ORORDDSC(IEN,"OR DESC")
..M ^TMP($J,SUB,IEN,"BEFORE")=^TMP($J,"OR DESC",IEN)
..M ^XTMP("OR QO DIALOG CONVERSION CPRS 31",IEN)=^ORD(101.41,IEN)
..I $$UPDATE(IEN,PTR,NUM,NODE,.ERRORS)=0 K LIST($P(NODE,U),IEN),^XTMP("OR QO DIALOG CONVERSION CPRS 31",IEN) Q
..I ISTUBE=1 S $P(^ORD(101.41,IEN,0),U,8)=0,$P(^ORD(101.41,IEN,5),U,8)=""
..K ^TMP($J,"OR DESC")
..D EN^ORORDDSC(IEN,"OR DESC")
..M ^TMP($J,SUB,IEN,"AFTER")=^TMP($J,"OR DESC",IEN)
D REPORT(.LIST,.ERRORS,SUB)
K ^TMP($J,"OR DESC")
Q
;
ORDERM(SUB,IEN,CNT) ;
N NL,NODE,NOUT,P,SPACER,SPACERI,TEMP,TEXT,TEXTOUT,TYPE,X,Y
S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=$$RJ^XLFSTR("Order Menus: ",23)
S X=0,NL=0 F S X=$O(^TMP($J,SUB,IEN,"ORDER MENUS",X)) Q:X'>0 D
.S SPACER=" ",Y=""
.S NODE=$G(^TMP($J,SUB,IEN,"ORDER MENUS",X)) S TYPE=$P(NODE,U,4)
.S NL=NL+1,TEXT(NL)=SPACER_TYPE_": "_$P(NODE,U)_"\\"
.;I NL>1 S NL=NL+1,TEXT(NL)="\\"
.;S NODE=$G(^TMP($J,SUB,IEN,"ORDER MENUS",X,Y)) S TYPE=$P(NODE,U,5)
.;F S Y=$O(^TMP($J,SUB,IEN,"ORDER MENUS",X,Y)) Q:Y="" D
.;.S NODE=$G(^TMP($J,SUB,IEN,"ORDER MENUS",X,Y)) S TYPE=$P(NODE,U,5)
.;.I Y'["." S SPACER=SPACERI
.;.I Y["." D
.;..S TEMP="" F P=1:1:$L(Y,".")-1 S TEMP=TEMP_" "
.;..S SPACER=SPACERI_TEMP
.;.S NL=NL+1,TEXT(NL)=SPACER_TYPE_": "_$P(NODE,U,2)_"\\",SPACER=SPACER_" "
D FORMAT^PXRMTEXT(23,74,.NL,.TEXT,.NOUT,.TEXTOUT)
F X=1:1:NOUT S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=TEXTOUT(X)
Q
;
QO(SUB,IEN,NODE,NAME,CNT) ;
N I,NL,NOUT,TEXT,TEXTOUT,X
K TEXT S NL=1,TEXT(NL)="\\",NL=NL+1,TEXT(NL)=$$RJ^XLFSTR("Name: ",23)_NAME_" (IEN: "_IEN_")\\"
S NL=NL+1,TEXT(NL)=$$RJ^XLFSTR("Display Name: ",23)_$P(NODE,U,2)_"\\"
S NL=NL+1,TEXT(NL)=$$RJ^XLFSTR("Personal Quick Order: ",23)_$S($G(^TMP($J,SUB,IEN,"ISPERQO"))=1:"Yes",1:"No")_"\\"
D FORMAT^PXRMTEXT(1,74,.NL,.TEXT,.NOUT,.TEXTOUT)
F X=1:1:NOUT S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=TEXTOUT(X)
I $D(^TMP($J,SUB,IEN,"BEFORE")) D
.S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="Before:"
.S I=0 F S I=$O(^TMP($J,SUB,IEN,"BEFORE",I)) Q:I'>0 D
..S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=^TMP($J,SUB,IEN,"BEFORE",I)
;
I $D(^TMP($J,SUB,IEN,"AFTER")) D
.S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="After:"
.S I=0 F S I=$O(^TMP($J,SUB,IEN,"AFTER",I)) Q:I'>0 D
..S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=^TMP($J,SUB,IEN,"AFTER",I)
Q
;
REMIND(SUB,IEN,CNT) ;
N NL,NODE,NOUT,SPACER,TEXT,TEXTOUT,TYPE,X,Y
S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=$$RJ^XLFSTR("Reminder Dialogs: ",23)
S X=0,NL=0 F S X=$O(^TMP($J,SUB,IEN,"REMINDER DIALOGS",X)) Q:X'>0 D
.I NL>0 S NL=NL+1,TEXT(NL)="\\"
.S Y=0 F S Y=$O(^TMP($J,SUB,IEN,"REMINDER DIALOGS",X,Y)) Q:Y'>0 D
..S NODE=$G(^TMP($J,SUB,IEN,"REMINDER DIALOGS",X,Y))
..S NL=NL+1,TEXT(NL)=" "_NODE_"\\"
D FORMAT^PXRMTEXT(23,74,.NL,.TEXT,.NOUT,.TEXTOUT)
F X=1:1:NOUT S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=TEXTOUT(X)
Q
;
REPORT(LIST,ERRORS,SUB) ;
K ^TMP("OR MSG",$J),XMY
N CNT,I,IEN,NAME,NL,NODE,NOUT,TEXT,TEXTOUT,TYPE,SAPCER,X,XMDUZ,XMSUB,XMTEXT,Y
S CNT=0,XMDUZ="CPRS, SEARCH",XMSUB="DIETETICS 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 Dietetics Quick Orders where the expiration date"
S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="and/or the Cancel Future Tray Order was removed"
S NAME="" F S NAME=$O(LIST(NAME)) Q:NAME="" D
.S IEN=0 F S IEN=$O(LIST(NAME,IEN)) Q:IEN'>0 D
..S NODE=LIST(NAME,IEN) I '$D(^TMP($J,SUB,IEN)) Q
..D QO(SUB,IEN,NODE,NAME,.CNT)
..;
..I $D(^TMP($J,SUB,IEN,"ORDER MENUS")) D ORDERM(SUB,IEN,.CNT)
..;
..I $D(^TMP($J,SUB,IEN,"REMINDER DIALOGS")) D REMIND(SUB,IEN,.CNT)
..;W !
..;S I=0 F S I=$O(^TMP("OR MSG",$J,I)) Q:I'>0 W !,^TMP("OR MSG",$J,I,0)
I $D(ERRORS) D
.S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=" "
.S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="The following quick orders had an error."
.S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="Please inactive and replace the quick order(s) with a new one."
.S NAME="" F S NAME=$O(ERRORS(NAME)) Q:NAME="" D
..S IEN=0 F S IEN=$O(ERRORS(NAME,IEN)) Q:IEN'>0 D
...S NODE=ERRORS(NAME,IEN) I '$D(^TMP($J,SUB,IEN)) Q
...D QO(SUB,IEN,NODE,NAME,.CNT)
...;
...I $D(^TMP($J,SUB,IEN,"ORDER MENUS")) D ORDERM(SUB,IEN,.CNT)
...;
...I $D(^TMP($J,SUB,IEN,"REMINDER DIALOGS")) D REMIND(SUB,IEN,.CNT)
;
I CNT=2 S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="None Found"
D ^XMD
Q
;
UPDATE(IEN,PTR,NUM,NODE,ERRORS) ;
N ERR,FDA,ID,IENS
S ID=$O(^ORD(101.41,IEN,6,"D",PTR,"")) Q:ID'>0
S IENS=ID_","_IEN_","
S FDA(101.416,IENS,.01)=NUM
S FDA(101.416,IENS,.02)=PTR
S FDA(101.416,IENS,.03)=1
S FDA(101.416,IENS,1)=""
D FILE^DIE("","FDA","ERR")
I $D(ERR) S ERRORS($P(NODE,U),IEN)=NODE Q 0
Q 1
;
SETDG ;
N DA,DIC,ORDG,X,DLAYGO,Y,DTOUT,DUOUT
S ORDG=$O(^ORD(100.98,"B","ALL SERVICES",0)) Q:'ORDG
S X=$O(^ORD(100.98,"B","CLINIC SCHEDULING",0)),DA(1)=ORDG I 'X D MES^XPDUTL(" 'Clinic Scheduling' display group not found") Q
I $O(^ORD(100.98,DA(1),1,"B",X,0)) D MES^XPDUTL(" Display group already attached") Q ;not first install - done.
S:'$D(^ORD(100.98,DA(1),1,0)) ^(0)="^100.981P^^"
S DIC="^ORD(100.98,"_DA(1)_",1,",DIC(0)="NLX",DLAYGO=100.98
S X="CLINIC SCHEDULING" D ^DIC
Q
;
SETPAR ;
N X
I '$D(^ORD(100.98,"B","CLINIC SCHEDULING")) D MES^XPDUTL(" Display group already attached") Q
S X=0,X=$O(^ORD(100.98,"B","CLINIC SCHEDULING",X)) Q:'X D
. D PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",135,X)
;update scheduling offset parameter
D PUT^XPAR("SYS","OR SD CIDC STOP OFFSET",1,30)
Q
;
PSOQOUPD ;Clean up any Conjunction entries in Outpatient Med Quick Orders that are set to "X" for Except
;
; ZEXCEPT: ZTREQ
N ORARRAY,ORINPUT,ORIEN,ORIEN2,ORNAME,ORPROMPT,ORSUB
;
S ZTREQ="@"
S ORSUB="OR PSOQOUPD"
K ^TMP($J,ORSUB)
I '$D(^XTMP("OR OUTPATIENT MED QO CPRS 31")) D
. S $P(^XTMP("OR OUTPATIENT MED QO CPRS 31",0),U,2)=$$NOW^XLFDT
S $P(^XTMP("OR OUTPATIENT MED QO CPRS 31",0),U,1)=$$FMADD^XLFDT($$NOW^XLFDT,90)
;
S ORPROMPT=$O(^ORD(101.41,"B","OR GTX AND/THEN",""))
I ORPROMPT'>0 Q
;
S ORINPUT("PSO OERR")=""
D FINDQO^ORQOUTL(.ORARRAY,.ORINPUT,ORSUB,1,1)
;
S ORIEN=""
F S ORIEN=$O(^TMP($J,ORSUB,ORIEN)) Q:'ORIEN D
. I '$D(^ORD(101.41,ORIEN)) Q
. I '$D(^TMP($J,ORSUB,ORIEN,"ORDIALOG",ORPROMPT)) Q
. ;
. S ORIEN2=0
. F S ORIEN2=$O(^ORD(101.41,ORIEN,6,"D",ORPROMPT,ORIEN2)) Q:'ORIEN2 D
. . I $G(^ORD(101.41,ORIEN,6,ORIEN2,1))'="X" Q
. . ;
. . S ORNAME=$P($G(^ORD(101.41,ORIEN,0)),U,1)
. . I ORNAME="" Q
. . S ^TMP($J,ORSUB,"B",ORNAME,ORIEN)=""
. . ;
. . ; Before QO Capture
. . I '$D(^TMP($J,ORSUB,ORIEN,"BEFORE")) D
. . . K ^TMP($J,"OR DESC")
. . . D EN^ORORDDSC(ORIEN,"OR DESC")
. . . M ^TMP($J,ORSUB,ORIEN,"BEFORE")=^TMP($J,"OR DESC",ORIEN)
. . ;
. . ; Backup QO to XTMP
. . I '$D(^XTMP("OR OUTPATIENT MED QO CPRS 31",ORIEN)) D
. . . M ^XTMP("OR OUTPATIENT MED QO CPRS 31",ORIEN)=^ORD(101.41,ORIEN)
. . ;
. . ; Remove Except conjunction
. . S ^ORD(101.41,ORIEN,6,ORIEN2,1)=""
. . ;
. . ; After QO Capture
. . K ^TMP($J,"OR DESC")
. . D EN^ORORDDSC(ORIEN,"OR DESC")
. . M ^TMP($J,ORSUB,ORIEN,"AFTER")=^TMP($J,"OR DESC",ORIEN)
;
; Email report
D PSOQORPT(ORSUB)
;
K ^TMP($J,"OR DESC")
K ^TMP($J,ORSUB)
;
Q
;
RADQOUPD ; Update Radiology quick orders
N SUB,ARRAY,INPUT,ORPROMPT,IEN,IDX,VAL
S ORPROMPT=$O(^ORD(101.41,"B","OR GTX URGENCY",""))
I ORPROMPT'>0 Q
S SUB="OR RADQOUPD"
K ^TMP($J,SUB)
S INPUT("RA OERR EXAM")=""
D FINDQO^ORQOUTL(.ARRAY,.INPUT,SUB,0,0)
S IEN=0 F S IEN=$O(^TMP($J,SUB,IEN)) Q:IEN'>0 D
. S IDX=0 F S IDX=$O(^ORD(101.41,IEN,6,IDX)) Q:IDX'>0 D
. . I $P($G(^ORD(101.41,IEN,6,IDX,0)),U,2)'=ORPROMPT Q
. . S VAL=$G(^ORD(101.41,IEN,6,IDX,1))
. . I "^1^2^9^"[(U_VAL_U) Q ; Valid Urgencies
. . S ^ORD(101.41,IEN,6,IDX,1)=9 ; Set to Routine Urgency
K ^TMP($J,SUB)
Q
;
PSOQORPT(ORSUB) ;Send a mailman message of updated Outpatient Med QOs
;
N ORCNT,ORIEN,ORNAME,ORNODE,XMDUZ,XMSUB,XMTEXT,XMY,XMMG
;
K ^TMP("OR MSG",$J)
S ORCNT=0
;
S ORCNT=ORCNT+1,^TMP("OR MSG",$J,ORCNT,0)="The following report lists Outpatient Medication Quick Orders where the "
S ORCNT=ORCNT+1,^TMP("OR MSG",$J,ORCNT,0)="conjunction was set to EXCEPT. These Quick Orders have had the and/then "
S ORCNT=ORCNT+1,^TMP("OR MSG",$J,ORCNT,0)="prompt cleared of this value."
S ORCNT=ORCNT+1,^TMP("OR MSG",$J,ORCNT,0)=""
;
S ORNAME=""
F S ORNAME=$O(^TMP($J,ORSUB,"B",ORNAME)) Q:ORNAME="" D
. S ORIEN=0
. F S ORIEN=$O(^TMP($J,ORSUB,"B",ORNAME,ORIEN)) Q:ORIEN'>0 D
. . I '$D(^TMP($J,ORSUB,ORIEN)) Q
. . S ORNODE=$G(^TMP($J,ORSUB,ORIEN))
. . D QO(ORSUB,ORIEN,ORNODE,ORNAME,.ORCNT)
. . ;
. . I $D(^TMP($J,ORSUB,ORIEN,"ORDER MENUS")) D ORDERM(ORSUB,ORIEN,.ORCNT)
. . ;
. . I $D(^TMP($J,ORSUB,ORIEN,"REMINDER DIALOGS")) D REMIND(ORSUB,ORIEN,.ORCNT)
;
I ORCNT=4 D
. S ORCNT=ORCNT+1,^TMP("OR MSG",$J,ORCNT,0)="None Found"
;
S XMDUZ="CPRS, SEARCH"
S XMSUB="OUTPATIENT MED QUICK ORDER CONVERSION"
S XMTEXT="^TMP(""OR MSG"",$J,"
S XMY(DUZ)=""
S XMY("G.OR CACS")=""
D ^XMD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY377O 12381 printed Sep 02, 2024@19:26:55 Page 2
ORY377O ;SLC/AGP - CPRS VERSION 31 QUICK ORDER CONVERSION ;02/07/19 10:59
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
+2 QUIT
AUTODC ;
+1 NEW DA,DIC,DIE,ERR,EVENT,EVENTS,FDA,IENS,IEN,NAME,NODE,OI,OIS,ORMGR,DR,TEXT,X,Y
+2 ;get list orderable items
+3 SET NAME=""
FOR
SET NAME=$ORDER(^ORD(101.43,"S.DIET",NAME))
if NAME=""
QUIT
IF $PIECE(NAME," ")="NPO"
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(101.43,"S.DIET",NAME,IEN))
if IEN'>0
QUIT
SET OIS(IEN)=NAME
End DoDot:1
+5 ; get list of Auto DC rules
+6 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(100.6,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+7 SET NODE=$GET(^ORD(100.6,IEN,0))
IF "OST"'[$PIECE(NODE,U,2)
QUIT
+8 SET EVENTS(IEN)=$PIECE(NODE,U)
End DoDot:1
+9 ;process EVENTS array and update the file
+10 SET IEN=0
FOR
SET IEN=$ORDER(EVENTS(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+11 KILL DA
+12 SET EVENT=EVENTS(IEN)
SET DA(1)=IEN
+13 KILL FDA
+14 SET X=IEN
+15 SET OI=0
FOR
SET OI=$ORDER(OIS(OI))
if OI'>0
QUIT
Begin DoDot:2
+16 SET NAME=OIS(OI)
+17 IF $DATA(^ORD(100.6,DA(1),8,"B",OI))
QUIT
+18 SET TEXT(1)=" Adding OI "_NAME_" to "
+19 SET TEXT(2)=" Auto-DC Rule: "_EVENT
+20 DO MES^XPDUTL(.TEXT)
+21 SET DIC="^ORD(100.6,"_DA(1)_",8,"
SET X=OI
SET DIC(0)="L"
+22 LOCK +^ORD(100.6,DA(1)):DILOCKTM
+23 IF '$TEST
DO MES^XPDUTL(" Cannot get lock on entry: "_EVENT)
QUIT
+24 SET ORMGR=1
+25 DO FILE^DICN
+26 IF Y=-1
Begin DoDot:3
+27 LOCK -^ORD(100.6,DA(1))
+28 KILL TEXT
+29 SET TEXT(1)=" Error adding OI "_NAME_" to "
+30 SET TEXT(2)=" Auto-DC Rule: "_EVENT
+31 DO MES^XPDUTL(.TEXT)
End DoDot:3
QUIT
+32 ;update lock field
+33 IF $PIECE($GET(^ORD(100.6,DA(1),8,$PIECE(Y,U),0)),U)=X
SET $PIECE(^ORD(100.6,DA(1),8,$PIECE(Y,U),0),U,2)=1
+34 LOCK -^ORD(100.6,DA(1))
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
EN ;
+1 ;I $$PATCH^XPDUTL("OR*3.0*377") Q
+2 DO TASK("PROCESS^ORY377O","Update to Dietetic Quick Orders")
+3 DO TASK("PSOQOUPD^ORY377O","Update to Outpatient Meds Quick Orders")
+4 DO TASK("RADQOUPD^ORY377O","Update to Radiology Quick Orders")
+5 QUIT
+6 ;
TASK(ZTRTN,ZTDESC) ;
+1 NEW ZTDTH,ZTSAVE,ZTIO,TEXT,ZTSK
+2 SET TEXT=" "_ZTDESC_" has been queued, task number "
+3 SET ZTIO=""
+4 SET ZTDTH=$$NOW^XLFDT
+5 DO ^%ZTLOAD
+6 IF $DATA(ZTSK)
SET TEXT=TEXT_ZTSK
DO MES^XPDUTL(.TEXT)
+7 QUIT
+8 ;
GETTYPE(TYPE) ;
+1 NEW RESULT
SET RESULT=$SELECT(TYPE="Q":"Quick Order",TYPE="M":"Menu",TYPE="D":"Dialog",TYPE="O":"Order Set",TYPE="A":"Action",1:"")
+2 QUIT RESULT
+3 ;
PROCESS ;
+1 NEW ARRAY,CNT,DIALOG,ERRORS,IEN,INPUT,ISTUBE,LIST,NUM,NODE,ORDIEN,PROMPT,PROMPTS,PTR,PTRS,SUB
+2 KILL ^XTMP("OR QO DIALOG CONVERSION CPRS 31")
+3 SET ^XTMP("OR QO DIALOG CONVERSION CPRS 31",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"CPRS 31 Quick Order Conversion"
+4 SET SUB="OR FHW QO"
+5 KILL ^TMP($JOB,SUB)
+6 SET INPUT("FHW1")=""
+7 SET INPUT("FHW OP MEAL")=""
+8 SET INPUT("FHW8")=""
+9 DO FINDQO^ORQOUTL(.ARRAY,.INPUT,SUB,1,1)
+10 SET DIALOG=""
FOR
SET DIALOG=$ORDER(INPUT(DIALOG))
if DIALOG=""
QUIT
Begin DoDot:1
+11 SET PROMPT=$SELECT(DIALOG="FHW1":"OR GTX STOP DATE/TIME",1:"")
IF PROMPT=""
QUIT
+12 SET PTR=$ORDER(^ORD(101.41,"B",PROMPT,""))
if PTR'>0
QUIT
+13 SET PTRS("STOP")=PTR
+14 SET PROMPT="OR GTX CANCEL FUTURE ORDERS"
+15 SET PTR=$ORDER(^ORD(101.41,"B",PROMPT,""))
if PTR'>0
QUIT
+16 SET PTRS("CANCEL")=PTR
+17 SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,SUB,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+18 SET ORDIEN=+$GET(^TMP($JOB,SUB,IEN,"ORDIALOG"))
IF ORDIEN'>0
QUIT
+19 SET ISTUBE=$SELECT($PIECE($GET(^ORD(101.41,ORDIEN,0)),U)="FHW8":1,1:0)
+20 SET PTR=$SELECT(ISTUBE=1:PTRS("CANCEL"),ISTUBE=0:PTRS("STOP"),1:"")
IF PTR'>0
QUIT
+21 IF $GET(^TMP($JOB,SUB,IEN,"ORDIALOG",PTR,1))=""
QUIT
+22 SET NUM=+$PIECE($GET(^TMP($JOB,SUB,IEN,"ORDIALOG",PTR)),U)
+23 SET NODE=$GET(^TMP($JOB,SUB,IEN))
+24 SET LIST($PIECE(NODE,U),IEN)=NODE
+25 KILL ^TMP($JOB,"OR DESC")
+26 DO EN^ORORDDSC(IEN,"OR DESC")
+27 MERGE ^TMP($JOB,SUB,IEN,"BEFORE")=^TMP($JOB,"OR DESC",IEN)
+28 MERGE ^XTMP("OR QO DIALOG CONVERSION CPRS 31",IEN)=^ORD(101.41,IEN)
+29 IF $$UPDATE(IEN,PTR,NUM,NODE,.ERRORS)=0
KILL LIST($PIECE(NODE,U),IEN),^XTMP("OR QO DIALOG CONVERSION CPRS 31",IEN)
QUIT
+30 IF ISTUBE=1
SET $PIECE(^ORD(101.41,IEN,0),U,8)=0
SET $PIECE(^ORD(101.41,IEN,5),U,8)=""
+31 KILL ^TMP($JOB,"OR DESC")
+32 DO EN^ORORDDSC(IEN,"OR DESC")
+33 MERGE ^TMP($JOB,SUB,IEN,"AFTER")=^TMP($JOB,"OR DESC",IEN)
End DoDot:2
End DoDot:1
+34 DO REPORT(.LIST,.ERRORS,SUB)
+35 KILL ^TMP($JOB,"OR DESC")
+36 QUIT
+37 ;
ORDERM(SUB,IEN,CNT) ;
+1 NEW NL,NODE,NOUT,P,SPACER,SPACERI,TEMP,TEXT,TEXTOUT,TYPE,X,Y
+2 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=$$RJ^XLFSTR("Order Menus: ",23)
+3 SET X=0
SET NL=0
FOR
SET X=$ORDER(^TMP($JOB,SUB,IEN,"ORDER MENUS",X))
if X'>0
QUIT
Begin DoDot:1
+4 SET SPACER=" "
SET Y=""
+5 SET NODE=$GET(^TMP($JOB,SUB,IEN,"ORDER MENUS",X))
SET TYPE=$PIECE(NODE,U,4)
+6 SET NL=NL+1
SET TEXT(NL)=SPACER_TYPE_": "_$PIECE(NODE,U)_"\\"
+7 ;I NL>1 S NL=NL+1,TEXT(NL)="\\"
+8 ;S NODE=$G(^TMP($J,SUB,IEN,"ORDER MENUS",X,Y)) S TYPE=$P(NODE,U,5)
+9 ;F S Y=$O(^TMP($J,SUB,IEN,"ORDER MENUS",X,Y)) Q:Y="" D
+10 ;.S NODE=$G(^TMP($J,SUB,IEN,"ORDER MENUS",X,Y)) S TYPE=$P(NODE,U,5)
+11 ;.I Y'["." S SPACER=SPACERI
+12 ;.I Y["." D
+13 ;..S TEMP="" F P=1:1:$L(Y,".")-1 S TEMP=TEMP_" "
+14 ;..S SPACER=SPACERI_TEMP
+15 ;.S NL=NL+1,TEXT(NL)=SPACER_TYPE_": "_$P(NODE,U,2)_"\\",SPACER=SPACER_" "
End DoDot:1
+16 DO FORMAT^PXRMTEXT(23,74,.NL,.TEXT,.NOUT,.TEXTOUT)
+17 FOR X=1:1:NOUT
SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=TEXTOUT(X)
+18 QUIT
+19 ;
QO(SUB,IEN,NODE,NAME,CNT) ;
+1 NEW I,NL,NOUT,TEXT,TEXTOUT,X
+2 KILL TEXT
SET NL=1
SET TEXT(NL)="\\"
SET NL=NL+1
SET TEXT(NL)=$$RJ^XLFSTR("Name: ",23)_NAME_" (IEN: "_IEN_")\\"
+3 SET NL=NL+1
SET TEXT(NL)=$$RJ^XLFSTR("Display Name: ",23)_$PIECE(NODE,U,2)_"\\"
+4 SET NL=NL+1
SET TEXT(NL)=$$RJ^XLFSTR("Personal Quick Order: ",23)_$SELECT($GET(^TMP($JOB,SUB,IEN,"ISPERQO"))=1:"Yes",1:"No")_"\\"
+5 DO FORMAT^PXRMTEXT(1,74,.NL,.TEXT,.NOUT,.TEXTOUT)
+6 FOR X=1:1:NOUT
SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=TEXTOUT(X)
+7 IF $DATA(^TMP($JOB,SUB,IEN,"BEFORE"))
Begin DoDot:1
+8 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="Before:"
+9 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,SUB,IEN,"BEFORE",I))
if I'>0
QUIT
Begin DoDot:2
+10 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=^TMP($JOB,SUB,IEN,"BEFORE",I)
End DoDot:2
End DoDot:1
+11 ;
+12 IF $DATA(^TMP($JOB,SUB,IEN,"AFTER"))
Begin DoDot:1
+13 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="After:"
+14 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,SUB,IEN,"AFTER",I))
if I'>0
QUIT
Begin DoDot:2
+15 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=^TMP($JOB,SUB,IEN,"AFTER",I)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
REMIND(SUB,IEN,CNT) ;
+1 NEW NL,NODE,NOUT,SPACER,TEXT,TEXTOUT,TYPE,X,Y
+2 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=$$RJ^XLFSTR("Reminder Dialogs: ",23)
+3 SET X=0
SET NL=0
FOR
SET X=$ORDER(^TMP($JOB,SUB,IEN,"REMINDER DIALOGS",X))
if X'>0
QUIT
Begin DoDot:1
+4 IF NL>0
SET NL=NL+1
SET TEXT(NL)="\\"
+5 SET Y=0
FOR
SET Y=$ORDER(^TMP($JOB,SUB,IEN,"REMINDER DIALOGS",X,Y))
if Y'>0
QUIT
Begin DoDot:2
+6 SET NODE=$GET(^TMP($JOB,SUB,IEN,"REMINDER DIALOGS",X,Y))
+7 SET NL=NL+1
SET TEXT(NL)=" "_NODE_"\\"
End DoDot:2
End DoDot:1
+8 DO FORMAT^PXRMTEXT(23,74,.NL,.TEXT,.NOUT,.TEXTOUT)
+9 FOR X=1:1:NOUT
SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=TEXTOUT(X)
+10 QUIT
+11 ;
REPORT(LIST,ERRORS,SUB) ;
+1 KILL ^TMP("OR MSG",$JOB),XMY
+2 NEW CNT,I,IEN,NAME,NL,NODE,NOUT,TEXT,TEXTOUT,TYPE,SAPCER,X,XMDUZ,XMSUB,XMTEXT,Y
+3 SET CNT=0
SET XMDUZ="CPRS, SEARCH"
SET XMSUB="DIETETICS 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 Dietetics Quick Orders where the expiration date"
+5 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="and/or the Cancel Future Tray Order was removed"
+6 SET NAME=""
FOR
SET NAME=$ORDER(LIST(NAME))
if NAME=""
QUIT
Begin DoDot:1
+7 SET IEN=0
FOR
SET IEN=$ORDER(LIST(NAME,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+8 SET NODE=LIST(NAME,IEN)
IF '$DATA(^TMP($JOB,SUB,IEN))
QUIT
+9 DO QO(SUB,IEN,NODE,NAME,.CNT)
+10 ;
+11 IF $DATA(^TMP($JOB,SUB,IEN,"ORDER MENUS"))
DO ORDERM(SUB,IEN,.CNT)
+12 ;
+13 IF $DATA(^TMP($JOB,SUB,IEN,"REMINDER DIALOGS"))
DO REMIND(SUB,IEN,.CNT)
+14 ;W !
+15 ;S I=0 F S I=$O(^TMP("OR MSG",$J,I)) Q:I'>0 W !,^TMP("OR MSG",$J,I,0)
End DoDot:2
End DoDot:1
+16 IF $DATA(ERRORS)
Begin DoDot:1
+17 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=" "
+18 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="The following quick orders had an error."
+19 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="Please inactive and replace the quick order(s) with a new one."
+20 SET NAME=""
FOR
SET NAME=$ORDER(ERRORS(NAME))
if NAME=""
QUIT
Begin DoDot:2
+21 SET IEN=0
FOR
SET IEN=$ORDER(ERRORS(NAME,IEN))
if IEN'>0
QUIT
Begin DoDot:3
+22 SET NODE=ERRORS(NAME,IEN)
IF '$DATA(^TMP($JOB,SUB,IEN))
QUIT
+23 DO QO(SUB,IEN,NODE,NAME,.CNT)
+24 ;
+25 IF $DATA(^TMP($JOB,SUB,IEN,"ORDER MENUS"))
DO ORDERM(SUB,IEN,.CNT)
+26 ;
+27 IF $DATA(^TMP($JOB,SUB,IEN,"REMINDER DIALOGS"))
DO REMIND(SUB,IEN,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
+29 IF CNT=2
SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="None Found"
+30 DO ^XMD
+31 QUIT
+32 ;
UPDATE(IEN,PTR,NUM,NODE,ERRORS) ;
+1 NEW ERR,FDA,ID,IENS
+2 SET ID=$ORDER(^ORD(101.41,IEN,6,"D",PTR,""))
if ID'>0
QUIT
+3 SET IENS=ID_","_IEN_","
+4 SET FDA(101.416,IENS,.01)=NUM
+5 SET FDA(101.416,IENS,.02)=PTR
+6 SET FDA(101.416,IENS,.03)=1
+7 SET FDA(101.416,IENS,1)=""
+8 DO FILE^DIE("","FDA","ERR")
+9 IF $DATA(ERR)
SET ERRORS($PIECE(NODE,U),IEN)=NODE
QUIT 0
+10 QUIT 1
+11 ;
SETDG ;
+1 NEW DA,DIC,ORDG,X,DLAYGO,Y,DTOUT,DUOUT
+2 SET ORDG=$ORDER(^ORD(100.98,"B","ALL SERVICES",0))
if 'ORDG
QUIT
+3 SET X=$ORDER(^ORD(100.98,"B","CLINIC SCHEDULING",0))
SET DA(1)=ORDG
IF 'X
DO MES^XPDUTL(" 'Clinic Scheduling' display group not found")
QUIT
+4 ;not first install - done.
IF $ORDER(^ORD(100.98,DA(1),1,"B",X,0))
DO MES^XPDUTL(" Display group already attached")
QUIT
+5 if '$DATA(^ORD(100.98,DA(1),1,0))
SET ^(0)="^100.981P^^"
+6 SET DIC="^ORD(100.98,"_DA(1)_",1,"
SET DIC(0)="NLX"
SET DLAYGO=100.98
+7 SET X="CLINIC SCHEDULING"
DO ^DIC
+8 QUIT
+9 ;
SETPAR ;
+1 NEW X
+2 IF '$DATA(^ORD(100.98,"B","CLINIC SCHEDULING"))
DO MES^XPDUTL(" Display group already attached")
QUIT
+3 SET X=0
SET X=$ORDER(^ORD(100.98,"B","CLINIC SCHEDULING",X))
if 'X
QUIT
Begin DoDot:1
+4 DO PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",135,X)
End DoDot:1
+5 ;update scheduling offset parameter
+6 DO PUT^XPAR("SYS","OR SD CIDC STOP OFFSET",1,30)
+7 QUIT
+8 ;
PSOQOUPD ;Clean up any Conjunction entries in Outpatient Med Quick Orders that are set to "X" for Except
+1 ;
+2 ; ZEXCEPT: ZTREQ
+3 NEW ORARRAY,ORINPUT,ORIEN,ORIEN2,ORNAME,ORPROMPT,ORSUB
+4 ;
+5 SET ZTREQ="@"
+6 SET ORSUB="OR PSOQOUPD"
+7 KILL ^TMP($JOB,ORSUB)
+8 IF '$DATA(^XTMP("OR OUTPATIENT MED QO CPRS 31"))
Begin DoDot:1
+9 SET $PIECE(^XTMP("OR OUTPATIENT MED QO CPRS 31",0),U,2)=$$NOW^XLFDT
End DoDot:1
+10 SET $PIECE(^XTMP("OR OUTPATIENT MED QO CPRS 31",0),U,1)=$$FMADD^XLFDT($$NOW^XLFDT,90)
+11 ;
+12 SET ORPROMPT=$ORDER(^ORD(101.41,"B","OR GTX AND/THEN",""))
+13 IF ORPROMPT'>0
QUIT
+14 ;
+15 SET ORINPUT("PSO OERR")=""
+16 DO FINDQO^ORQOUTL(.ORARRAY,.ORINPUT,ORSUB,1,1)
+17 ;
+18 SET ORIEN=""
+19 FOR
SET ORIEN=$ORDER(^TMP($JOB,ORSUB,ORIEN))
if 'ORIEN
QUIT
Begin DoDot:1
+20 IF '$DATA(^ORD(101.41,ORIEN))
QUIT
+21 IF '$DATA(^TMP($JOB,ORSUB,ORIEN,"ORDIALOG",ORPROMPT))
QUIT
+22 ;
+23 SET ORIEN2=0
+24 FOR
SET ORIEN2=$ORDER(^ORD(101.41,ORIEN,6,"D",ORPROMPT,ORIEN2))
if 'ORIEN2
QUIT
Begin DoDot:2
+25 IF $GET(^ORD(101.41,ORIEN,6,ORIEN2,1))'="X"
QUIT
+26 ;
+27 SET ORNAME=$PIECE($GET(^ORD(101.41,ORIEN,0)),U,1)
+28 IF ORNAME=""
QUIT
+29 SET ^TMP($JOB,ORSUB,"B",ORNAME,ORIEN)=""
+30 ;
+31 ; Before QO Capture
+32 IF '$DATA(^TMP($JOB,ORSUB,ORIEN,"BEFORE"))
Begin DoDot:3
+33 KILL ^TMP($JOB,"OR DESC")
+34 DO EN^ORORDDSC(ORIEN,"OR DESC")
+35 MERGE ^TMP($JOB,ORSUB,ORIEN,"BEFORE")=^TMP($JOB,"OR DESC",ORIEN)
End DoDot:3
+36 ;
+37 ; Backup QO to XTMP
+38 IF '$DATA(^XTMP("OR OUTPATIENT MED QO CPRS 31",ORIEN))
Begin DoDot:3
+39 MERGE ^XTMP("OR OUTPATIENT MED QO CPRS 31",ORIEN)=^ORD(101.41,ORIEN)
End DoDot:3
+40 ;
+41 ; Remove Except conjunction
+42 SET ^ORD(101.41,ORIEN,6,ORIEN2,1)=""
+43 ;
+44 ; After QO Capture
+45 KILL ^TMP($JOB,"OR DESC")
+46 DO EN^ORORDDSC(ORIEN,"OR DESC")
+47 MERGE ^TMP($JOB,ORSUB,ORIEN,"AFTER")=^TMP($JOB,"OR DESC",ORIEN)
End DoDot:2
End DoDot:1
+48 ;
+49 ; Email report
+50 DO PSOQORPT(ORSUB)
+51 ;
+52 KILL ^TMP($JOB,"OR DESC")
+53 KILL ^TMP($JOB,ORSUB)
+54 ;
+55 QUIT
+56 ;
RADQOUPD ; Update Radiology quick orders
+1 NEW SUB,ARRAY,INPUT,ORPROMPT,IEN,IDX,VAL
+2 SET ORPROMPT=$ORDER(^ORD(101.41,"B","OR GTX URGENCY",""))
+3 IF ORPROMPT'>0
QUIT
+4 SET SUB="OR RADQOUPD"
+5 KILL ^TMP($JOB,SUB)
+6 SET INPUT("RA OERR EXAM")=""
+7 DO FINDQO^ORQOUTL(.ARRAY,.INPUT,SUB,0,0)
+8 SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,SUB,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+9 SET IDX=0
FOR
SET IDX=$ORDER(^ORD(101.41,IEN,6,IDX))
if IDX'>0
QUIT
Begin DoDot:2
+10 IF $PIECE($GET(^ORD(101.41,IEN,6,IDX,0)),U,2)'=ORPROMPT
QUIT
+11 SET VAL=$GET(^ORD(101.41,IEN,6,IDX,1))
+12 ; Valid Urgencies
IF "^1^2^9^"[(U_VAL_U)
QUIT
+13 ; Set to Routine Urgency
SET ^ORD(101.41,IEN,6,IDX,1)=9
End DoDot:2
End DoDot:1
+14 KILL ^TMP($JOB,SUB)
+15 QUIT
+16 ;
PSOQORPT(ORSUB) ;Send a mailman message of updated Outpatient Med QOs
+1 ;
+2 NEW ORCNT,ORIEN,ORNAME,ORNODE,XMDUZ,XMSUB,XMTEXT,XMY,XMMG
+3 ;
+4 KILL ^TMP("OR MSG",$JOB)
+5 SET ORCNT=0
+6 ;
+7 SET ORCNT=ORCNT+1
SET ^TMP("OR MSG",$JOB,ORCNT,0)="The following report lists Outpatient Medication Quick Orders where the "
+8 SET ORCNT=ORCNT+1
SET ^TMP("OR MSG",$JOB,ORCNT,0)="conjunction was set to EXCEPT. These Quick Orders have had the and/then "
+9 SET ORCNT=ORCNT+1
SET ^TMP("OR MSG",$JOB,ORCNT,0)="prompt cleared of this value."
+10 SET ORCNT=ORCNT+1
SET ^TMP("OR MSG",$JOB,ORCNT,0)=""
+11 ;
+12 SET ORNAME=""
+13 FOR
SET ORNAME=$ORDER(^TMP($JOB,ORSUB,"B",ORNAME))
if ORNAME=""
QUIT
Begin DoDot:1
+14 SET ORIEN=0
+15 FOR
SET ORIEN=$ORDER(^TMP($JOB,ORSUB,"B",ORNAME,ORIEN))
if ORIEN'>0
QUIT
Begin DoDot:2
+16 IF '$DATA(^TMP($JOB,ORSUB,ORIEN))
QUIT
+17 SET ORNODE=$GET(^TMP($JOB,ORSUB,ORIEN))
+18 DO QO(ORSUB,ORIEN,ORNODE,ORNAME,.ORCNT)
+19 ;
+20 IF $DATA(^TMP($JOB,ORSUB,ORIEN,"ORDER MENUS"))
DO ORDERM(ORSUB,ORIEN,.ORCNT)
+21 ;
+22 IF $DATA(^TMP($JOB,ORSUB,ORIEN,"REMINDER DIALOGS"))
DO REMIND(ORSUB,ORIEN,.ORCNT)
End DoDot:2
End DoDot:1
+23 ;
+24 IF ORCNT=4
Begin DoDot:1
+25 SET ORCNT=ORCNT+1
SET ^TMP("OR MSG",$JOB,ORCNT,0)="None Found"
End DoDot:1
+26 ;
+27 SET XMDUZ="CPRS, SEARCH"
+28 SET XMSUB="OUTPATIENT MED QUICK ORDER CONVERSION"
+29 SET XMTEXT="^TMP(""OR MSG"",$J,"
+30 SET XMY(DUZ)=""
+31 SET XMY("G.OR CACS")=""
+32 DO ^XMD
+33 ;
+34 QUIT
