- 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 Feb 18, 2025@23:58:53 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 ;
