- 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 Feb 18, 2025@23:05:24 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