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/XQT1.m@ 1569

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1XQT1 ;SEA/MJM - Menu Template Processor ;04/07/99 12:13
2 ;;8.0;KERNEL;**59,37**;Jul 10, 1995
3 ;This routine should be a mirror image of XQ1
4 ;
5 S (XQPT,^XUTL("XQT",$J,0))=XQUR,^(XQPT,"T")=0
6 ;
7KILL K D,D0,D1,DA,DIC,DIE,DIR,DIS,DR,XQI,XQV,XQW,XQZ
8 ;
9NXT ;Process the next option, entry/exit actions,start list over, or quit
10 I $D(^(^XUTL("XQT",$J,XQPT,"T"),"X")) X ^("X")
11 I '$D(DT)!('$D(DTIME))!('$D(DUZ))!('$D(DUZ(0))) D DVARS^XQ12
12 S:'$D(XQPT)#2 XQPT=^XUTL("XQT",$J,0) S ^("T")=^XUTL("XQT",$J,XQPT,"T")+1
13ASK I '$D(^(^XUTL("XQT",$J,XQPT,"T"))) G:'^("RPT") OUT S ^("T")=1 W !!,"Again? Y// " R %:DTIME S:'$T %=U S:%="" %="Y" G:%=U!("Nn"[%) OUT D:%["??" HELP I "Yy"'[% W !!,"Please type 'Y' or 'N', '^' to quit, or '??' for help." G ASK
14 S:'$D(XQPT)#2 XQPT=^XUTL("XQT",$J,0) S %=^(^XUTL("XQT",$J,XQPT,"T")),XQY=+%,XQDIC=$P(%,U,2),XQY0=$P(%,U,3,99)
15 I $D(^(^XUTL("XQT",$J,XQPT,"T"),"H")) X ^("H")
16 I $D(^(^XUTL("XQT",$J,XQPT,"T"),"E")),$P(XQY0,U,4)'="A" X ^("E") I $D(XQUIT) D T^XQUIT I $D(XQUIT) K XQUIT W !!,"XQUIT encountered at option ",$P(XQY0,U,2),!,?5,"template ",XQPT," halted by this encounter. Sorry." G OUT
17 W !?5,"Executing: ",$P(XQY0,U,2)
18 S XQT=$P(XQY0,U,4) I "M"'[XQT G @XQT
19 G NXT
20 ;
21OUT ;End of the line for this puppy: return to regular menu system
22 I $D(XQXFLG("ZEBRA")) L ^XWB("SESSION",XQXFLG("ZEBRA")) ;Clear by setting new lock
23 E L ;Clear the lock table
24 ;
25 K ^XUTL("XQT",$J,0),^(XQPT,"T"),XQPT
26 S %=^XUTL("XQ",$J,"S"),XQY=+%,XQDIC=$P(%,U,2),XQY0=$P(%,U,3,99),XQT=$P(XQY0,U,4)
27 K D0,D1,DA,DIC,DIE,DR,XQUIT,XQI,XQV,XQW,XQZ
28 G NOFIND^XQ
29 ;
30HELP ;Call the help screen
31 S XQH="XQTREPEAT" D EN^XQH
32 Q
33 ;
34A ;ACTION type option entry point
35 X:$D(^DIC(19,+XQY,20)) ^(20)
36 I $D(XQUIT) D T^XQUIT I $D(XQUIT) K XQUIT W !!,"XQUIT encountered at option ",$P(XQY0,U,2),!,?5,"template ",XQPT," halted by this encounter. Sorry." G OUT
37 I $P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26)
38 G NXT
39 ;
40B ;Broker type option. Not allowed in templates.
41 G NXT
42 ;
43C ;SCREEN type option entry point
44 D DIC G:DA=-1 KILL S XQZ="DR,DDSFILE,DDSFILE(1)",XQW=39 D SET
45 S DDSPAGE=$P($G(^DIC(19,+XQY,43)),U) K:DDSPAGE="" DDSPAGE
46 S DDSPARM=$P($G(^DIC(19,+XQY,43)),U,2) K:DDSPARM="" DDSPARM
47 I DDSFILE["(",DDSFILE'[U S DDSFILE=U_DDSFILE
48 I $D(DDSFILE(1)),DDSFILE(1)["(",DDSFILE(1)'[U S DDSFILE(1)=U_DDSFILE(1)
49 D ^DDS K DDSFILE G C
50 ;
51P ;PRINT type option entry point
52 S XQZ="DIC,PG,L,FLDS,BY,FR,TO,DHD,DCOPIES,DIS(0),IOP,DHIT,DIOBEG,DIOEND",XQW=59 D SET
53 I $D(DIS(0))#2 F XQI=1:1:3 Q:'$D(^DIC(19,+XQY,69+(XQI/10))) Q:^(69+(XQI/10))="" S DIS(XQI)=^(69+(XQI/10))
54 S:$D(XQIOP) IOP=XQIOP
55 S XQI=$G(^DIC(19,XQY,79)) S:XQI>0 DIASKHD="" S:$P(XQI,U,2) DISUPNO=1 S:$P(XQI,U,3) DIPCRIT=1
56 D D1,EN1^DIP K IOP,DIOBERG,DIS,DP
57 G NXT
58 ;
59I ;INQUIRE type option entry point
60I1 D DIC G KILL:DA=-1 S DI=DIC,XQZ="DIC,DR,DIQ(0)",XQW=79 D SET,D1 S:$D(DIC)[0 DIC=DI
61 I $D(^DIC(19,+XQY,63)),$L(^(63)) S FLDS=^(63)
62 E S FLDS="[CAPTIONED]"
63 I $G(^DIC(19,+XQY,83))["Y" S IOP="HOME"
64 ;S:DUZ(0)'="@" DICS="I 1 Q:'$D(^(8)) F DW=1:1:$L(^(8)) I DUZ(0)[$E(^(8),DW) Q"
65 ;W:$D(IOF) @IOF D EN^DIQ S Y=XQY G I1
66I2 ;
67 W ! S XQZ="DHD",XQW=66 D SET K ^UTILITY($J),^(U,$J) S ^($J,1,DA)="",@("L=+$P("_DI_"0),U,2)"),DPP(1)=L_"^^^@",L=0,C=",",Q="""",DPP=1,DPP(1,"IX")="^UTILITY(U,$J,"_DI_"^2" D N^DIP1 S Y=XQY G I1
68 ;
69E ;EDIT type option entry point
70E1 D DIC G KILL:DA=-1 K DIE,DIC S XQZ="DIE,DR",XQW=49 D SET S XQZ="DIE(""W"")",XQW=53 D SET
71 I $D(^DIC(19,XQY,53)),$L(^(53)) S %=^(53),DIE("NO^")=$S(%="N":"",1:%)
72 S:DIE["(" DIE=U_DIE D ^DIE S Y=XQY G E1
73 ;
74DIC ;Get FileMan parameters from Option File and do look up
75 W ! K DIC S XQZ="DIC,DIC(0),DIC(""A""),DIC(""B""),DIC(""S""),DIC(""W""),D",XQW=29 D SET,D1
76 I '$D(D) D ^DIC
77 I $D(D) S:D="" D="B" D IX^DIC
78 S DA=+Y,Y=XQY
79 Q
80 ;
81D1 S:DIC["(" DIC=U_DIC Q
82 ;
83SET F XQI=1:1 S XQV=$P(XQZ,",",XQI) Q:XQV="" K @XQV I $D(^DIC(19,+XQY,XQW+XQI)),^(XQW+XQI)]"" S @XQV=^(XQW+XQI)
84 I $D(DIC("A")),DIC("A")]"" S DIC("A")=DIC("A")_" "
85 K XQI,J
86 Q
87 ;
88R ;RUN ROUTINE type option entry point
89 G:'$D(^DIC(19,XQY,25)) NXT S XQZ=^(25) G:'$L(XQZ) NXT S:XQZ'[U XQZ=U_XQZ I XQZ["[" D DO^%XUCI G NXT
90 D @XQZ
91 G NXT
92 ;
93L ;OE/RR Limited Option type
94O ;OE/RR Protocol (orderables) type option entry point
95X ;OE/RR Extended Action type option (Subset of Protocol type)
96Q ;OE/RR Protocol Menu type option entry point
97 S XQOR=+XQY,XQOR(1)=XQT D XQ^XQOR K XQOR
98 G NXT
99 Q
Note: See TracBrowser for help on using the repository browser.