XQORD1.m

XQORD1 ; SLC/KCM - Process Menus, WP during dialog ;11/19/92  08:31 [ 05/08/95  4:17 PM ]

 ;;8.0;KERNEL;;Jul 10, 1995

 ;

RDR ;Setup and prompt using reader (DIR)

 ;Entry: XQORDX(field) is entire prompt node, XQORDLG(ITM) is previous response

 N DIR

 I XQORDX("DOM")="D",'$L(XQORDX("PARM")) S XQORDX("PARM")="::ET"

 S DIR(0)=XQORDX("DOM")_"A"_$S(XQORDX("MODE")["R":"",1:"O")_"^"_XQORDX("PARM")

 S DIR("A")=XQORDX("PRMT") S:DIR("A")'?.E1P1" " DIR("A")=DIR("A")_": "

 S:$L(XQORDX("DFLT")) DIR("B")=XQORDX("DFLT") ;default answer

 S:$D(XQORDLG(ITM))#2 DIR("B")=XQORDLG(ITM) ;last entered answer

 S:$L(XQORDX("HELP")) DIR("?")=XQORDX("HELP") ;help prompt

 D ^DIR

 Q  ;Exit: X is user entry, Y is validated answer (internal value)

 ;

WP ;Prompt for word processing

 ;Entry: .X is entire prompt node, XQORDLG(ITM) is last answer to this prompt

 N IFN,PRMT,DIC,DLAYGO,DIE,DR,DA,%

 S PRMT=XQORDX("PRMT") ;boilerplate in $P(X,"^",2)

 I '$G(XQORDLG(ITM)) DO

 . I '$D(^XUTL("XQORW",0)) S ^XUTL("XQORW",0)="XQOR WORD PROCESSING^101.11D^" ;if ^XUTL killed

 . D NOW^%DTC

 . S X=""""_%_"""",DIC="^XUTL(""XQORW"",",DIC(0)="L",DLAYGO=101.11 D ^DIC ;stuff entry

 I $G(XQORDLG(ITM)) S Y=XQORDLG(ITM),DIC="^XUTL(""XQORW"","

 S IFN=+Y,DIE=DIC,DR="1"_$TR(PRMT,";:","  "),DA=IFN D ^DIE

 S Y=IFN,X=$G(^XUTL("XQORW",IFN,1,+$O(^XUTL("XQORW",IFN,1,0)),0))

 Q  ;Exit: X is first entered line, Y is pointer 101.11 entry

 ;

MENU ;Allow menu selections from 101, 19, and similar files (XQORM)

 ;Entry: XQORDX(field) is prompt node, XQORDLG(ITM) is last answer to this prompt

 Q  ;N XQORM (menus not allowed for now)

 S XQORM=$P(X,"^",6),XQORM(0)=$P(X,"^",4)_"\",XQORM("A")=$P(X,"^",1)_": "

 S:'$L(XQORM(0)) XQORM(0)="A"

 S:$L($P(X,"^",2)) XQORM("B")=$P(X,"^",2) ;default selection

 S:$D(XQORDLG(ITM,1,"E")) XQORM("B")=XQORDLG(ITM,1,"E") ;last answer

 S:$L($P(X,"^",5)) XQORM("?")="W !!,"""_$P(X,"^",5)_""",!" ;help prompt

 D EN^XQORM

 Q  ;Exit: X is user entry, Y is pointer to entry in menu file

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XQORD1   2003     printed  Apr 09, 2024@21:15:19                                                                                                                                                                                                      Page 2

XQORD1    ; SLC/KCM - Process Menus, WP during dialog ;11/19/92  08:31 [ 05/08/95  4:17 PM ]

 +1       ;;8.0;KERNEL;;Jul 10, 1995

 +2       ;

RDR       ;Setup and prompt using reader (DIR)

 +1       ;Entry: XQORDX(field) is entire prompt node, XQORDLG(ITM) is previous response

 +2        NEW DIR

 +3        IF XQORDX("DOM")="D"

               IF '$LENGTH(XQORDX("PARM"))

                   SET XQORDX("PARM")="::ET"

 +4        SET DIR(0)=XQORDX("DOM")_"A"_$SELECT(XQORDX("MODE")["R":"",1:"O")_"^"_XQORDX("PARM")

 +5        SET DIR("A")=XQORDX("PRMT")

           if DIR("A")'?.E1P1" "

               SET DIR("A")=DIR("A")_": "

 +6       ;default answer

           if $LENGTH(XQORDX("DFLT"))

               SET DIR("B")=XQORDX("DFLT")

 +7       ;last entered answer

           if $DATA(XQORDLG(ITM))#2

               SET DIR("B")=XQORDLG(ITM)

 +8       ;help prompt

           if $LENGTH(XQORDX("HELP"))

               SET DIR("?")=XQORDX("HELP")

 +9        DO ^DIR

 +10      ;Exit: X is user entry, Y is validated answer (internal value)

           QUIT 

 +11      ;

WP        ;Prompt for word processing

 +1       ;Entry: .X is entire prompt node, XQORDLG(ITM) is last answer to this prompt

 +2        NEW IFN,PRMT,DIC,DLAYGO,DIE,DR,DA,%

 +3       ;boilerplate in $P(X,"^",2)

           SET PRMT=XQORDX("PRMT")

 +4        IF '$GET(XQORDLG(ITM))

               Begin DoDot:1

 +5       ;if ^XUTL killed

                   IF '$DATA(^XUTL("XQORW",0))

                       SET ^XUTL("XQORW",0)="XQOR WORD PROCESSING^101.11D^"

 +6                DO NOW^%DTC

 +7       ;stuff entry

                   SET X=""""_%_""""

                   SET DIC="^XUTL(""XQORW"","

                   SET DIC(0)="L"

                   SET DLAYGO=101.11

                   DO ^DIC

               End DoDot:1

 +8        IF $GET(XQORDLG(ITM))

               SET Y=XQORDLG(ITM)

               SET DIC="^XUTL(""XQORW"","

 +9        SET IFN=+Y

           SET DIE=DIC

           SET DR="1"_$TRANSLATE(PRMT,";:","  ")

           SET DA=IFN

           DO ^DIE

 +10       SET Y=IFN

           SET X=$GET(^XUTL("XQORW",IFN,1,+$ORDER(^XUTL("XQORW",IFN,1,0)),0))

 +11      ;Exit: X is first entered line, Y is pointer 101.11 entry

           QUIT 

 +12      ;

MENU      ;Allow menu selections from 101, 19, and similar files (XQORM)

 +1       ;Entry: XQORDX(field) is prompt node, XQORDLG(ITM) is last answer to this prompt

 +2       ;N XQORM (menus not allowed for now)

           QUIT 

 +3        SET XQORM=$PIECE(X,"^",6)

           SET XQORM(0)=$PIECE(X,"^",4)_"\"

           SET XQORM("A")=$PIECE(X,"^",1)_": "

 +4        if '$LENGTH(XQORM(0))

               SET XQORM(0)="A"

 +5       ;default selection

           if $LENGTH($PIECE(X,"^",2))

               SET XQORM("B")=$PIECE(X,"^",2)

 +6       ;last answer

           if $DATA(XQORDLG(ITM,1,"E"))

               SET XQORM("B")=XQORDLG(ITM,1,"E")

 +7       ;help prompt

           if $LENGTH($PIECE(X,"^",5))

               SET XQORM("?")="W !!,"""_$PIECE(X,"^",5)_""",!"

 +8        DO EN^XQORM

 +9       ;Exit: X is user entry, Y is pointer to entry in menu file

           QUIT