- XQ8A ;SEA/LUKE - Rebuild menus in all production accounts ;06/26/2000 09:15
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ8A 2009 printed Feb 18, 2025@23:31:37 Page 2
- XQ8A ;SEA/LUKE - Rebuild menus in all production accounts ;06/26/2000 09:15
- +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