ORY389A ;SLC/JLC-Search through Outpatient Pharmacy Quick Orders ;04/27/2015 13:42
;;3.0;ORDER ENTRY/RESULTS REPORTING;**389**;Dec 17, 1997;Build 17
;
;Reference to PXRMD(801.41 supported by ICR #4097
;Reference to DIC(9.4 supported by ICR #2058
;
Q
EN ; -- main entry point
S:$D(ZTQUEUED) ZTREQ="@"
N CREAT,EXPR,ORPSO,ORURG,ORDUO,ORDONE,S1,A,B,%,X
D NOW^%DTC S CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0) K ^XTMP("ORY389A"),^TMP($J)
N DIEN,AFIND,TEXT,TYPE
F TYPE="G","E" D
. S DIEN="" F S DIEN=$O(^PXRMD(801.41,"TYPE",TYPE,DIEN)) Q:DIEN'>0 D
.. S TEXT=$P($G(^PXRMD(801.41,DIEN,1)),U,5)
.. I TEXT[101.41 S ^TMP($J,$P(TEXT,";"))=""
.. S AFIND="" F S AFIND=$O(^PXRMD(801.41,DIEN,3,"B",AFIND)) Q:AFIND="" D
... I AFIND'[101.41 Q
... S ^TMP($J,$P(AFIND,";"))=""
S ORPSO=$O(^DIC(9.4,"B","OUTPATIENT PHARMACY",""))
S ORURG=$O(^ORD(101.41,"B","OR GTX URGENCY",""))
S ORDONE=$O(^ORD(101.42,"S.PSO","DONE",""))
I ORDONE="" S ^XTMP("ORY389A",1)="No Priority of DONE on system." D SEND K ZTQUEUED,ZTREQ Q
S ORD=0
F S ORD=$O(^ORD(101.41,ORD)) Q:'ORD S A=$G(^(ORD,0)) I $P(A,"^",4)="Q",$P(A,"^",7)=ORPSO D
. S ORDUO=""
. S S1=0 F S S1=$O(^ORD(101.41,ORD,6,S1)) Q:'S1 S B=$G(^(S1,0)) I $P(B,"^",2)=ORURG D
.. I $G(^ORD(101.41,ORD,6,S1,1))'=ORDONE Q
.. S ^XTMP("ORY389A",ORD)=$P(A,"^")_"^"_$P(A,"^",3)
I $D(^XTMP("ORY389A")) S ^XTMP("ORY389A",0)=EXPR_"^"_CREAT
D SEND
K ZTQUEUED,ZTREQ Q
SEND ;Send message
N OCNT,ORD,A,S1,H1,H2,H3,ORSTAT,ORMSGT
S ORMSGT(1,0)=" The check of Outpatient Pharmacy Quick Orders is complete."
S ORMSGT(2,0)=" ",ORMSGT(3,0)=" Here is the list of all quick orders that should be reviewed and/or updated: ",ORMSGT(4,0)=" "
S ORD=0,ORMSGT(5,0)="Quick Order Name Disable Text Ancestors/Menus or Reminders"
S ORMSGT(6,0)=" ",OCNT=6
F S ORD=$O(^XTMP("ORY389A",ORD)) Q:ORD="" S A=^(ORD) D
. S OCNT=OCNT+1,ORMSGT(OCNT,0)=$E($P(A,"^")_$J(" ",38),1,37)_" "_$E($P(A,"^",2)_$J(" ",38),1,15)_" ",(H1,H2,H3)=""
. I $D(^TMP($J,ORD)) S H2="Used in Clinical Reminders Dialog"
. I $D(^ORD(101.41,"AD",ORD)) S H3="On a menu or in an order set"
. I H2]"" S ORMSGT(OCNT,0)=ORMSGT(OCNT,0)_H2
. I H3]"" S:$L(ORMSGT(OCNT,0))>97 OCNT=OCNT+1,ORMSGT(OCNT,0)=$J(" ",97) S ORMSGT(OCNT,0)=ORMSGT(OCNT,0)_H3
. S OCNT=OCNT+1,ORMSGT(OCNT,0)=" "
S ORSTAT=$$MAIL^ORUTL("ORMSGT(","OUTPATIENT PHARMACY QUICK ORDERS",,"ORY389OQORECIPS")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY389A 2453 printed Nov 22, 2024@17:51:36 Page 2
ORY389A ;SLC/JLC-Search through Outpatient Pharmacy Quick Orders ;04/27/2015 13:42
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**389**;Dec 17, 1997;Build 17
+2 ;
+3 ;Reference to PXRMD(801.41 supported by ICR #4097
+4 ;Reference to DIC(9.4 supported by ICR #2058
+5 ;
+6 QUIT
EN ; -- main entry point
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 NEW CREAT,EXPR,ORPSO,ORURG,ORDUO,ORDONE,S1,A,B,%,X
+3 DO NOW^%DTC
SET CREAT=$EXTRACT(%,1,7)
SET EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0)
KILL ^XTMP("ORY389A"),^TMP($JOB)
+4 NEW DIEN,AFIND,TEXT,TYPE
+5 FOR TYPE="G","E"
Begin DoDot:1
+6 SET DIEN=""
FOR
SET DIEN=$ORDER(^PXRMD(801.41,"TYPE",TYPE,DIEN))
if DIEN'>0
QUIT
Begin DoDot:2
+7 SET TEXT=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)
+8 IF TEXT[101.41
SET ^TMP($JOB,$PIECE(TEXT,";"))=""
+9 SET AFIND=""
FOR
SET AFIND=$ORDER(^PXRMD(801.41,DIEN,3,"B",AFIND))
if AFIND=""
QUIT
Begin DoDot:3
+10 IF AFIND'[101.41
QUIT
+11 SET ^TMP($JOB,$PIECE(AFIND,";"))=""
End DoDot:3
End DoDot:2
End DoDot:1
+12 SET ORPSO=$ORDER(^DIC(9.4,"B","OUTPATIENT PHARMACY",""))
+13 SET ORURG=$ORDER(^ORD(101.41,"B","OR GTX URGENCY",""))
+14 SET ORDONE=$ORDER(^ORD(101.42,"S.PSO","DONE",""))
+15 IF ORDONE=""
SET ^XTMP("ORY389A",1)="No Priority of DONE on system."
DO SEND
KILL ZTQUEUED,ZTREQ
QUIT
+16 SET ORD=0
+17 FOR
SET ORD=$ORDER(^ORD(101.41,ORD))
if 'ORD
QUIT
SET A=$GET(^(ORD,0))
IF $PIECE(A,"^",4)="Q"
IF $PIECE(A,"^",7)=ORPSO
Begin DoDot:1
+18 SET ORDUO=""
+19 SET S1=0
FOR
SET S1=$ORDER(^ORD(101.41,ORD,6,S1))
if 'S1
QUIT
SET B=$GET(^(S1,0))
IF $PIECE(B,"^",2)=ORURG
Begin DoDot:2
+20 IF $GET(^ORD(101.41,ORD,6,S1,1))'=ORDONE
QUIT
+21 SET ^XTMP("ORY389A",ORD)=$PIECE(A,"^")_"^"_$PIECE(A,"^",3)
End DoDot:2
End DoDot:1
+22 IF $DATA(^XTMP("ORY389A"))
SET ^XTMP("ORY389A",0)=EXPR_"^"_CREAT
+23 DO SEND
+24 KILL ZTQUEUED,ZTREQ
QUIT
SEND ;Send message
+1 NEW OCNT,ORD,A,S1,H1,H2,H3,ORSTAT,ORMSGT
+2 SET ORMSGT(1,0)=" The check of Outpatient Pharmacy Quick Orders is complete."
+3 SET ORMSGT(2,0)=" "
SET ORMSGT(3,0)=" Here is the list of all quick orders that should be reviewed and/or updated: "
SET ORMSGT(4,0)=" "
+4 SET ORD=0
SET ORMSGT(5,0)="Quick Order Name Disable Text Ancestors/Menus or Reminders"
+5 SET ORMSGT(6,0)=" "
SET OCNT=6
+6 FOR
SET ORD=$ORDER(^XTMP("ORY389A",ORD))
if ORD=""
QUIT
SET A=^(ORD)
Begin DoDot:1
+7 SET OCNT=OCNT+1
SET ORMSGT(OCNT,0)=$EXTRACT($PIECE(A,"^")_$JUSTIFY(" ",38),1,37)_" "_$EXTRACT($PIECE(A,"^",2)_$JUSTIFY(" ",38),1,15)_" "
SET (H1,H2,H3)=""
+8 IF $DATA(^TMP($JOB,ORD))
SET H2="Used in Clinical Reminders Dialog"
+9 IF $DATA(^ORD(101.41,"AD",ORD))
SET H3="On a menu or in an order set"
+10 IF H2]""
SET ORMSGT(OCNT,0)=ORMSGT(OCNT,0)_H2
+11 IF H3]""
if $LENGTH(ORMSGT(OCNT,0))>97
SET OCNT=OCNT+1
SET ORMSGT(OCNT,0)=$JUSTIFY(" ",97)
SET ORMSGT(OCNT,0)=ORMSGT(OCNT,0)_H3
+12 SET OCNT=OCNT+1
SET ORMSGT(OCNT,0)=" "
End DoDot:1
+13 SET ORSTAT=$$MAIL^ORUTL("ORMSGT(","OUTPATIENT PHARMACY QUICK ORDERS",,"ORY389OQORECIPS")
+14 QUIT
