- 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 Feb 18, 2025@23:33:17 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