LA7CHKFP ;VA/DALISC/JMC - Print Lab Messaging File Integrity Report; 22-Oct-2013 09:22 ; MAW
;;5.2;LAB MESSAGING;**27,1033**;NOV 1, 1997
;This routine prints file integrity report for Lab Messaging.
EN ; Select report to print
K ^TMP($J,"LA7ICLIST")
D HED1
S LA7IC="LA7IC",(LA7CNT,LA7DA,LA7QUIT)=0
F S LA7IC=$O(^XTMP(LA7IC)) Q:LA7IC=""!($P(LA7IC,"^")'="LA7IC") D Q:LA7QUIT!(LA7DA)
. N LA7X
. S LA7DT=$$FMTE^XLFDT($P(LA7IC,"^",2))
. S LA7CNT=LA7CNT+1,^TMP($J,"LA7ICLIST",LA7CNT)=LA7DT_"^"_LA7IC
. S LA7X=^XTMP(LA7IC,0)
. S LA7ECNT=$S($P(LA7X,"^",7):$P(LA7X,"^",7),1:"NO")_" errors"
. I '$P(LA7X,"^",5) D
. . L +^XTMP(LA7IC,0):1
. . I $T L -^XTMP(LA7IC,0) S LA7ECNT=LA7ECNT_" - Did NOT finish" Q
. . S LA7ECNT=LA7ECNT_" - Still running"
. W !,$J(LA7CNT,3)," ",LA7DT," [",LA7ECNT,"]"
. I $Y+10>IOSL D
. . D ASK
. . I LA7QUIT Q
. . D HED1
I LA7QUIT Q
I 'LA7CNT D EN^DDIOL("No reports on file!","","!?5")
I 'LA7DA D ASK
I 'LA7DA Q
S LA7IC=$P($G(^TMP($J,"LA7ICLIST",LA7DA)),"^",2,3)
DEV ; Ask device to print report.
K %ZIS
S %ZIS="Q" D ^%ZIS
I POP D HOME^%ZIS Q
I $D(IO("Q")) D Q
. N MSG,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTRTN,ZTSAVE
. S ZTRTN="DQ^LA7CHKFP",ZTDESC="Print LA7 Messaging Integrity Check"
. S ZTSAVE("LA7IC")=""
. D ^%ZTLOAD,^%ZISC
. S MSG="Task "_$S($G(ZTSK):"",1:"NOT ")_"Queued"
. D EN^DDIOL(MSG,"","!")
;
DQ ; Entry point from taskman
N LA7ECNT,LA7EDT,LA7I,LA7LINE,LA7PAGE,LA7RDT,LA7SDT,LA7X,X,Y
U IO
S $P(LA7LINE,"-",IOM)=""
S (LA7EXIT,LA7PAGE)=0
S LA7X=$G(^XTMP(LA7IC,0))
S LA7RDT=$$FMTE^XLFDT($P(LA7IC,"^",2))
S LA7SDT=$P(LA7X,"^",4)_"^"_$$FMTE^XLFDT($P(LA7X,"^",4))
S LA7EDT=$P(LA7X,"^",5)_"^"_$$FMTE^XLFDT($P(LA7X,"^",5))
S LA7TCNT=+$P(LA7X,"^",6) ; Count of # of entries checked
S LA7ECNT=+$P(LA7X,"^",7) ; Count of number of errors
S LA7NOW=$$NOW^XLFDT
S $P(LA7NOW,"^",2)=$$FMTE^XLFDT(LA7NOW)
D HED Q:$G(LA7EXIT)
I '$O(^XTMP(LA7IC,0)) W !," NO entries to print"
S LA7I=0
F S LA7I=$O(^XTMP(LA7IC,LA7I)) Q:'LA7I D Q:$G(LA7EXIT)
. I $Y+5>IOSL D HED Q:$G(LA7EXIT)
. W !,^XTMP(LA7IC,LA7I)
I '$G(LA7EXIT) D
. I $Y+5>IOSL D HED Q:$G(LA7EXIT)
. W !!," Total number of entries: ",LA7TCNT
. W !," Total number of errors: ",LA7ECNT
. W !," Integrity Checker Started: ",$P(LA7SDT,"^",2)
. W !,"Integrity Checker Finished: ",$P(LA7EDT,"^",2)
I '$G(LA7EXIT),$E(IOST,1,2)="C-" D TERM
I $D(ZTQUEUED) S ZTREQ="@"
E W:$E(IOST,1,2)="P-" @IOF D ^%ZISC
Q
;
TERM ;
I 'LA7PAGE W @IOF Q
N DIR,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="E" D ^DIR S:$D(DIRUT) LA7EXIT=1
Q
;
ASK ; Ask for report to print
N DIR,DIROUT,DIRUT,DUOUT,X,Y
W !
S DIR(0)="NO^1:"_LA7CNT_":0",DIR("A")="Select Report"
D ^DIR
I $D(DUOUT) S LA7QUIT=1 Q
I Y S LA7DA=Y
Q
;
HED1 ; Print selection header
W @IOF,$$CJ^XLFSTR("--- Lab Messaging Integrity Checker Report ---",IOM),!
Q
;
HED ; Print header
I $E(IOST,1,2)="C-" D TERM Q:$G(LA7EXIT)
I LA7PAGE W @IOF
S LA7PAGE=LA7PAGE+1
W !,"Lab Messaging File Integrity Checker Report",?IOM-30,"Printed: ",$P(LA7NOW,"^",2)
W !,"For Date: ",LA7RDT,?IOM-27,"Page: ",LA7PAGE
W !,LA7LINE,!
Q
LA7CHKFP ;VA/DALISC/JMC - Print Lab Messaging File Integrity Report; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;LAB MESSAGING;**27,1033**;NOV 1, 1997
+2 ;This routine prints file integrity report for Lab Messaging.
EN ; Select report to print
+1 KILL ^TMP($JOB,"LA7ICLIST")
+2 DO HED1
+3 SET LA7IC="LA7IC"
SET (LA7CNT,LA7DA,LA7QUIT)=0
+4 FOR
SET LA7IC=$ORDER(^XTMP(LA7IC))
IF LA7IC=""!($PIECE(LA7IC,"^")'="LA7IC")
QUIT
Begin DoDot:1
+5 NEW LA7X
+6 SET LA7DT=$$FMTE^XLFDT($PIECE(LA7IC,"^",2))
+7 SET LA7CNT=LA7CNT+1
SET ^TMP($JOB,"LA7ICLIST",LA7CNT)=LA7DT_"^"_LA7IC
+8 SET LA7X=^XTMP(LA7IC,0)
+9 SET LA7ECNT=$SELECT($PIECE(LA7X,"^",7):$PIECE(LA7X,"^",7),1:"NO")_" errors"
+10 IF '$PIECE(LA7X,"^",5)
Begin DoDot:2
+11 LOCK +^XTMP(LA7IC,0):1
+12 IF $TEST
LOCK -^XTMP(LA7IC,0)
SET LA7ECNT=LA7ECNT_" - Did NOT finish"
QUIT
+13 SET LA7ECNT=LA7ECNT_" - Still running"
End DoDot:2
+14 WRITE !,$JUSTIFY(LA7CNT,3)," ",LA7DT," [",LA7ECNT,"]"
+15 IF $Y+10>IOSL
Begin DoDot:2
+16 DO ASK
+17 IF LA7QUIT
QUIT
+18 DO HED1
End DoDot:2
End DoDot:1
IF LA7QUIT!(LA7DA)
QUIT
+19 IF LA7QUIT
QUIT
+20 IF 'LA7CNT
DO EN^DDIOL("No reports on file!","","!?5")
+21 IF 'LA7DA
DO ASK
+22 IF 'LA7DA
QUIT
+23 SET LA7IC=$PIECE($GET(^TMP($JOB,"LA7ICLIST",LA7DA)),"^",2,3)
DEV ; Ask device to print report.
+1 KILL %ZIS
+2 SET %ZIS="Q"
DO ^%ZIS
+3 IF POP
DO HOME^%ZIS
QUIT
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 NEW MSG,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTRTN,ZTSAVE
+6 SET ZTRTN="DQ^LA7CHKFP"
SET ZTDESC="Print LA7 Messaging Integrity Check"
+7 SET ZTSAVE("LA7IC")=""
+8 DO ^%ZTLOAD
DO ^%ZISC
+9 SET MSG="Task "_$SELECT($GET(ZTSK):"",1:"NOT ")_"Queued"
+10 DO EN^DDIOL(MSG,"","!")
End DoDot:1
QUIT
+11 ;
DQ ; Entry point from taskman
+1 NEW LA7ECNT,LA7EDT,LA7I,LA7LINE,LA7PAGE,LA7RDT,LA7SDT,LA7X,X,Y
+2 USE IO
+3 SET $PIECE(LA7LINE,"-",IOM)=""
+4 SET (LA7EXIT,LA7PAGE)=0
+5 SET LA7X=$GET(^XTMP(LA7IC,0))
+6 SET LA7RDT=$$FMTE^XLFDT($PIECE(LA7IC,"^",2))
+7 SET LA7SDT=$PIECE(LA7X,"^",4)_"^"_$$FMTE^XLFDT($PIECE(LA7X,"^",4))
+8 SET LA7EDT=$PIECE(LA7X,"^",5)_"^"_$$FMTE^XLFDT($PIECE(LA7X,"^",5))
+9 ; Count of # of entries checked
SET LA7TCNT=+$PIECE(LA7X,"^",6)
+10 ; Count of number of errors
SET LA7ECNT=+$PIECE(LA7X,"^",7)
+11 SET LA7NOW=$$NOW^XLFDT
+12 SET $PIECE(LA7NOW,"^",2)=$$FMTE^XLFDT(LA7NOW)
+13 DO HED
IF $GET(LA7EXIT)
QUIT
+14 IF '$ORDER(^XTMP(LA7IC,0))
WRITE !," NO entries to print"
+15 SET LA7I=0
+16 FOR
SET LA7I=$ORDER(^XTMP(LA7IC,LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+17 IF $Y+5>IOSL
DO HED
IF $GET(LA7EXIT)
QUIT
+18 WRITE !,^XTMP(LA7IC,LA7I)
End DoDot:1
IF $GET(LA7EXIT)
QUIT
+19 IF '$GET(LA7EXIT)
Begin DoDot:1
+20 IF $Y+5>IOSL
DO HED
IF $GET(LA7EXIT)
QUIT
+21 WRITE !!," Total number of entries: ",LA7TCNT
+22 WRITE !," Total number of errors: ",LA7ECNT
+23 WRITE !," Integrity Checker Started: ",$PIECE(LA7SDT,"^",2)
+24 WRITE !,"Integrity Checker Finished: ",$PIECE(LA7EDT,"^",2)
End DoDot:1
+25 IF '$GET(LA7EXIT)
IF $EXTRACT(IOST,1,2)="C-"
DO TERM
+26 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+27 IF '$TEST
IF $EXTRACT(IOST,1,2)="P-"
WRITE @IOF
DO ^%ZISC
+28 QUIT
+29 ;
TERM ;
+1 IF 'LA7PAGE
WRITE @IOF
QUIT
+2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 WRITE !
+4 SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)
SET LA7EXIT=1
+5 QUIT
+6 ;
ASK ; Ask for report to print
+1 NEW DIR,DIROUT,DIRUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="NO^1:"_LA7CNT_":0"
SET DIR("A")="Select Report"
+4 DO ^DIR
+5 IF $DATA(DUOUT)
SET LA7QUIT=1
QUIT
+6 IF Y
SET LA7DA=Y
+7 QUIT
+8 ;
HED1 ; Print selection header
+1 WRITE @IOF,$$CJ^XLFSTR("--- Lab Messaging Integrity Checker Report ---",IOM),!
+2 QUIT
+3 ;
HED ; Print header
+1 IF $EXTRACT(IOST,1,2)="C-"
DO TERM
IF $GET(LA7EXIT)
QUIT
+2 IF LA7PAGE
WRITE @IOF
+3 SET LA7PAGE=LA7PAGE+1
+4 WRITE !,"Lab Messaging File Integrity Checker Report",?IOM-30,"Printed: ",$PIECE(LA7NOW,"^",2)
+5 WRITE !,"For Date: ",LA7RDT,?IOM-27,"Page: ",LA7PAGE
+6 WRITE !,LA7LINE,!
+7 QUIT
