XQ8A.m

XQ8A ;SEA/LUKE - Rebuild menus in all production accounts ;06/26/2000  09:15 [ 07/29/2004   9:01 AM ]

 ;;8.0;KERNEL;**46,157**;Jul 10, 1995

BLD1 ;Build the ^XUTL("XQO") for a single XQDIC in all production UCI's

 S XQ8SV=XQY_U_XQDIC_U_XQY0

BLD12 K DIC S DIC="^DIC(19,",DIC(0)="AEQMZ" D ^DIC I Y<1 K DIC Q

 I $P(Y(0),U,4)'="M" W !!,$P(Y(0),U)," is not a menu-type option and can't be compiled." G BLD12

 S XQDIC="P"_+Y,XQXUF="" I +Y=$O(^DIC(19,"B","XUCOMMAND",0)) S XQDIC="PXU" K XQXUF

 S DIR(0)="Y",DIR("A")="Que rebuilds on all production UCI's",DIR("B")="N",DIR("?")="Answering 'Y' will cause a job to be queued on all production UCI's" D ^DIR S XQUR=Y

 W !!,"Task number(s):" S (ZTUCI,ZTVOL)="" D FIRE

 I 'XQUR G OUT

 S ZTVOL=0 D GETENV^%ZOSV S XQHERE=$P(Y,U,2),XQPROD=$P(^%ZOSF("PROD"),",")

 F XQI=0:0 S ZTVOL=$O(^%ZIS(14.5,"B",ZTVOL)) Q:ZTVOL=""  S ZTUCI=$O(^%ZIS(14.6,"AT",XQPROD,XQHERE,ZTVOL,"")) I ZTUCI]"" D FIRE

 ;

OUT ;Exit here

 S XQY=+XQ8SV,XQDIC=$P(XQ8SV,U,2),XQY0=$P(XQ8SV,3,99)

 K %,%X,%Y,DIC,DIR,XQ8SV,XQDATE,XQFG1,XQHERE,XQI,XQPROD,XQRE,XQUCI,XQUR,XQVOL,XQXUF,ZTSK,ZTUCI,ZTVOL,Y

 Q

FIRE ;Fire off a task in selected UCI

 S (XQRE,XQFG1)=0,ZTIO="",ZTRTN="PM1^XQ8",ZTDTH=$H,ZTSAVE("XQDIC")="",ZTSAVE("XQRE")="",ZTSAVE("XQFG1")="",ZTDESC="Rebuilding "_XQDIC_" from FIRE^XQ8A"

 S:$D(XQXUF) ZTSAVE("XQXUF")=""

 D ^%ZTLOAD W " ",ZTSK

 Q

 ;

ALL ;Rebuild menus in all UCI's marked in the UCI Association Table

 ;  which is in %ZIS(14.6)

 D ^XQDATE S XQDATE=%Y

 K ^DIC(19,"AT")

 S XQVOL=""

 F  S XQVOL=$O(^%ZIS(14.5,"B",XQVOL)) Q:XQVOL=""  D

 .S XQUCI=""

 .F  S XQUCI=$O(^%ZIS(14.6,"AV",XQVOL,XQUCI)) Q:XQUCI=""  D

 ..S XQN=$O(^%ZIS(14.6,"AV",XQVOL,XQUCI,0)) Q:XQN=""

 ..I $P(^%ZIS(14.6,XQN,0),U,7) D FIRE2

 ..Q

 .Q

 K %,%Y,XQDATE,XQUCI,XQVOL

 Q

FIRE2 ;Queue menubuild in a particular UCI

 S (XQRE,XQFG1)=0,ZTSAVE("XQRE")="",ZTSAVE("XQFG1")=""

 S ZTCPU=XQVOL,ZTUCI=XQUCI

 S ZTRTN="QUE^XQ81",ZTDTH=$H,ZTIO=""

 S ZTDESC="Menu rebuild in "_ZTCPU_","_ZTUCI_" on "_XQDATE

 D ^%ZTLOAD

 Q

XQ8A      ;SEA/LUKE - Rebuild menus in all production accounts ;06/26/2000  09:15 [ 07/29/2004   9:01 AM ]

 +1       ;;8.0;KERNEL;**46,157**;Jul 10, 1995

BLD1      ;Build the ^XUTL("XQO") for a single XQDIC in all production UCI's

 +1        SET XQ8SV=XQY_U_XQDIC_U_XQY0

BLD12      KILL DIC

           SET DIC="^DIC(19,"

           SET DIC(0)="AEQMZ"

           DO ^DIC

           IF Y<1

               KILL DIC

               QUIT 

 +1        IF $PIECE(Y(0),U,4)'="M"

               WRITE !!,$PIECE(Y(0),U)," is not a menu-type option and can't be compiled."

               GOTO BLD12

 +2        SET XQDIC="P"_+Y

           SET XQXUF=""

           IF +Y=$ORDER(^DIC(19,"B","XUCOMMAND",0))

               SET XQDIC="PXU"

               KILL XQXUF

 +3        SET DIR(0)="Y"

           SET DIR("A")="Que rebuilds on all production UCI's"

           SET DIR("B")="N"

           SET DIR("?")="Answering 'Y' will cause a job to be queued on all production UCI's"

           DO ^DIR

           SET XQUR=Y

 +4        WRITE !!,"Task number(s):"

           SET (ZTUCI,ZTVOL)=""

           DO FIRE

 +5        IF 'XQUR

               GOTO OUT

 +6        SET ZTVOL=0

           DO GETENV^%ZOSV

           SET XQHERE=$PIECE(Y,U,2)

           SET XQPROD=$PIECE(^%ZOSF("PROD"),",")

 +7        FOR XQI=0:0

               SET ZTVOL=$ORDER(^%ZIS(14.5,"B",ZTVOL))

               IF ZTVOL=""

                   QUIT 

               SET ZTUCI=$ORDER(^%ZIS(14.6,"AT",XQPROD,XQHERE,ZTVOL,""))

               IF ZTUCI]""

                   DO FIRE

 +8       ;

OUT       ;Exit here

 +1        SET XQY=+XQ8SV

           SET XQDIC=$PIECE(XQ8SV,U,2)

           SET XQY0=$PIECE(XQ8SV,3,99)

 +2        KILL %,%X,%Y,DIC,DIR,XQ8SV,XQDATE,XQFG1,XQHERE,XQI,XQPROD,XQRE,XQUCI,XQUR,XQVOL,XQXUF,ZTSK,ZTUCI,ZTVOL,Y

 +3        QUIT 

FIRE      ;Fire off a task in selected UCI

 +1        SET (XQRE,XQFG1)=0

           SET ZTIO=""

           SET ZTRTN="PM1^XQ8"

           SET ZTDTH=$HOROLOG

           SET ZTSAVE("XQDIC")=""

           SET ZTSAVE("XQRE")=""

           SET ZTSAVE("XQFG1")=""

           SET ZTDESC="Rebuilding "_XQDIC_" from FIRE^XQ8A"

 +2        IF $DATA(XQXUF)

               SET ZTSAVE("XQXUF")=""

 +3        DO ^%ZTLOAD

           WRITE " ",ZTSK

 +4        QUIT 

 +5       ;

ALL       ;Rebuild menus in all UCI's marked in the UCI Association Table

 +1       ;  which is in %ZIS(14.6)

 +2        DO ^XQDATE

           SET XQDATE=%Y

 +3        KILL ^DIC(19,"AT")

 +4        SET XQVOL=""

 +5        FOR 

               SET XQVOL=$ORDER(^%ZIS(14.5,"B",XQVOL))

               IF XQVOL=""

                   QUIT 

               Begin DoDot:1

 +6                SET XQUCI=""

 +7                FOR 

                       SET XQUCI=$ORDER(^%ZIS(14.6,"AV",XQVOL,XQUCI))

                       IF XQUCI=""

                           QUIT 

                       Begin DoDot:2

 +8                        SET XQN=$ORDER(^%ZIS(14.6,"AV",XQVOL,XQUCI,0))

                           IF XQN=""

                               QUIT 

 +9                        IF $PIECE(^%ZIS(14.6,XQN,0),U,7)

                               DO FIRE2

 +10                       QUIT 

                       End DoDot:2

 +11               QUIT 

               End DoDot:1

 +12       KILL %,%Y,XQDATE,XQUCI,XQVOL

 +13       QUIT 

FIRE2     ;Queue menubuild in a particular UCI

 +1        SET (XQRE,XQFG1)=0

           SET ZTSAVE("XQRE")=""

           SET ZTSAVE("XQFG1")=""

 +2        SET ZTCPU=XQVOL

           SET ZTUCI=XQUCI

 +3        SET ZTRTN="QUE^XQ81"

           SET ZTDTH=$HOROLOG

           SET ZTIO=""

 +4        SET ZTDESC="Menu rebuild in "_ZTCPU_","_ZTUCI_" on "_XQDATE

 +5        DO ^%ZTLOAD

 +6        QUIT