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
;
;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 ---[H[J[2J[HXQORD1 2003 printed Dec 13, 2024@02:06:14 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 ;
+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
