XQT1 ;SEA/MJM - Menu Template Processor ;04/07/99 12:13
;;8.0;KERNEL;**59,37**;Jul 10, 1995
;This routine should be a mirror image of XQ1
;
S (XQPT,^XUTL("XQT",$J,0))=XQUR,^(XQPT,"T")=0
;
KILL K D,D0,D1,DA,DIC,DIE,DIR,DIS,DR,XQI,XQV,XQW,XQZ
;
NXT ;Process the next option, entry/exit actions,start list over, or quit
I $D(^(^XUTL("XQT",$J,XQPT,"T"),"X")) X ^("X")
I '$D(DT)!('$D(DTIME))!('$D(DUZ))!('$D(DUZ(0))) D DVARS^XQ12
S:'$D(XQPT)#2 XQPT=^XUTL("XQT",$J,0) S ^("T")=^XUTL("XQT",$J,XQPT,"T")+1
ASK 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
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)
I $D(^(^XUTL("XQT",$J,XQPT,"T"),"H")) X ^("H")
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
W !?5,"Executing: ",$P(XQY0,U,2)
S XQT=$P(XQY0,U,4) I "M"'[XQT G @XQT
G NXT
;
OUT ;End of the line for this puppy: return to regular menu system
I $D(XQXFLG("ZEBRA")) L ^XWB("SESSION",XQXFLG("ZEBRA")) ;Clear by setting new lock
E L ;Clear the lock table
;
K ^XUTL("XQT",$J,0),^(XQPT,"T"),XQPT
S %=^XUTL("XQ",$J,"S"),XQY=+%,XQDIC=$P(%,U,2),XQY0=$P(%,U,3,99),XQT=$P(XQY0,U,4)
K D0,D1,DA,DIC,DIE,DR,XQUIT,XQI,XQV,XQW,XQZ
G NOFIND^XQ
;
HELP ;Call the help screen
S XQH="XQTREPEAT" D EN^XQH
Q
;
A ;ACTION type option entry point
X:$D(^DIC(19,+XQY,20)) ^(20)
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
I $P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26)
G NXT
;
B ;Broker type option. Not allowed in templates.
G NXT
;
C ;SCREEN type option entry point
D DIC G:DA=-1 KILL S XQZ="DR,DDSFILE,DDSFILE(1)",XQW=39 D SET
S DDSPAGE=$P($G(^DIC(19,+XQY,43)),U) K:DDSPAGE="" DDSPAGE
S DDSPARM=$P($G(^DIC(19,+XQY,43)),U,2) K:DDSPARM="" DDSPARM
I DDSFILE["(",DDSFILE'[U S DDSFILE=U_DDSFILE
I $D(DDSFILE(1)),DDSFILE(1)["(",DDSFILE(1)'[U S DDSFILE(1)=U_DDSFILE(1)
D ^DDS K DDSFILE G C
;
P ;PRINT type option entry point
S XQZ="DIC,PG,L,FLDS,BY,FR,TO,DHD,DCOPIES,DIS(0),IOP,DHIT,DIOBEG,DIOEND",XQW=59 D SET
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))
S:$D(XQIOP) IOP=XQIOP
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
D D1,EN1^DIP K IOP,DIOBERG,DIS,DP
G NXT
;
I ;INQUIRE type option entry point
I1 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
I $D(^DIC(19,+XQY,63)),$L(^(63)) S FLDS=^(63)
E S FLDS="[CAPTIONED]"
I $G(^DIC(19,+XQY,83))["Y" S IOP="HOME"
;S:DUZ(0)'="@" DICS="I 1 Q:'$D(^(8)) F DW=1:1:$L(^(8)) I DUZ(0)[$E(^(8),DW) Q"
;W:$D(IOF) @IOF D EN^DIQ S Y=XQY G I1
I2 ;
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
;
E ;EDIT type option entry point
E1 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
I $D(^DIC(19,XQY,53)),$L(^(53)) S %=^(53),DIE("NO^")=$S(%="N":"",1:%)
S:DIE["(" DIE=U_DIE D ^DIE S Y=XQY G E1
;
DIC ;Get FileMan parameters from Option File and do look up
W ! K DIC S XQZ="DIC,DIC(0),DIC(""A""),DIC(""B""),DIC(""S""),DIC(""W""),D",XQW=29 D SET,D1
I '$D(D) D ^DIC
I $D(D) S:D="" D="B" D IX^DIC
S DA=+Y,Y=XQY
Q
;
D1 S:DIC["(" DIC=U_DIC Q
;
SET 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)
I $D(DIC("A")),DIC("A")]"" S DIC("A")=DIC("A")_" "
K XQI,J
Q
;
R ;RUN ROUTINE type option entry point
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
D @XQZ
G NXT
;
L ;OE/RR Limited Option type
O ;OE/RR Protocol (orderables) type option entry point
X ;OE/RR Extended Action type option (Subset of Protocol type)
Q ;OE/RR Protocol Menu type option entry point
S XQOR=+XQY,XQOR(1)=XQT D XQ^XQOR K XQOR
G NXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQT1 4448 printed Nov 22, 2024@17:16:57 Page 2
XQT1 ;SEA/MJM - Menu Template Processor ;04/07/99 12:13
+1 ;;8.0;KERNEL;**59,37**;Jul 10, 1995
+2 ;This routine should be a mirror image of XQ1
+3 ;
+4 SET (XQPT,^XUTL("XQT",$JOB,0))=XQUR
SET ^(XQPT,"T")=0
+5 ;
KILL KILL D,D0,D1,DA,DIC,DIE,DIR,DIS,DR,XQI,XQV,XQW,XQZ
+1 ;
NXT ;Process the next option, entry/exit actions,start list over, or quit
+1 IF $DATA(^(^XUTL("XQT",$JOB,XQPT,"T"),"X"))
XECUTE ^("X")
+2 IF '$DATA(DT)!('$DATA(DTIME))!('$DATA(DUZ))!('$DATA(DUZ(0)))
DO DVARS^XQ12
+3 if '$DATA(XQPT)#2
SET XQPT=^XUTL("XQT",$JOB,0)
SET ^("T")=^XUTL("XQT",$JOB,XQPT,"T")+1
ASK IF '$DATA(^(^XUTL("XQT",$JOB,XQPT,"T")))
if '^("RPT")
GOTO OUT
SET ^("T")=1
WRITE !!,"Again? Y// "
READ %:DTIME
if '$TEST
SET %=U
if %=""
SET %="Y"
if %=U!("Nn"[%)
GOTO OUT
if %["??"
DO HELP
IF "Yy"'[%
WRITE !!,"Please type 'Y' or 'N', '^' to quit, or '??' for help."
GOTO ASK
+1 if '$DATA(XQPT)#2
SET XQPT=^XUTL("XQT",$JOB,0)
SET %=^(^XUTL("XQT",$JOB,XQPT,"T"))
SET XQY=+%
SET XQDIC=$PIECE(%,U,2)
SET XQY0=$PIECE(%,U,3,99)
+2 IF $DATA(^(^XUTL("XQT",$JOB,XQPT,"T"),"H"))
XECUTE ^("H")
+3 IF $DATA(^(^XUTL("XQT",$JOB,XQPT,"T"),"E"))
IF $PIECE(XQY0,U,4)'="A"
XECUTE ^("E")
IF $DATA(XQUIT)
DO T^XQUIT
IF $DATA(XQUIT)
KILL XQUIT
WRITE !!,"XQUIT encountered at option ",$PIECE(XQY0,U,2),!,?5,"template ",XQPT," halted by this encounter. Sorry."
GOTO OUT
+4 WRITE !?5,"Executing: ",$PIECE(XQY0,U,2)
+5 SET XQT=$PIECE(XQY0,U,4)
IF "M"'[XQT
GOTO @XQT
+6 GOTO NXT
+7 ;
OUT ;End of the line for this puppy: return to regular menu system
+1 ;Clear by setting new lock
IF $DATA(XQXFLG("ZEBRA"))
LOCK ^XWB("SESSION",XQXFLG("ZEBRA"))
+2 ;Clear the lock table
IF '$TEST
LOCK
+3 ;
+4 KILL ^XUTL("XQT",$JOB,0),^(XQPT,"T"),XQPT
+5 SET %=^XUTL("XQ",$JOB,"S")
SET XQY=+%
SET XQDIC=$PIECE(%,U,2)
SET XQY0=$PIECE(%,U,3,99)
SET XQT=$PIECE(XQY0,U,4)
+6 KILL D0,D1,DA,DIC,DIE,DR,XQUIT,XQI,XQV,XQW,XQZ
+7 GOTO NOFIND^XQ
+8 ;
HELP ;Call the help screen
+1 SET XQH="XQTREPEAT"
DO EN^XQH
+2 QUIT
+3 ;
A ;ACTION type option entry point
+1 if $DATA(^DIC(19,+XQY,20))
XECUTE ^(20)
+2 IF $DATA(XQUIT)
DO T^XQUIT
IF $DATA(XQUIT)
KILL XQUIT
WRITE !!,"XQUIT encountered at option ",$PIECE(XQY0,U,2),!,?5,"template ",XQPT," halted by this encounter. Sorry."
GOTO OUT
+3 IF $PIECE(XQY0,U,17)
IF $DATA(^DIC(19,XQY,26))
IF $LENGTH(^(26))
XECUTE ^(26)
+4 GOTO NXT
+5 ;
B ;Broker type option. Not allowed in templates.
+1 GOTO NXT
+2 ;
C ;SCREEN type option entry point
+1 DO DIC
if DA=-1
GOTO KILL
SET XQZ="DR,DDSFILE,DDSFILE(1)"
SET XQW=39
DO SET
+2 SET DDSPAGE=$PIECE($GET(^DIC(19,+XQY,43)),U)
if DDSPAGE=""
KILL DDSPAGE
+3 SET DDSPARM=$PIECE($GET(^DIC(19,+XQY,43)),U,2)
if DDSPARM=""
KILL DDSPARM
+4 IF DDSFILE["("
IF DDSFILE'[U
SET DDSFILE=U_DDSFILE
+5 IF $DATA(DDSFILE(1))
IF DDSFILE(1)["("
IF DDSFILE(1)'[U
SET DDSFILE(1)=U_DDSFILE(1)
+6 DO ^DDS
KILL DDSFILE
GOTO C
+7 ;
P ;PRINT type option entry point
+1 SET XQZ="DIC,PG,L,FLDS,BY,FR,TO,DHD,DCOPIES,DIS(0),IOP,DHIT,DIOBEG,DIOEND"
SET XQW=59
DO SET
+2 IF $DATA(DIS(0))#2
FOR XQI=1:1:3
if '$DATA(^DIC(19,+XQY,69+(XQI/10)))
QUIT
if ^(69+(XQI/10))=""
QUIT
SET DIS(XQI)=^(69+(XQI/10))
+3 if $DATA(XQIOP)
SET IOP=XQIOP
+4 SET XQI=$GET(^DIC(19,XQY,79))
if XQI>0
SET DIASKHD=""
if $PIECE(XQI,U,2)
SET DISUPNO=1
if $PIECE(XQI,U,3)
SET DIPCRIT=1
+5 DO D1
DO EN1^DIP
KILL IOP,DIOBERG,DIS,DP
+6 GOTO NXT
+7 ;
I ;INQUIRE type option entry point
I1 DO DIC
if DA=-1
GOTO KILL
SET DI=DIC
SET XQZ="DIC,DR,DIQ(0)"
SET XQW=79
DO SET
DO D1
if $DATA(DIC)[0
SET DIC=DI
+1 IF $DATA(^DIC(19,+XQY,63))
IF $LENGTH(^(63))
SET FLDS=^(63)
+2 IF '$TEST
SET FLDS="[CAPTIONED]"
+3 IF $GET(^DIC(19,+XQY,83))["Y"
SET IOP="HOME"
+4 ;S:DUZ(0)'="@" DICS="I 1 Q:'$D(^(8)) F DW=1:1:$L(^(8)) I DUZ(0)[$E(^(8),DW) Q"
+5 ;W:$D(IOF) @IOF D EN^DIQ S Y=XQY G I1
I2 ;
+1 WRITE !
SET XQZ="DHD"
SET XQW=66
DO SET
KILL ^UTILITY($JOB),^(U,$JOB)
SET ^($JOB,1,DA)=""
SET @("L=+$P("_DI_"0),U,2)")
SET DPP(1)=L_"^^^@"
SET L=0
SET C=","
SET Q=""""
SET DPP=1
SET DPP(1,"IX")="^UTILITY(U,$J,"_DI_"^2"
DO N^DIP1
SET Y=XQY
GOTO I1
+2 ;
E ;EDIT type option entry point
E1 DO DIC
if DA=-1
GOTO KILL
KILL DIE,DIC
SET XQZ="DIE,DR"
SET XQW=49
DO SET
SET XQZ="DIE(""W"")"
SET XQW=53
DO SET
+1 IF $DATA(^DIC(19,XQY,53))
IF $LENGTH(^(53))
SET %=^(53)
SET DIE("NO^")=$SELECT(%="N":"",1:%)
+2 if DIE["("
SET DIE=U_DIE
DO ^DIE
SET Y=XQY
GOTO E1
+3 ;
DIC ;Get FileMan parameters from Option File and do look up
+1 WRITE !
KILL DIC
SET XQZ="DIC,DIC(0),DIC(""A""),DIC(""B""),DIC(""S""),DIC(""W""),D"
SET XQW=29
DO SET
DO D1
+2 IF '$DATA(D)
DO ^DIC
+3 IF $DATA(D)
if D=""
SET D="B"
DO IX^DIC
+4 SET DA=+Y
SET Y=XQY
+5 QUIT
+6 ;
D1 if DIC["("
SET DIC=U_DIC
QUIT
+1 ;
SET FOR XQI=1:1
SET XQV=$PIECE(XQZ,",",XQI)
if XQV=""
QUIT
KILL @XQV
IF $DATA(^DIC(19,+XQY,XQW+XQI))
IF ^(XQW+XQI)]""
SET @XQV=^(XQW+XQI)
+1 IF $DATA(DIC("A"))
IF DIC("A")]""
SET DIC("A")=DIC("A")_" "
+2 KILL XQI,J
+3 QUIT
+4 ;
R ;RUN ROUTINE type option entry point
+1 if '$DATA(^DIC(19,XQY,25))
GOTO NXT
SET XQZ=^(25)
if '$LENGTH(XQZ)
GOTO NXT
if XQZ'[U
SET XQZ=U_XQZ
IF XQZ["["
DO DO^%XUCI
GOTO NXT
+2 DO @XQZ
+3 GOTO NXT
+4 ;
L ;OE/RR Limited Option type
O ;OE/RR Protocol (orderables) type option entry point
X ;OE/RR Extended Action type option (Subset of Protocol type)
Q ;OE/RR Protocol Menu type option entry point
+1 SET XQOR=+XQY
SET XQOR(1)=XQT
DO XQ^XQOR
KILL XQOR
+2 GOTO NXT
+3 QUIT
