XQT4 ;SEA/MJM - Menu template utilities ;08/27/97 14:52
;;8.0;KERNEL;**46**;Jul 10, 1995
S U="^"
SHO ;Show a user his or her template names
S XQUSER=$P($P(^VA(200,DUZ,0),U),",",2)_" "_$P($P(^(0),U),",")
S U="^",(XQI,XQN,XQIT,XQV)=0
S XQN=$O(^VA(200,DUZ,19.8,"B",XQN)) I XQN="" W !,XQUSER," doesn't have any Templates stored in the New Person File." G KIL
D HOME^%ZIS:'$D(IOF),^XQDATE
W @IOF,!,?10,"The menu templates of ",XQUSER," ",%Y S XQV=2
D SHO1 F XQI=0:0 S XQN=$O(^VA(200,DUZ,19.8,"B",XQN)) Q:XQN="" D SHO1 Q:XQIT
KIL K %,%1,%2,%Y,XQI,XQLN,XQN,XQIT,XQUSER,XQV
Q
SHO1 ;Write out template name and the first two options in it
S XQI=0,XQI=$O(^VA(200,DUZ,19.8,"B",XQN,XQI)),%=^VA(200,DUZ,19.8,XQI,1,1,0),%=$P(%,U,2,999),%1=+$P(%,U,1),%2=+$P(%,U,2)
I IOST["C-",'$D(ZTQUEUED),XQV+5>21 S XQV=0 D WAIT Q:XQIT W @IOF
W !!,"Template name: ",XQN S XQV=XQV+2
I %1 W !,?3,"1st option: ",$S($D(^DIC(19,%1,0))#2:$P(^(0),U,2),1:"*** Missing Option ***") S XQV=XQV+1
I %2 W !,?6,"2nd option: ",$S($D(^DIC(19,%2,0))#2:$P(^(0),U,2),1:"*** Missing Option ***") S XQV=XQV+1
I $L($P(%,U,3)) W !,?9,"Etc." S XQV=XQV+1
Q
OUT ;Clean up and quit
S XQY=+XQTSV,XQDIC=$P(XQTSV,U,2),XQY0=$P(XQTSV,U,3,99)
K %,%1,%2,X,XQ,XQALL,XQE,XQEX,XQI,XQII,XQJ,XQLM,XQN,XQTSV,XQIT,XQUR,Y
Q
;
LIST ;List all of the options in a particular Menu Template
S U="^",XQTSV=XQY_U_XQDIC_U_XQY0
ASK S (XQALL,XQE,XQIT)=0
R !!,"Which template? ('^' to quit) ^// ",XQUR:DTIME S:'$T!(XQUR="") XQUR=U G:XQUR=U OUT I XQUR="?" W !!," Enter the name of one of your templates, 'ALL' to list them all,",!?5,"or '??' to get a list of all your templates." G ASK
I XQUR="??" N XQIT D SHO G ASK
I XQUR="ALL"!(XQUR="all") R !,"Are saying you want to print out all your templates? (Y/N) Y// ",%:DTIME S:'$T %=U S:%="" %="Y" S:"Yy"[% XQALL=1 I %["?" W !,"Please answer 'Y' or 'N' to this question." G ASK
ASKE R !,"Show Entry and Exit Actions? (Y/N) N// ",%:DTIME S:'$T %=U G:%=U OUT S:%="" %="N" S:"Yy"[% XQE=1
I 'XQE,"YyNn"'[% W !!,"'Y' means you'll see the MUMPS code (if any) executed",!?3,"before and after the option is run. 'N' means you won't" G ASKE
I XQALL S XQUR="" F XQII=0:0 S XQUR=$O(^VA(200,DUZ,19.8,"B",XQUR)) Q:XQUR="" D DEED,WAIT Q:XQIT
G:XQALL OUT
D FIND^XQT G:XQK ASK D DEED
G ASK
Q
DEED ;Decode the word processing field where templates are stored
S XQN=$O(^VA(200,DUZ,19.8,"B",XQUR,0)),XQJ=$P(^VA(200,DUZ,19.8,XQN,1,0),U,3)
W @IOF,!?20,"Menu Template ",XQUR,!! S XQV=3,XQLM=1
F XQI=1:1:XQJ S %=^VA(200,DUZ,19.8,XQN,1,XQI,0),%=$P(%,U,2,999) F XQK=1:1 S XQ=$P(%,U,XQK) Q:XQ="" S XQY=+XQ,XQEX=$P(XQ,",",3),XQY0=$S($D(^DIC(19,+XQY,0))#2:^(0),1:"") D WRITE Q:XQIT S XQLM=XQLM+1
Q
;
WRITE ;Write the Entry Action, Menu text, and Exit Action for an option
I XQE,$P(XQY0,U,14) W !?XQLM,"Entry Action: ",^DIC(19,+XQY,20) S XQV=XQV+1
I XQE,$P(XQY0,U,17) W !?XQLM,"Header: ",^DIC(19,+XQY,26) S XQV=XQV+1
I XQY0]"" W !?XQLM,$P(XQY0,U,2)_" ("_$P(XQY0,U)_")" S XQV=XQV+1
E W !!?XQLM,"*** Fatal Error *** Option missing from Option File ***",!?XQLM,"This template will not run. Delete and/or rebuild it." S XQIT=1 Q
I XQE,$P(XQY0,U,15) W !?XQLM,"Exit Action: ",^DIC(19,+XQY,15) S XQV=XQV+1
I XQV>20,IOST["C-" D WAIT Q:XQIT W @IOF,?10,"Template ",XQUR," continued..." S XQV=1
Q
;
WAIT ;That's a screen load hold it here for a minute
S XQIT=0 W !!,"Hit RETURN to continue, '^' to quit: " S X="" R X:DTIME S:'$T X=U S:X=U XQIT=1 S XQLM=1
Q
;
KILL ;Remove a template from the New Person File
S U="^"
R !!,"Which template should be deleted ? ",XQUR:DTIME S:'$T XQUR=U Q:XQUR=U I XQUR="?" W !,"Enter a template name, '??' to get a list of your templates",!," or '^' to quit." G KILL
I XQUR["??" D SHO W !! G KILL
D FIND^XQT I XQK K XQ,XQI,XQJ,XQK Q
K1 W !,"I will remove the Menu Template ",XQUR," permanently. OK? (Y/N) N// " R %:DTIME S:'$T %=U S:%="" %="N" G:%=U K2 G:"Nn"[% KILL I "Yy"'[% W !,"Please answer 'Y' or 'N' or '^' to quit." G K1
S DA=$O(^VA(200,DUZ,19.8,"B",XQUR,0)),DA(1)=DUZ,DIK="^VA(200,"_DA(1)_",19.8," D ^DIK
K2 K DA,DIK,XQ,XQI,XQJ,XQK
Q
;
RNAM ;Rename an exsisting Menu Template
S U="^",DA(1)=DUZ,DIC="^VA(200,"_DA(1)_",19.8,",DIC("P")=200.198,DIC(0)="AEQM",DIC("A")="Rename which template? " D ^DIC I Y<0 K %,%Y,CD,DA,DIC,FUN Q
S DIE=DIC,DIE("P")=DIC("P"),DA=+Y,DR=".01" D ^DIE
K CD,D,D0,DA,DI,DIC,DIE,DISYS,DR,DQ,FUN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQT4 4425 printed Dec 13, 2024@02:06:51 Page 2
XQT4 ;SEA/MJM - Menu template utilities ;08/27/97 14:52
+1 ;;8.0;KERNEL;**46**;Jul 10, 1995
+2 SET U="^"
SHO ;Show a user his or her template names
+1 SET XQUSER=$PIECE($PIECE(^VA(200,DUZ,0),U),",",2)_" "_$PIECE($PIECE(^(0),U),",")
+2 SET U="^"
SET (XQI,XQN,XQIT,XQV)=0
+3 SET XQN=$ORDER(^VA(200,DUZ,19.8,"B",XQN))
IF XQN=""
WRITE !,XQUSER," doesn't have any Templates stored in the New Person File."
GOTO KIL
+4 if '$DATA(IOF)
DO HOME^%ZIS
DO ^XQDATE
+5 WRITE @IOF,!,?10,"The menu templates of ",XQUSER," ",%Y
SET XQV=2
+6 DO SHO1
FOR XQI=0:0
SET XQN=$ORDER(^VA(200,DUZ,19.8,"B",XQN))
if XQN=""
QUIT
DO SHO1
if XQIT
QUIT
KIL KILL %,%1,%2,%Y,XQI,XQLN,XQN,XQIT,XQUSER,XQV
+1 QUIT
SHO1 ;Write out template name and the first two options in it
+1 SET XQI=0
SET XQI=$ORDER(^VA(200,DUZ,19.8,"B",XQN,XQI))
SET %=^VA(200,DUZ,19.8,XQI,1,1,0)
SET %=$PIECE(%,U,2,999)
SET %1=+$PIECE(%,U,1)
SET %2=+$PIECE(%,U,2)
+2 IF IOST["C-"
IF '$DATA(ZTQUEUED)
IF XQV+5>21
SET XQV=0
DO WAIT
if XQIT
QUIT
WRITE @IOF
+3 WRITE !!,"Template name: ",XQN
SET XQV=XQV+2
+4 IF %1
WRITE !,?3,"1st option: ",$SELECT($DATA(^DIC(19,%1,0))#2:$PIECE(^(0),U,2),1:"*** Missing Option ***")
SET XQV=XQV+1
+5 IF %2
WRITE !,?6,"2nd option: ",$SELECT($DATA(^DIC(19,%2,0))#2:$PIECE(^(0),U,2),1:"*** Missing Option ***")
SET XQV=XQV+1
+6 IF $LENGTH($PIECE(%,U,3))
WRITE !,?9,"Etc."
SET XQV=XQV+1
+7 QUIT
OUT ;Clean up and quit
+1 SET XQY=+XQTSV
SET XQDIC=$PIECE(XQTSV,U,2)
SET XQY0=$PIECE(XQTSV,U,3,99)
+2 KILL %,%1,%2,X,XQ,XQALL,XQE,XQEX,XQI,XQII,XQJ,XQLM,XQN,XQTSV,XQIT,XQUR,Y
+3 QUIT
+4 ;
LIST ;List all of the options in a particular Menu Template
+1 SET U="^"
SET XQTSV=XQY_U_XQDIC_U_XQY0
ASK SET (XQALL,XQE,XQIT)=0
+1 READ !!,"Which template? ('^' to quit) ^// ",XQUR:DTIME
if '$TEST!(XQUR="")
SET XQUR=U
if XQUR=U
GOTO OUT
IF XQUR="?"
WRITE !!," Enter the name of one of your templates, 'ALL' to list them all,",!?5,"or '??' to get a list of all your templates."
GOTO ASK
+2 IF XQUR="??"
NEW XQIT
DO SHO
GOTO ASK
+3 IF XQUR="ALL"!(XQUR="all")
READ !,"Are saying you want to print out all your templates? (Y/N) Y// ",%:DTIME
if '$TEST
SET %=U
if %=""
SET %="Y"
if "Yy"[%
SET XQALL=1
IF %["?"
WRITE !,"Please answer 'Y' or 'N' to this question."
GOTO ASK
ASKE READ !,"Show Entry and Exit Actions? (Y/N) N// ",%:DTIME
if '$TEST
SET %=U
if %=U
GOTO OUT
if %=""
SET %="N"
if "Yy"[%
SET XQE=1
+1 IF 'XQE
IF "YyNn"'[%
WRITE !!,"'Y' means you'll see the MUMPS code (if any) executed",!?3,"before and after the option is run. 'N' means you won't"
GOTO ASKE
+2 IF XQALL
SET XQUR=""
FOR XQII=0:0
SET XQUR=$ORDER(^VA(200,DUZ,19.8,"B",XQUR))
if XQUR=""
QUIT
DO DEED
DO WAIT
if XQIT
QUIT
+3 if XQALL
GOTO OUT
+4 DO FIND^XQT
if XQK
GOTO ASK
DO DEED
+5 GOTO ASK
+6 QUIT
DEED ;Decode the word processing field where templates are stored
+1 SET XQN=$ORDER(^VA(200,DUZ,19.8,"B",XQUR,0))
SET XQJ=$PIECE(^VA(200,DUZ,19.8,XQN,1,0),U,3)
+2 WRITE @IOF,!?20,"Menu Template ",XQUR,!!
SET XQV=3
SET XQLM=1
+3 FOR XQI=1:1:XQJ
SET %=^VA(200,DUZ,19.8,XQN,1,XQI,0)
SET %=$PIECE(%,U,2,999)
FOR XQK=1:1
SET XQ=$PIECE(%,U,XQK)
if XQ=""
QUIT
SET XQY=+XQ
SET XQEX=$PIECE(XQ,",",3)
SET XQY0=$SELECT($DATA(^DIC(19,+XQY,0))#2:^(0),1:"")
DO WRITE
if XQIT
QUIT
SET XQLM=XQLM+1
+4 QUIT
+5 ;
WRITE ;Write the Entry Action, Menu text, and Exit Action for an option
+1 IF XQE
IF $PIECE(XQY0,U,14)
WRITE !?XQLM,"Entry Action: ",^DIC(19,+XQY,20)
SET XQV=XQV+1
+2 IF XQE
IF $PIECE(XQY0,U,17)
WRITE !?XQLM,"Header: ",^DIC(19,+XQY,26)
SET XQV=XQV+1
+3 IF XQY0]""
WRITE !?XQLM,$PIECE(XQY0,U,2)_" ("_$PIECE(XQY0,U)_")"
SET XQV=XQV+1
+4 IF '$TEST
WRITE !!?XQLM,"*** Fatal Error *** Option missing from Option File ***",!?XQLM,"This template will not run. Delete and/or rebuild it."
SET XQIT=1
QUIT
+5 IF XQE
IF $PIECE(XQY0,U,15)
WRITE !?XQLM,"Exit Action: ",^DIC(19,+XQY,15)
SET XQV=XQV+1
+6 IF XQV>20
IF IOST["C-"
DO WAIT
if XQIT
QUIT
WRITE @IOF,?10,"Template ",XQUR," continued..."
SET XQV=1
+7 QUIT
+8 ;
WAIT ;That's a screen load hold it here for a minute
+1 SET XQIT=0
WRITE !!,"Hit RETURN to continue, '^' to quit: "
SET X=""
READ X:DTIME
if '$TEST
SET X=U
if X=U
SET XQIT=1
SET XQLM=1
+2 QUIT
+3 ;
KILL ;Remove a template from the New Person File
+1 SET U="^"
+2 READ !!,"Which template should be deleted ? ",XQUR:DTIME
if '$TEST
SET XQUR=U
if XQUR=U
QUIT
IF XQUR="?"
WRITE !,"Enter a template name, '??' to get a list of your templates",!," or '^' to quit."
GOTO KILL
+3 IF XQUR["??"
DO SHO
WRITE !!
GOTO KILL
+4 DO FIND^XQT
IF XQK
KILL XQ,XQI,XQJ,XQK
QUIT
K1 WRITE !,"I will remove the Menu Template ",XQUR," permanently. OK? (Y/N) N// "
READ %:DTIME
if '$TEST
SET %=U
if %=""
SET %="N"
if %=U
GOTO K2
if "Nn"[%
GOTO KILL
IF "Yy"'[%
WRITE !,"Please answer 'Y' or 'N' or '^' to quit."
GOTO K1
+1 SET DA=$ORDER(^VA(200,DUZ,19.8,"B",XQUR,0))
SET DA(1)=DUZ
SET DIK="^VA(200,"_DA(1)_",19.8,"
DO ^DIK
K2 KILL DA,DIK,XQ,XQI,XQJ,XQK
+1 QUIT
+2 ;
RNAM ;Rename an exsisting Menu Template
+1 SET U="^"
SET DA(1)=DUZ
SET DIC="^VA(200,"_DA(1)_",19.8,"
SET DIC("P")=200.198
SET DIC(0)="AEQM"
SET DIC("A")="Rename which template? "
DO ^DIC
IF Y<0
KILL %,%Y,CD,DA,DIC,FUN
QUIT
+2 SET DIE=DIC
SET DIE("P")=DIC("P")
SET DA=+Y
SET DR=".01"
DO ^DIE
+3 KILL CD,D,D0,DA,DI,DIC,DIE,DISYS,DR,DQ,FUN
+4 QUIT
