XTSUMCK1 ;Boise/MAW,SFISC/RSD-process routine checksum job results ;10/04/96 12:37
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTSUMCK1 1516 printed Dec 13, 2024@02:41:51 Page 2
XTSUMCK1 ;Boise/MAW,SFISC/RSD-process routine checksum job results ;10/04/96 12:37
+1 ;;8.0;KERNEL;**44**;Jul 10, 1995
+2 ;this routine is normally called via an ALERT process...
+3 WRITE !!,"ROUTINE CHECKSUM REPORT"
+4 IF '$DATA(^XTMP("XTSUMCK",DUZ,"SYS"))
WRITE *7,!!,"ERROR -- NO data to retrieve!"
QUIT
+5 DO EN^XUTMDEVQ("DQ^XTSUMCK1","Print Routine Checksum Results","")
+6 WRITE !
+7 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
