| [613] | 1 | XQT4 ;SEA/MJM - Menu template utilities ;08/27/97 14:52
|
|---|
| 2 | ;;8.0;KERNEL;**46**;Jul 10, 1995
|
|---|
| 3 | S U="^"
|
|---|
| 4 | SHO ;Show a user his or her template names
|
|---|
| 5 | S XQUSER=$P($P(^VA(200,DUZ,0),U),",",2)_" "_$P($P(^(0),U),",")
|
|---|
| 6 | S U="^",(XQI,XQN,XQIT,XQV)=0
|
|---|
| 7 | 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
|
|---|
| 8 | D HOME^%ZIS:'$D(IOF),^XQDATE
|
|---|
| 9 | W @IOF,!,?10,"The menu templates of ",XQUSER," ",%Y S XQV=2
|
|---|
| 10 | D SHO1 F XQI=0:0 S XQN=$O(^VA(200,DUZ,19.8,"B",XQN)) Q:XQN="" D SHO1 Q:XQIT
|
|---|
| 11 | KIL K %,%1,%2,%Y,XQI,XQLN,XQN,XQIT,XQUSER,XQV
|
|---|
| 12 | Q
|
|---|
| 13 | SHO1 ;Write out template name and the first two options in it
|
|---|
| 14 | 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)
|
|---|
| 15 | I IOST["C-",'$D(ZTQUEUED),XQV+5>21 S XQV=0 D WAIT Q:XQIT W @IOF
|
|---|
| 16 | W !!,"Template name: ",XQN S XQV=XQV+2
|
|---|
| 17 | I %1 W !,?3,"1st option: ",$S($D(^DIC(19,%1,0))#2:$P(^(0),U,2),1:"*** Missing Option ***") S XQV=XQV+1
|
|---|
| 18 | I %2 W !,?6,"2nd option: ",$S($D(^DIC(19,%2,0))#2:$P(^(0),U,2),1:"*** Missing Option ***") S XQV=XQV+1
|
|---|
| 19 | I $L($P(%,U,3)) W !,?9,"Etc." S XQV=XQV+1
|
|---|
| 20 | Q
|
|---|
| 21 | OUT ;Clean up and quit
|
|---|
| 22 | S XQY=+XQTSV,XQDIC=$P(XQTSV,U,2),XQY0=$P(XQTSV,U,3,99)
|
|---|
| 23 | K %,%1,%2,X,XQ,XQALL,XQE,XQEX,XQI,XQII,XQJ,XQLM,XQN,XQTSV,XQIT,XQUR,Y
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | LIST ;List all of the options in a particular Menu Template
|
|---|
| 27 | S U="^",XQTSV=XQY_U_XQDIC_U_XQY0
|
|---|
| 28 | ASK S (XQALL,XQE,XQIT)=0
|
|---|
| 29 | 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
|
|---|
| 30 | I XQUR="??" N XQIT D SHO G ASK
|
|---|
| 31 | 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
|
|---|
| 32 | ASKE R !,"Show Entry and Exit Actions? (Y/N) N// ",%:DTIME S:'$T %=U G:%=U OUT S:%="" %="N" S:"Yy"[% XQE=1
|
|---|
| 33 | 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
|
|---|
| 34 | 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
|
|---|
| 35 | G:XQALL OUT
|
|---|
| 36 | D FIND^XQT G:XQK ASK D DEED
|
|---|
| 37 | G ASK
|
|---|
| 38 | Q
|
|---|
| 39 | DEED ;Decode the word processing field where templates are stored
|
|---|
| 40 | S XQN=$O(^VA(200,DUZ,19.8,"B",XQUR,0)),XQJ=$P(^VA(200,DUZ,19.8,XQN,1,0),U,3)
|
|---|
| 41 | W @IOF,!?20,"Menu Template ",XQUR,!! S XQV=3,XQLM=1
|
|---|
| 42 | 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
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | WRITE ;Write the Entry Action, Menu text, and Exit Action for an option
|
|---|
| 46 | I XQE,$P(XQY0,U,14) W !?XQLM,"Entry Action: ",^DIC(19,+XQY,20) S XQV=XQV+1
|
|---|
| 47 | I XQE,$P(XQY0,U,17) W !?XQLM,"Header: ",^DIC(19,+XQY,26) S XQV=XQV+1
|
|---|
| 48 | I XQY0]"" W !?XQLM,$P(XQY0,U,2)_" ("_$P(XQY0,U)_")" S XQV=XQV+1
|
|---|
| 49 | 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
|
|---|
| 50 | I XQE,$P(XQY0,U,15) W !?XQLM,"Exit Action: ",^DIC(19,+XQY,15) S XQV=XQV+1
|
|---|
| 51 | I XQV>20,IOST["C-" D WAIT Q:XQIT W @IOF,?10,"Template ",XQUR," continued..." S XQV=1
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | WAIT ;That's a screen load hold it here for a minute
|
|---|
| 55 | 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
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | KILL ;Remove a template from the New Person File
|
|---|
| 59 | S U="^"
|
|---|
| 60 | 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
|
|---|
| 61 | I XQUR["??" D SHO W !! G KILL
|
|---|
| 62 | D FIND^XQT I XQK K XQ,XQI,XQJ,XQK Q
|
|---|
| 63 | 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
|
|---|
| 64 | S DA=$O(^VA(200,DUZ,19.8,"B",XQUR,0)),DA(1)=DUZ,DIK="^VA(200,"_DA(1)_",19.8," D ^DIK
|
|---|
| 65 | K2 K DA,DIK,XQ,XQI,XQJ,XQK
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | RNAM ;Rename an exsisting Menu Template
|
|---|
| 69 | 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
|
|---|
| 70 | S DIE=DIC,DIE("P")=DIC("P"),DA=+Y,DR=".01" D ^DIE
|
|---|
| 71 | K CD,D,D0,DA,DI,DIC,DIE,DISYS,DR,DQ,FUN
|
|---|
| 72 | Q
|
|---|
