XTSUMCK1.m

XTSUMCK1 ;Boise/MAW,SFISC/RSD-process routine checksum job results ;10/04/96  12:37 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;**44**;Jul 10, 1995

 ;this routine is normally called via an ALERT process...

 W !!,"ROUTINE CHECKSUM REPORT"

 I '$D(^XTMP("XTSUMCK",DUZ,"SYS")) W *7,!!,"ERROR -- NO data to retrieve!" Q

 D EN^XUTMDEVQ("DQ^XTSUMCK1","Print Routine Checksum Results","")

 W !

 Q

DQ ;TaskMan and display/print entry point

 N DIR,DIRUT,XTX,XTUCI,XTROU,XTSYS,XTUL,XTPG,XTY,XTCNT,X,Y

 Q:'$D(^XTMP("XTSUMCK",DUZ))  S XTX=^(DUZ)

 S $P(XTUL,"-",IOM)="",XTPG=0,XTUCI=$P($P(XTX,U,2),",")

 I $E(IOST)="C" W @IOF

 D HDR

 W !?31,"JOB STARTED: ",$$FMTE^XLFDT($P(XTX,U,5))

 W !?33,"JOB ENDED: ",$$FMTE^XLFDT($P(XTX,U))

 S XTSYS="",DIR(0)="E"

 F  S XTSYS=$O(^XTMP("XTSUMCK",DUZ,"SYS",XTSYS)) Q:XTSYS=""  D  Q:$D(DIRUT)

 .Q:$$CHK(4)

 .W !!,"UCI,VOL: ",XTUCI,",",XTSYS," -- "

 .S XTY=^XTMP("XTSUMCK",DUZ,"SYS",XTSYS) W:$P(XTY,U) $$FMTE^XLFDT($P(XTY,U))

 .W " -- ",$P(XTY,U,3)

 .S XTROU=""

 .F XTCNT=0:1 S XTROU=$O(^XTMP("XTSUMCK",DUZ,"SYS",XTSYS,XTROU)) Q:XTROU=""  S Y=^(XTROU) D  Q:$D(DIRUT)

 ..Q:$$CHK(2)

 ..W !?2,XTROU,?12,Y

 .W !!,?15,+$P(XTY,U,6)," Routine checked, ",XTCNT," failed.",!

 K ^XTMP("XTSUMCK",DUZ)

 I $E(IOST)="P" W @IOF

 I $D(ZTQUEUED) S ZTREQ="@"

 Q

CHK(Y) ;Y=excess lines, return 1 to exit & DIRUT is set

 Q:$Y<(IOSL-Y) 0

 I $E(IOST,1,2)="C-" D ^DIR Q:'Y 1

 W @IOF D HDR

 Q 0

 ;

HDR S XTPG=XTPG+1

 W !!,"MASTER ROUTINE SET USED RESIDES ON UCI,VOL: ",$P(XTX,U,2),?70,"PAGE ",XTPG,!,XTUL,!

 Q

XTSUMCK1  ;Boise/MAW,SFISC/RSD-process routine checksum job results ;10/04/96  12:37 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**44**;Jul 10, 1995

 +3       ;this routine is normally called via an ALERT process...

 +4        WRITE !!,"ROUTINE CHECKSUM REPORT"

 +5        IF '$DATA(^XTMP("XTSUMCK",DUZ,"SYS"))

               WRITE *7,!!,"ERROR -- NO data to retrieve!"

               QUIT 

 +6        DO EN^XUTMDEVQ("DQ^XTSUMCK1","Print Routine Checksum Results","")

 +7        WRITE !

 +8        QUIT 

DQ        ;TaskMan and display/print entry point

 +1        NEW DIR,DIRUT,XTX,XTUCI,XTROU,XTSYS,XTUL,XTPG,XTY,XTCNT,X,Y

 +2        IF '$DATA(^XTMP("XTSUMCK",DUZ))

               QUIT 

           SET XTX=^(DUZ)

 +3        SET $PIECE(XTUL,"-",IOM)=""

           SET XTPG=0

           SET XTUCI=$PIECE($PIECE(XTX,U,2),",")

 +4        IF $EXTRACT(IOST)="C"

               WRITE @IOF

 +5        DO HDR

 +6        WRITE !?31,"JOB STARTED: ",$$FMTE^XLFDT($PIECE(XTX,U,5))

 +7        WRITE !?33,"JOB ENDED: ",$$FMTE^XLFDT($PIECE(XTX,U))

 +8        SET XTSYS=""

           SET DIR(0)="E"

 +9        FOR 

               SET XTSYS=$ORDER(^XTMP("XTSUMCK",DUZ,"SYS",XTSYS))

               IF XTSYS=""

                   QUIT 

               Begin DoDot:1

 +10               IF $$CHK(4)

                       QUIT 

 +11               WRITE !!,"UCI,VOL: ",XTUCI,",",XTSYS," -- "

 +12               SET XTY=^XTMP("XTSUMCK",DUZ,"SYS",XTSYS)

                   IF $PIECE(XTY,U)

                       WRITE $$FMTE^XLFDT($PIECE(XTY,U))

 +13               WRITE " -- ",$PIECE(XTY,U,3)

 +14               SET XTROU=""

 +15               FOR XTCNT=0:1

                       SET XTROU=$ORDER(^XTMP("XTSUMCK",DUZ,"SYS",XTSYS,XTROU))

                       IF XTROU=""

                           QUIT 

                       SET Y=^(XTROU)

                       Begin DoDot:2

 +16                       IF $$CHK(2)

                               QUIT 

 +17                       WRITE !?2,XTROU,?12,Y

                       End DoDot:2

                       IF $DATA(DIRUT)

                           QUIT 

 +18               WRITE !!,?15,+$PIECE(XTY,U,6)," Routine checked, ",XTCNT," failed.",!

               End DoDot:1

               IF $DATA(DIRUT)

                   QUIT 

 +19       KILL ^XTMP("XTSUMCK",DUZ)

 +20       IF $EXTRACT(IOST)="P"

               WRITE @IOF

 +21       IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +22       QUIT 

CHK(Y)    ;Y=excess lines, return 1 to exit & DIRUT is set

 +1        IF $Y<(IOSL-Y)

               QUIT 0

 +2        IF $EXTRACT(IOST,1,2)="C-"

               DO ^DIR

               IF 'Y

                   QUIT 1

 +3        WRITE @IOF

           DO HDR

 +4        QUIT 0

 +5       ;

HDR        SET XTPG=XTPG+1

 +1        WRITE !!,"MASTER ROUTINE SET USED RESIDES ON UCI,VOL: ",$PIECE(XTX,U,2),?70,"PAGE ",XTPG,!,XTUL,!

 +2        QUIT