ORORDDSC ; SLC/AGP - API for returning Order Dialogs Structure;Dec 08, 2021@10:53:21
;;3.0;ORDER ENTRY/RESULTS REPORTING;**301,295,280,405**;Dec 17, 1997;Build 211
;
BEG(OUTPUT,IEN,TYPE,CNT) ;
N DTYPE,NODE
S NODE=$G(^ORD(101.41,IEN,0))
S DTYPE=$S(TYPE="Q":"Quick Order",TYPE="M":"Menu",TYPE="D":"Dialog",TYPE="O":"Order Set",TYPE="A":"Action",1:"")
S CNT=CNT+1 S @OUTPUT@(CNT)=$$REPEAT^XLFSTR("-",79)
S CNT=CNT+1 S @OUTPUT@(CNT)=$J(" ",24)_"Name: "_$P(NODE,U)
S CNT=CNT+1 S @OUTPUT@(CNT)=$J(" ",24)_"Type: "_DTYPE
I $P(NODE,U,3)'="" S CNT=CNT+1,@OUTPUT@(CNT)=$J(" ",21)_"Disable: "_$P(NODE,U,3)
I $P(NODE,U,2)'="" S CNT=CNT+1 S @OUTPUT@(CNT)=$J(" ",16)_"Display Text: "_$P(NODE,U,2)
I TYPE="Q" D Q
.S CNT=CNT+1 S @OUTPUT@(CNT)=$J(" ",15)_"Display Group: "_$$GETDISGP($P(NODE,U,5))
.S CNT=CNT+1 S @OUTPUT@(CNT)=$J(" ",21)_"Package: "_$$NMSP($P(NODE,U,7))
Q
;
DIALOG(OUTPUT,IEN,TYPE,CNT) ;
D BEG(.OUTPUT,IEN,TYPE,.CNT)
S CNT=CNT+1,@OUTPUT@(CNT)=$$REPEAT^XLFSTR("-",79)
Q
;
EN(IEN,SUB) ;
I $D(^TMP($J,SUB,IEN))>0 Q
N CNT,OUTPUT
S CNT=0
S OUTPUT=$NA(^TMP($J,SUB,IEN))
D DIRECT(.OUTPUT,IEN,.CNT)
Q
;
DIRECT(OUTPUT,IEN,CNT) ;
N ORDIALOG,SAFEIEN,TYPE
S TYPE=$P($G(^ORD(101.41,IEN,0)),U,4)
I TYPE="Q" D Q
.;done to prevent a problem with TIU Active Medication Objects
.;killing the variable IEN
.S ORTYPE="Z"
.S SAFEIEN=IEN
.D GETQDLG^ORCD(IEN)
.D QO(.ORDIALOG,SAFEIEN,.OUTPUT,.CNT)
I TYPE="M"!(TYPE="O") D MENU(.OUTPUT,IEN,TYPE,.CNT) Q
I TYPE="D"!(TYPE="A") D DIALOG(.OUTPUT,IEN,TYPE,.CNT) Q
Q
;
GETDISGP(IEN) ;
N RESULT
S RESULT=$P($G(^ORD(100.98,IEN,0)),U)
Q RESULT
;
D BEG(.OUTPUT,IEN,TYPE,.CNT)
N NODE,NUM,SEQ,ITEM
S SEQ="" F S SEQ=$O(^ORD(101.41,IEN,10,"B",SEQ)) Q:SEQ="" D
.S NUM=$O(^ORD(101.41,IEN,10,"B",SEQ,"")) Q:NUM=""
.S ITEM=+$P($G(^ORD(101.41,IEN,10,NUM,0)),U,2) I ITEM'>0 Q
.S CNT=CNT+1,@OUTPUT@(CNT)=$J(" ",25)_"SEQ: "_SEQ
.D DIRECT(.OUTPUT,ITEM,.CNT)
S CNT=CNT+1,@OUTPUT@(CNT)=$$REPEAT^XLFSTR("-",79)
Q
;
NMSP(PKG) ;
Q $$GET1^DIQ(9.4,+PKG_",",.01)
;
QO(ORDIALOG,IEN,OUTPUT,CNT) ; -- Display new order on screen
N SEQ,DA,X,PROMPT,MULT,NL,NOUT,I,TEXT,TEXTOUT,TIDX,TITLE,LEN,X
D BEG(.OUTPUT,IEN,"Q",.CNT)
S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0 D
. S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D
.. S X=$G(^ORD(101.41,+ORDIALOG,10,DA,0)) Q:$P(X,U,11) ;child
.. S PROMPT=$P(X,U,2),MULT=$P(X,U,7) Q:$P(X,U,9)["*" ;hide
.. Q:'PROMPT S I=$O(ORDIALOG(PROMPT,0)) Q:'I ; no values
.. S TITLE=$S($L($G(ORDIALOG(PROMPT,"TTL"))):ORDIALOG(PROMPT,"TTL"),1:ORDIALOG(PROMPT,"A"))
.. S CNT=CNT+1,@OUTPUT@(CNT)=$J(TITLE,30)
.. I $E(ORDIALOG(PROMPT,0))="W" D
...S TIDX=0,NL=0 F S TIDX=$O(^TMP("ORWORD",$J,PROMPT,I,TIDX)) Q:TIDX'>0 D
....S NL=NL+1,TEXT(NL)=^TMP("ORWORD",$J,PROMPT,I,TIDX,0)
...D FORMAT^PXRMTEXT(1,40,NL,.TEXT,.NOUT,.TEXTOUT)
...F X=1:1:NOUT D
....I X=1 S @OUTPUT@(CNT)=@OUTPUT@(CNT)_TEXTOUT(X) Q
....S CNT=CNT+1,@OUTPUT@(CNT)=$J(" ",30)_TEXTOUT(X)
...; S @OUTPUT@(CNT)=@OUTPUT@(CNT)_$E($G(^TMP("ORWORD",$J,PROMPT,I,1,0)),1,40)_$S($L($G(^(0)))>40:" ...",$O(^TMP("ORWORD",$J,PROMPT,I,1)):" ...",1:"") Q
.. I $E(ORDIALOG(PROMPT,0))'="W" D
... S @OUTPUT@(CNT)=@OUTPUT@(CNT)_$$ITEM^ORCDLG(PROMPT,I) Q:'MULT Q:'$O(ORDIALOG(PROMPT,I)) ; done
.. F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D
... S CNT=CNT+1,@OUTPUT@(CNT)=$J(" ",30)_$$ITEM^ORCDLG(PROMPT,I)
S CNT=CNT+1,@OUTPUT@(CNT)=$$REPEAT^XLFSTR("-",79)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORORDDSC 3553 printed Sep 23, 2025@20:08:39 Page 2
ORORDDSC ; SLC/AGP - API for returning Order Dialogs Structure;Dec 08, 2021@10:53:21
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**301,295,280,405**;Dec 17, 1997;Build 211
+2 ;
BEG(OUTPUT,IEN,TYPE,CNT) ;
+1 NEW DTYPE,NODE
+2 SET NODE=$GET(^ORD(101.41,IEN,0))
+3 SET DTYPE=$SELECT(TYPE="Q":"Quick Order",TYPE="M":"Menu",TYPE="D":"Dialog",TYPE="O":"Order Set",TYPE="A":"Action",1:"")
+4 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$$REPEAT^XLFSTR("-",79)
+5 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$JUSTIFY(" ",24)_"Name: "_$PIECE(NODE,U)
+6 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$JUSTIFY(" ",24)_"Type: "_DTYPE
+7 IF $PIECE(NODE,U,3)'=""
SET CNT=CNT+1
SET @OUTPUT@(CNT)=$JUSTIFY(" ",21)_"Disable: "_$PIECE(NODE,U,3)
+8 IF $PIECE(NODE,U,2)'=""
SET CNT=CNT+1
SET @OUTPUT@(CNT)=$JUSTIFY(" ",16)_"Display Text: "_$PIECE(NODE,U,2)
+9 IF TYPE="Q"
Begin DoDot:1
+10 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$JUSTIFY(" ",15)_"Display Group: "_$$GETDISGP($PIECE(NODE,U,5))
+11 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$JUSTIFY(" ",21)_"Package: "_$$NMSP($PIECE(NODE,U,7))
End DoDot:1
QUIT
+12 QUIT
+13 ;
DIALOG(OUTPUT,IEN,TYPE,CNT) ;
+1 DO BEG(.OUTPUT,IEN,TYPE,.CNT)
+2 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$$REPEAT^XLFSTR("-",79)
+3 QUIT
+4 ;
EN(IEN,SUB) ;
+1 IF $DATA(^TMP($JOB,SUB,IEN))>0
QUIT
+2 NEW CNT,OUTPUT
+3 SET CNT=0
+4 SET OUTPUT=$NAME(^TMP($JOB,SUB,IEN))
+5 DO DIRECT(.OUTPUT,IEN,.CNT)
+6 QUIT
+7 ;
DIRECT(OUTPUT,IEN,CNT) ;
+1 NEW ORDIALOG,SAFEIEN,TYPE
+2 SET TYPE=$PIECE($GET(^ORD(101.41,IEN,0)),U,4)
+3 IF TYPE="Q"
Begin DoDot:1
+4 ;done to prevent a problem with TIU Active Medication Objects
+5 ;killing the variable IEN
+6 SET ORTYPE="Z"
+7 SET SAFEIEN=IEN
+8 DO GETQDLG^ORCD(IEN)
+9 DO QO(.ORDIALOG,SAFEIEN,.OUTPUT,.CNT)
End DoDot:1
QUIT
+10 IF TYPE="M"!(TYPE="O")
DO MENU(.OUTPUT,IEN,TYPE,.CNT)
QUIT
+11 IF TYPE="D"!(TYPE="A")
DO DIALOG(.OUTPUT,IEN,TYPE,.CNT)
QUIT
+12 QUIT
+13 ;
GETDISGP(IEN) ;
+1 NEW RESULT
+2 SET RESULT=$PIECE($GET(^ORD(100.98,IEN,0)),U)
+3 QUIT RESULT
+4 ;
+1 DO BEG(.OUTPUT,IEN,TYPE,.CNT)
+2 NEW NODE,NUM,SEQ,ITEM
+3 SET SEQ=""
FOR
SET SEQ=$ORDER(^ORD(101.41,IEN,10,"B",SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+4 SET NUM=$ORDER(^ORD(101.41,IEN,10,"B",SEQ,""))
if NUM=""
QUIT
+5 SET ITEM=+$PIECE($GET(^ORD(101.41,IEN,10,NUM,0)),U,2)
IF ITEM'>0
QUIT
+6 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$JUSTIFY(" ",25)_"SEQ: "_SEQ
+7 DO DIRECT(.OUTPUT,ITEM,.CNT)
End DoDot:1
+8 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$$REPEAT^XLFSTR("-",79)
+9 QUIT
+10 ;
NMSP(PKG) ;
+1 QUIT $$GET1^DIQ(9.4,+PKG_",",.01)
+2 ;
QO(ORDIALOG,IEN,OUTPUT,CNT) ; -- Display new order on screen
+1 NEW SEQ,DA,X,PROMPT,MULT,NL,NOUT,I,TEXT,TEXTOUT,TIDX,TITLE,LEN,X
+2 DO BEG(.OUTPUT,IEN,"Q",.CNT)
+3 SET SEQ=0
FOR
SET SEQ=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ))
if SEQ'>0
QUIT
Begin DoDot:1
+4 SET DA=0
FOR
SET DA=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA))
if 'DA
QUIT
Begin DoDot:2
+5 ;child
SET X=$GET(^ORD(101.41,+ORDIALOG,10,DA,0))
if $PIECE(X,U,11)
QUIT
+6 ;hide
SET PROMPT=$PIECE(X,U,2)
SET MULT=$PIECE(X,U,7)
if $PIECE(X,U,9)["*"
QUIT
+7 ; no values
if 'PROMPT
QUIT
SET I=$ORDER(ORDIALOG(PROMPT,0))
if 'I
QUIT
+8 SET TITLE=$SELECT($LENGTH($GET(ORDIALOG(PROMPT,"TTL"))):ORDIALOG(PROMPT,"TTL"),1:ORDIALOG(PROMPT,"A"))
+9 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$JUSTIFY(TITLE,30)
+10 IF $EXTRACT(ORDIALOG(PROMPT,0))="W"
Begin DoDot:3
+11 SET TIDX=0
SET NL=0
FOR
SET TIDX=$ORDER(^TMP("ORWORD",$JOB,PROMPT,I,TIDX))
if TIDX'>0
QUIT
Begin DoDot:4
+12 SET NL=NL+1
SET TEXT(NL)=^TMP("ORWORD",$JOB,PROMPT,I,TIDX,0)
End DoDot:4
+13 DO FORMAT^PXRMTEXT(1,40,NL,.TEXT,.NOUT,.TEXTOUT)
+14 FOR X=1:1:NOUT
Begin DoDot:4
+15 IF X=1
SET @OUTPUT@(CNT)=@OUTPUT@(CNT)_TEXTOUT(X)
QUIT
+16 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$JUSTIFY(" ",30)_TEXTOUT(X)
End DoDot:4
+17 ; S @OUTPUT@(CNT)=@OUTPUT@(CNT)_$E($G(^TMP("ORWORD",$J,PROMPT,I,1,0)),1,40)_$S($L($G(^(0)))>40:" ...",$O(^TMP("ORWORD",$J,PROMPT,I,1)):" ...",1:"") Q
End DoDot:3
+18 IF $EXTRACT(ORDIALOG(PROMPT,0))'="W"
Begin DoDot:3
+19 ; done
SET @OUTPUT@(CNT)=@OUTPUT@(CNT)_$$ITEM^ORCDLG(PROMPT,I)
if 'MULT
QUIT
if '$ORDER(ORDIALOG(PROMPT,I))
QUIT
End DoDot:3
+20 FOR
SET I=$ORDER(ORDIALOG(PROMPT,I))
if I'>0
QUIT
Begin DoDot:3
+21 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$JUSTIFY(" ",30)_$$ITEM^ORCDLG(PROMPT,I)
End DoDot:3
End DoDot:2
End DoDot:1
+22 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$$REPEAT^XLFSTR("-",79)
+23 QUIT
+24 ;
