Routine: XQT1

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

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQT1   4448     printed  Mar 13, 2025@21:11:42                                                                                                                                                                                                        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

XQT1.m