source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQT4.m@ 1625

Last change on this file since 1625 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1XQT4 ;SEA/MJM - Menu template utilities ;08/27/97 14:52
2 ;;8.0;KERNEL;**46**;Jul 10, 1995
3 S U="^"
4SHO ;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
11KIL K %,%1,%2,%Y,XQI,XQLN,XQN,XQIT,XQUSER,XQV
12 Q
13SHO1 ;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
21OUT ;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 ;
26LIST ;List all of the options in a particular Menu Template
27 S U="^",XQTSV=XQY_U_XQDIC_U_XQY0
28ASK 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
32ASKE 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
39DEED ;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 ;
45WRITE ;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 ;
54WAIT ;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 ;
58KILL ;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
63K1 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
65K2 K DA,DIK,XQ,XQI,XQJ,XQK
66 Q
67 ;
68RNAM ;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
Note: See TracBrowser for help on using the repository browser.