ORQOUTL ; SLC/AGP - Utility report for Order Dialogs ;Dec 08, 2021@10:59:06
;;3.0;ORDER ENTRY/RESULTS REPORTING;**377,405**;DEC 17, 1997;Build 211
;
;
;
Q
;
FINDOD(RESULT,INPUT,SUB) ;
K ^TMP($J,SUB),^TMP($J,"DIALOGS")
N NAME,ODIEN
S RESULT=$NA(^TMP($J,SUB))
S NAME="" F S NAME=$O(INPUT(NAME)) Q:NAME="" D
.S ODIEN=$O(^ORD(101.41,"B",NAME,"")) Q:ODIEN=""
.S ORREM(ODIEN_";ORD(101.41,")=""
.S ^TMP($J,SUB,ODIEN)=NAME
.D FINDORD(ODIEN,SUB)
D FINDREM(SUB,.ORREM)
Q
;
FINDOPAR(RESULT,IEN) ;
N CNT,ITEM,NODE,SUB
K ^TMP($J,"ORDER MENU ON LIST")
S SUB="OR REM ITEMS"
D FINDRORD(IEN,SUB)
S CNT=0 F S CNT=$O(^TMP($J,SUB,IEN,"ORDER MENUS",CNT)) Q:CNT'>0 D
.S NODE=$G(^TMP($J,SUB,IEN,"ORDER MENUS",CNT))
.S ITEM=$O(^ORD(101.41,"B",$P(NODE,U),"")) Q:IEN'>0
.S RESULT(ITEM)=NODE
Q
FINDQO(RESULT,INPUT,SUB,RETMENU,RETSTRCT,SPINNER,SKIPDIS) ;
N CNT,DSGPAR,DSGRP,I,J,NAME,NODE,ODIEN,OIIEN,ORDIALOG,ORREM,ORTYPE,PERQOAR,ORREMD,QOIEN
N SPINCNT,TEMP,X,Y
K ^TMP($J,SUB),^TMP($J,"DIALOGS")
S SPINCNT=0
S RESULT=$NA(^TMP($J,SUB))
;Build a list of Display Groups that contains the default dialog defined in INPUT
S NAME="" F S NAME=$O(INPUT(NAME)) Q:NAME="" D
.S ODIEN=$O(^ORD(101.41,"AB",NAME,"")) Q:ODIEN=""
.S DSGRP=0 F S DSGRP=$O(^ORD(100.98,DSGRP)) Q:DSGRP'>0 D
..I $P(^ORD(100.98,DSGRP,0),U,4)=ODIEN S DSGPAR(DSGRP,NAME)=""
;
S OIIEN=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM","")) Q:OIIEN'>0
S QOIEN=0 F S QOIEN=$O(^ORD(101.41,QOIEN)) Q:QOIEN'>0 D
.I SKIPDIS=1,$P($G(^ORD(101.41,QOIEN,0)),U,3)'="" Q
.I $$ISVALID(QOIEN,.DSGPAR)=0 Q
.I SPINNER D SPIN("Finding Quick Orders",.SPINCNT)
.S NODE=$G(^ORD(101.41,QOIEN,0))
.S ^TMP($J,SUB,QOIEN)=$P(NODE,U,1,4)
.S ^TMP($J,SUB,QOIEN,"ISPERQO")=$S($D(^ORD(101.44,"C",QOIEN)):1,1:0)
.S ORREM(QOIEN_";ORD(101.41,")=""
.I $G(RETSTRCT)=0 Q
.S ORTYPE="Z"
.K ORDIALOG
.D GETQDLG^ORCD(QOIEN)
.;D GETQDLG(QOIEN)
.M ^TMP($J,SUB,QOIEN,"ORDIALOG")=ORDIALOG
;
I RETMENU=0 G FINDQOX
;find menu structure order dialog exists on
S QOIEN=0 F S QOIEN=$O(^TMP($J,SUB,QOIEN)) Q:QOIEN'>0 D
.I SPINNER D SPIN("Finding Quick Orders",.SPINCNT)
.D FINDORD(QOIEN,SUB)
;find reminder dialogs order dialog exisits on
D FINDREM(SUB,.ORREM,SPINNER)
FINDQOX ;
K ^TMP($J,"DIALOGS")
Q
;
FINDORD(QOIEN,SUB) ;
N CNT,IEN,LIST,NODE,TIEN,TOP
S IEN=0,CNT=0 F S IEN=$O(^ORD(101.41,"AD",QOIEN,IEN)) Q:IEN'>0 D
.S NODE=$G(^ORD(101.41,IEN,0)) I NODE="" Q
.S $P(NODE,U,4)=$$GETTYPE($P(NODE,U,4))
.S CNT=CNT+1,^TMP($J,SUB,QOIEN,"ORDER MENUS",CNT)=NODE
Q
;
FINDRORD(QOIEN,SUB) ;
N CNT,IEN,LIST,NODE,TIEN,TOP
S CNT=+$O(^TMP($J,SUB,QOIEN,"ORDER MENUS",""),-1)
S IEN=0 F S IEN=$O(^ORD(101.41,"AD",QOIEN,IEN)) Q:IEN'>0 D
.I $D(^TMP($J,"ORDER MENU ON LIST",IEN)) Q
.S NODE=$G(^ORD(101.41,IEN,0)) I NODE="" Q
.S $P(NODE,U,4)=$$GETTYPE($P(NODE,U,4))
.S CNT=CNT+1,^TMP($J,SUB,QOIEN,"ORDER MENUS",CNT)=NODE
.S ^TMP($J,"ORDER MENU ON LIST",IEN)=""
.D FINDRORD(IEN,SUB)
Q
;
FINDREM(SUB,ORREM,SPINNER) ;
N I,IEN
D APIALL^PXRMDLR3("DIALOGS",.ORREM,0,SPINNER)
S I="" F S I=$O(^TMP($J,"DIALOGS",I)) Q:I="" D
.S IEN=+I
.I $D(^TMP($J,SUB,I,"ERROR")) S ^TMP($J,SUB,IEN,"REMINDER DIALOG",1)="ERROR: Could Process Reminder List" Q
.I '$D(^TMP($J,SUB,IEN)) Q
.M ^TMP($J,SUB,IEN,"REMINDER DIALOGS")=^TMP($J,"DIALOGS",I)
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
;
ISVALID(IEN,DSGPAR) ;
N NODE,QODSG
S NODE=$G(^ORD(101.41,IEN,0))
;Quit if not a quick order
I $P(NODE,U,4)'="Q" Q 0
;Disregard order dialog entry does not contain a valid display group
S QODSG=$P(NODE,U,5) I QODSG="" Q 0
I '$D(DSGPAR(QODSG)) Q 0
Q 1
;
SPIN(TEXT,SPINCNT) ;Move the spinner.
N QUAD
I SPINCNT=0 W !!,TEXT," "
S SPINCNT=SPINCNT+1
S QUAD=SPINCNT#8
I QUAD=1 W @IOBS,"|"
I QUAD=3 W @IOBS,"/"
I QUAD=5 W @IOBS,"-"
I QUAD=7 W @IOBS,"\"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQOUTL 4032 printed Sep 23, 2025@20:09:41 Page 2
ORQOUTL ; SLC/AGP - Utility report for Order Dialogs ;Dec 08, 2021@10:59:06
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377,405**;DEC 17, 1997;Build 211
+2 ;
+3 ;
+4 ;
+5 QUIT
+6 ;
FINDOD(RESULT,INPUT,SUB) ;
+1 KILL ^TMP($JOB,SUB),^TMP($JOB,"DIALOGS")
+2 NEW NAME,ODIEN
+3 SET RESULT=$NAME(^TMP($JOB,SUB))
+4 SET NAME=""
FOR
SET NAME=$ORDER(INPUT(NAME))
if NAME=""
QUIT
Begin DoDot:1
+5 SET ODIEN=$ORDER(^ORD(101.41,"B",NAME,""))
if ODIEN=""
QUIT
+6 SET ORREM(ODIEN_";ORD(101.41,")=""
+7 SET ^TMP($JOB,SUB,ODIEN)=NAME
+8 DO FINDORD(ODIEN,SUB)
End DoDot:1
+9 DO FINDREM(SUB,.ORREM)
+10 QUIT
+11 ;
FINDOPAR(RESULT,IEN) ;
+1 NEW CNT,ITEM,NODE,SUB
+2 KILL ^TMP($JOB,"ORDER MENU ON LIST")
+3 SET SUB="OR REM ITEMS"
+4 DO FINDRORD(IEN,SUB)
+5 SET CNT=0
FOR
SET CNT=$ORDER(^TMP($JOB,SUB,IEN,"ORDER MENUS",CNT))
if CNT'>0
QUIT
Begin DoDot:1
+6 SET NODE=$GET(^TMP($JOB,SUB,IEN,"ORDER MENUS",CNT))
+7 SET ITEM=$ORDER(^ORD(101.41,"B",$PIECE(NODE,U),""))
if IEN'>0
QUIT
+8 SET RESULT(ITEM)=NODE
End DoDot:1
+9 QUIT
FINDQO(RESULT,INPUT,SUB,RETMENU,RETSTRCT,SPINNER,SKIPDIS) ;
+1 NEW CNT,DSGPAR,DSGRP,I,J,NAME,NODE,ODIEN,OIIEN,ORDIALOG,ORREM,ORTYPE,PERQOAR,ORREMD,QOIEN
+2 NEW SPINCNT,TEMP,X,Y
+3 KILL ^TMP($JOB,SUB),^TMP($JOB,"DIALOGS")
+4 SET SPINCNT=0
+5 SET RESULT=$NAME(^TMP($JOB,SUB))
+6 ;Build a list of Display Groups that contains the default dialog defined in INPUT
+7 SET NAME=""
FOR
SET NAME=$ORDER(INPUT(NAME))
if NAME=""
QUIT
Begin DoDot:1
+8 SET ODIEN=$ORDER(^ORD(101.41,"AB",NAME,""))
if ODIEN=""
QUIT
+9 SET DSGRP=0
FOR
SET DSGRP=$ORDER(^ORD(100.98,DSGRP))
if DSGRP'>0
QUIT
Begin DoDot:2
+10 IF $PIECE(^ORD(100.98,DSGRP,0),U,4)=ODIEN
SET DSGPAR(DSGRP,NAME)=""
End DoDot:2
End DoDot:1
+11 ;
+12 SET OIIEN=$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",""))
if OIIEN'>0
QUIT
+13 SET QOIEN=0
FOR
SET QOIEN=$ORDER(^ORD(101.41,QOIEN))
if QOIEN'>0
QUIT
Begin DoDot:1
+14 IF SKIPDIS=1
IF $PIECE($GET(^ORD(101.41,QOIEN,0)),U,3)'=""
QUIT
+15 IF $$ISVALID(QOIEN,.DSGPAR)=0
QUIT
+16 IF SPINNER
DO SPIN("Finding Quick Orders",.SPINCNT)
+17 SET NODE=$GET(^ORD(101.41,QOIEN,0))
+18 SET ^TMP($JOB,SUB,QOIEN)=$PIECE(NODE,U,1,4)
+19 SET ^TMP($JOB,SUB,QOIEN,"ISPERQO")=$SELECT($DATA(^ORD(101.44,"C",QOIEN)):1,1:0)
+20 SET ORREM(QOIEN_";ORD(101.41,")=""
+21 IF $GET(RETSTRCT)=0
QUIT
+22 SET ORTYPE="Z"
+23 KILL ORDIALOG
+24 DO GETQDLG^ORCD(QOIEN)
+25 ;D GETQDLG(QOIEN)
+26 MERGE ^TMP($JOB,SUB,QOIEN,"ORDIALOG")=ORDIALOG
End DoDot:1
+27 ;
+28 IF RETMENU=0
GOTO FINDQOX
+29 ;find menu structure order dialog exists on
+30 SET QOIEN=0
FOR
SET QOIEN=$ORDER(^TMP($JOB,SUB,QOIEN))
if QOIEN'>0
QUIT
Begin DoDot:1
+31 IF SPINNER
DO SPIN("Finding Quick Orders",.SPINCNT)
+32 DO FINDORD(QOIEN,SUB)
End DoDot:1
+33 ;find reminder dialogs order dialog exisits on
+34 DO FINDREM(SUB,.ORREM,SPINNER)
FINDQOX ;
+1 KILL ^TMP($JOB,"DIALOGS")
+2 QUIT
+3 ;
FINDORD(QOIEN,SUB) ;
+1 NEW CNT,IEN,LIST,NODE,TIEN,TOP
+2 SET IEN=0
SET CNT=0
FOR
SET IEN=$ORDER(^ORD(101.41,"AD",QOIEN,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^ORD(101.41,IEN,0))
IF NODE=""
QUIT
+4 SET $PIECE(NODE,U,4)=$$GETTYPE($PIECE(NODE,U,4))
+5 SET CNT=CNT+1
SET ^TMP($JOB,SUB,QOIEN,"ORDER MENUS",CNT)=NODE
End DoDot:1
+6 QUIT
+7 ;
FINDRORD(QOIEN,SUB) ;
+1 NEW CNT,IEN,LIST,NODE,TIEN,TOP
+2 SET CNT=+$ORDER(^TMP($JOB,SUB,QOIEN,"ORDER MENUS",""),-1)
+3 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(101.41,"AD",QOIEN,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+4 IF $DATA(^TMP($JOB,"ORDER MENU ON LIST",IEN))
QUIT
+5 SET NODE=$GET(^ORD(101.41,IEN,0))
IF NODE=""
QUIT
+6 SET $PIECE(NODE,U,4)=$$GETTYPE($PIECE(NODE,U,4))
+7 SET CNT=CNT+1
SET ^TMP($JOB,SUB,QOIEN,"ORDER MENUS",CNT)=NODE
+8 SET ^TMP($JOB,"ORDER MENU ON LIST",IEN)=""
+9 DO FINDRORD(IEN,SUB)
End DoDot:1
+10 QUIT
+11 ;
FINDREM(SUB,ORREM,SPINNER) ;
+1 NEW I,IEN
+2 DO APIALL^PXRMDLR3("DIALOGS",.ORREM,0,SPINNER)
+3 SET I=""
FOR
SET I=$ORDER(^TMP($JOB,"DIALOGS",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=+I
+5 IF $DATA(^TMP($JOB,SUB,I,"ERROR"))
SET ^TMP($JOB,SUB,IEN,"REMINDER DIALOG",1)="ERROR: Could Process Reminder List"
QUIT
+6 IF '$DATA(^TMP($JOB,SUB,IEN))
QUIT
+7 MERGE ^TMP($JOB,SUB,IEN,"REMINDER DIALOGS")=^TMP($JOB,"DIALOGS",I)
End DoDot:1
+8 QUIT
+9 ;
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 ;
ISVALID(IEN,DSGPAR) ;
+1 NEW NODE,QODSG
+2 SET NODE=$GET(^ORD(101.41,IEN,0))
+3 ;Quit if not a quick order
+4 IF $PIECE(NODE,U,4)'="Q"
QUIT 0
+5 ;Disregard order dialog entry does not contain a valid display group
+6 SET QODSG=$PIECE(NODE,U,5)
IF QODSG=""
QUIT 0
+7 IF '$DATA(DSGPAR(QODSG))
QUIT 0
+8 QUIT 1
+9 ;
SPIN(TEXT,SPINCNT) ;Move the spinner.
+1 NEW QUAD
+2 IF SPINCNT=0
WRITE !!,TEXT," "
+3 SET SPINCNT=SPINCNT+1
+4 SET QUAD=SPINCNT#8
+5 IF QUAD=1
WRITE @IOBS,"|"
+6 IF QUAD=3
WRITE @IOBS,"/"
+7 IF QUAD=5
WRITE @IOBS,"-"
+8 IF QUAD=7
WRITE @IOBS,"\"
+9 QUIT
+10 ;
