LA7CHKFP ;DALOI/JMC - Print Lab Messaging File Integrity Report ;11/16/11 10:54
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,74**;Sep 27, 1994;Build 229
;
;This routine prints file integrity report for Lab Messaging.
;
EN ; Select report to print
;
;ZEXCEPT: IOF,IOM,IOSL,IOST,ZTQUEUED,ZTREQ
;
N %ZIS,LA7CNT,LA7DA,LA7DT,LA7ECNT,LA7EXIT,LA7IC,LA7NOW,LA7QUIT,LA7TCNT,POP
;
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")_" file errors"
. S LA7ECNT=LA7ECNT_" / "_$S($P(LA7X,"^",9):$P(LA7X,"^",9),1:"NO")_" mail group 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+4>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,LA7FIX,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 LA7FIX=$P(LA7X,"^",8) ; Flag if fix option was run
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 LA7FIX>0,LA7ECNT>0 D
. . W !!,"***Integrity Checker (IC) ran with fix option***"
. . W !,"***Recommend that IC be re-run to verify fixes***"
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 ;
;
;ZEXCEPT: IOF,LA7EXIT,LA7PAGE
;
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
;
;ZEXCEPT: LA7CNT,LA7DA,LA7QUIT
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="NO^1:"_LA7CNT_":0",DIR("A")="Select Report"
D ^DIR
I $D(DIROUT) S LA7QUIT=1 Q
I Y S LA7DA=Y
Q
;
;
HED1 ; Print selection header
;
;ZEXCEPT: IOF,IOM
;
W @IOF,$$CJ^XLFSTR("--- Lab Messaging Integrity Checker Report ---",IOM),!
Q
;
;
HED ; Print header
;
;ZEXCEPT: IOF,IOM,IOST,LA7LINE,LA7NOW,LA7PAGE,LA7RDT
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7CHKFP 3842 printed Apr 09, 2024@20:49:20 Page 2
LA7CHKFP ;DALOI/JMC - Print Lab Messaging File Integrity Report ;11/16/11 10:54
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,74**;Sep 27, 1994;Build 229
+2 ;
+3 ;This routine prints file integrity report for Lab Messaging.
+4 ;
EN ; Select report to print
+1 ;
+2 ;ZEXCEPT: IOF,IOM,IOSL,IOST,ZTQUEUED,ZTREQ
+3 ;
+4 NEW %ZIS,LA7CNT,LA7DA,LA7DT,LA7ECNT,LA7EXIT,LA7IC,LA7NOW,LA7QUIT,LA7TCNT,POP
+5 ;
+6 KILL ^TMP($JOB,"LA7ICLIST")
+7 DO HED1
+8 SET LA7IC="LA7IC"
SET (LA7CNT,LA7DA,LA7QUIT)=0
+9 FOR
SET LA7IC=$ORDER(^XTMP(LA7IC))
if LA7IC=""!($PIECE(LA7IC,"^")'="LA7IC")
QUIT
Begin DoDot:1
+10 NEW LA7X
+11 SET LA7DT=$$FMTE^XLFDT($PIECE(LA7IC,"^",2))
+12 SET LA7CNT=LA7CNT+1
SET ^TMP($JOB,"LA7ICLIST",LA7CNT)=LA7DT_"^"_LA7IC
+13 SET LA7X=^XTMP(LA7IC,0)
+14 SET LA7ECNT=$SELECT($PIECE(LA7X,"^",7):$PIECE(LA7X,"^",7),1:"NO")_" file errors"
+15 SET LA7ECNT=LA7ECNT_" / "_$SELECT($PIECE(LA7X,"^",9):$PIECE(LA7X,"^",9),1:"NO")_" mail group errors"
+16 IF '$PIECE(LA7X,"^",5)
Begin DoDot:2
+17 LOCK +^XTMP(LA7IC,0):1
+18 IF $TEST
LOCK -^XTMP(LA7IC,0)
SET LA7ECNT=LA7ECNT_" - Did NOT finish"
QUIT
+19 SET LA7ECNT=LA7ECNT_" - Still running"
End DoDot:2
+20 WRITE !,$JUSTIFY(LA7CNT,3)," ",LA7DT," [",LA7ECNT,"]"
+21 IF $Y+4>IOSL
Begin DoDot:2
+22 DO ASK
+23 IF LA7QUIT
QUIT
+24 DO HED1
End DoDot:2
End DoDot:1
if LA7QUIT!(LA7DA)
QUIT
+25 IF LA7QUIT
QUIT
+26 IF 'LA7CNT
DO EN^DDIOL("No reports on file!","","!?5")
+27 IF 'LA7DA
DO ASK
+28 IF 'LA7DA
QUIT
+29 SET LA7IC=$PIECE($GET(^TMP($JOB,"LA7ICLIST",LA7DA)),"^",2,3)
+30 ;
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 ;
+12 ;
DQ ; Entry point from taskman
+1 NEW LA7ECNT,LA7EDT,LA7FIX,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 ; Flag if fix option was run
SET LA7FIX=$PIECE(LA7X,"^",8)
+12 SET LA7NOW=$$NOW^XLFDT
+13 SET $PIECE(LA7NOW,"^",2)=$$FMTE^XLFDT(LA7NOW)
+14 DO HED
if $GET(LA7EXIT)
QUIT
+15 IF '$ORDER(^XTMP(LA7IC,0))
WRITE !," NO entries to print"
+16 SET LA7I=0
+17 FOR
SET LA7I=$ORDER(^XTMP(LA7IC,LA7I))
if 'LA7I
QUIT
Begin DoDot:1
+18 IF $Y+5>IOSL
DO HED
if $GET(LA7EXIT)
QUIT
+19 WRITE !,^XTMP(LA7IC,LA7I)
End DoDot:1
if $GET(LA7EXIT)
QUIT
+20 IF '$GET(LA7EXIT)
Begin DoDot:1
+21 IF $Y+5>IOSL
DO HED
if $GET(LA7EXIT)
QUIT
+22 WRITE !!," Total number of entries: ",LA7TCNT
+23 WRITE !," Total number of errors: ",LA7ECNT
+24 WRITE !," Integrity Checker Started: ",$PIECE(LA7SDT,"^",2)
+25 WRITE !,"Integrity Checker Finished: ",$PIECE(LA7EDT,"^",2)
+26 IF LA7FIX>0
IF LA7ECNT>0
Begin DoDot:2
+27 WRITE !!,"***Integrity Checker (IC) ran with fix option***"
+28 WRITE !,"***Recommend that IC be re-run to verify fixes***"
End DoDot:2
End DoDot:1
+29 IF '$GET(LA7EXIT)
IF $EXTRACT(IOST,1,2)="C-"
DO TERM
+30 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+31 IF '$TEST
if $EXTRACT(IOST,1,2)="P-"
WRITE @IOF
DO ^%ZISC
+32 QUIT
+33 ;
+34 ;
TERM ;
+1 ;
+2 ;ZEXCEPT: IOF,LA7EXIT,LA7PAGE
+3 ;
+4 IF 'LA7PAGE
WRITE @IOF
QUIT
+5 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+6 WRITE !
+7 SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
SET LA7EXIT=1
+8 QUIT
+9 ;
+10 ;
ASK ; Ask for report to print
+1 ;
+2 ;ZEXCEPT: LA7CNT,LA7DA,LA7QUIT
+3 ;
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 WRITE !
+6 SET DIR(0)="NO^1:"_LA7CNT_":0"
SET DIR("A")="Select Report"
+7 DO ^DIR
+8 IF $DATA(DIROUT)
SET LA7QUIT=1
QUIT
+9 IF Y
SET LA7DA=Y
+10 QUIT
+11 ;
+12 ;
HED1 ; Print selection header
+1 ;
+2 ;ZEXCEPT: IOF,IOM
+3 ;
+4 WRITE @IOF,$$CJ^XLFSTR("--- Lab Messaging Integrity Checker Report ---",IOM),!
+5 QUIT
+6 ;
+7 ;
HED ; Print header
+1 ;
+2 ;ZEXCEPT: IOF,IOM,IOST,LA7LINE,LA7NOW,LA7PAGE,LA7RDT
+3 ;
+4 IF $EXTRACT(IOST,1,2)="C-"
DO TERM
if $GET(LA7EXIT)
QUIT
+5 IF LA7PAGE
WRITE @IOF
+6 SET LA7PAGE=LA7PAGE+1
+7 WRITE !,"Lab Messaging File Integrity Checker Report",?IOM-30,"Printed: ",$PIECE(LA7NOW,"^",2)
+8 WRITE !,"For Date: ",LA7RDT,?IOM-27,"Page: ",LA7PAGE
+9 WRITE !,LA7LINE,!
+10 QUIT
