VALMXQ07.m

VALMXQ07 ; alb/mjk - XQORD1 for export with LM v1 ; 3/30/93

 ;;1;List Manager;;Aug 13, 1993

 ;

 ;

XQORD1 ; SLC/KCM - Process Menus, WP during dialog ;11/19/92  08:31

 ;;6.7;Sidewinder;;Jan 08, 1993

 ;

RDR ;Setup and prompt using reader (DIR)

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

 N DIR

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

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

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

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

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

 S:$L(X("HELP")) DIR("?")=X("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=X("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: X(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 ---VALMXQ07   2017     printed  Apr 09, 2024@21:12:40                                                                                                                                                                                                    Page 2

VALMXQ07  ; alb/mjk - XQORD1 for export with LM v1 ; 3/30/93

 +1       ;;1;List Manager;;Aug 13, 1993

 +2       ;

 +3       ;

XQORD1    ; SLC/KCM - Process Menus, WP during dialog ;11/19/92  08:31

 +1       ;;6.7;Sidewinder;;Jan 08, 1993

 +2       ;

RDR       ;Setup and prompt using reader (DIR)

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

 +2        NEW DIR

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

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

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

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

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

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

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

 +6       ;default answer

           if $LENGTH(X("DFLT"))

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

 +7       ;last entered answer

           if $DATA(XQORDLG(ITM))#2

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

 +8       ;help prompt

           if $LENGTH(X("HELP"))

               SET DIR("?")=X("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=X("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: X(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