Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7CHKFP

LA7CHKFP.m

Go to the documentation of this file. 
  1. 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
  1.  ;This routine prints file integrity report for Lab Messaging.
  1. EN ; Select report to print
  1.  K ^TMP($J,"LA7ICLIST")
  1.  D HED1
  1.  S LA7IC="LA7IC",(LA7CNT,LA7DA,LA7QUIT)=0
  1.  F  S LA7IC=$O(^XTMP(LA7IC)) Q:LA7IC=""!($P(LA7IC,"^")'="LA7IC")  D  Q:LA7QUIT!(LA7DA)
  1.  . N LA7X
  1.  . S LA7DT=$$FMTE^XLFDT($P(LA7IC,"^",2))
  1.  . S LA7CNT=LA7CNT+1,^TMP($J,"LA7ICLIST",LA7CNT)=LA7DT_"^"_LA7IC
  1.  . S LA7X=^XTMP(LA7IC,0)
  1.  . S LA7ECNT=$S($P(LA7X,"^",7):$P(LA7X,"^",7),1:"NO")_" errors"
  1.  . I '$P(LA7X,"^",5) D
  1.  . . L +^XTMP(LA7IC,0):1
  1.  . . I $T L -^XTMP(LA7IC,0) S LA7ECNT=LA7ECNT_" - Did NOT finish" Q
  1.  . . S LA7ECNT=LA7ECNT_" - Still running"
  1.  . W !,$J(LA7CNT,3),"  ",LA7DT,"  [",LA7ECNT,"]"
  1.  . I $Y+10>IOSL D
  1.  . . D ASK
  1.  . . I LA7QUIT Q
  1.  . . D HED1
  1.  I LA7QUIT Q
  1.  I 'LA7CNT D EN^DDIOL("No reports on file!","","!?5")
  1.  I 'LA7DA D ASK
  1.  I 'LA7DA Q
  1.  S LA7IC=$P($G(^TMP($J,"LA7ICLIST",LA7DA)),"^",2,3)
  1. DEV ; Ask device to print report.
  1.  K %ZIS
  1.  S %ZIS="Q" D ^%ZIS
  1.  I POP D HOME^%ZIS Q
  1.  I $D(IO("Q")) D  Q
  1.  . N MSG,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTRTN,ZTSAVE
  1.  . S ZTRTN="DQ^LA7CHKFP",ZTDESC="Print LA7 Messaging Integrity Check"
  1.  . S ZTSAVE("LA7IC")=""
  1.  . D ^%ZTLOAD,^%ZISC
  1.  . S MSG="Task "_$S($G(ZTSK):"",1:"NOT ")_"Queued"
  1.  . D EN^DDIOL(MSG,"","!")
  1.  ;
  1. DQ ; Entry point from taskman
  1.  N LA7ECNT,LA7EDT,LA7I,LA7LINE,LA7PAGE,LA7RDT,LA7SDT,LA7X,X,Y
  1.  U IO
  1.  S $P(LA7LINE,"-",IOM)=""
  1.  S (LA7EXIT,LA7PAGE)=0
  1.  S LA7X=$G(^XTMP(LA7IC,0))
  1.  S LA7RDT=$$FMTE^XLFDT($P(LA7IC,"^",2))
  1.  S LA7SDT=$P(LA7X,"^",4)_"^"_$$FMTE^XLFDT($P(LA7X,"^",4))
  1.  S LA7EDT=$P(LA7X,"^",5)_"^"_$$FMTE^XLFDT($P(LA7X,"^",5))
  1.  S LA7TCNT=+$P(LA7X,"^",6) ; Count of # of entries checked
  1.  S LA7ECNT=+$P(LA7X,"^",7) ; Count of number of errors
  1.  S LA7NOW=$$NOW^XLFDT
  1.  S $P(LA7NOW,"^",2)=$$FMTE^XLFDT(LA7NOW)
  1.  D HED Q:$G(LA7EXIT)
  1.  I '$O(^XTMP(LA7IC,0)) W !,"    NO entries to print"
  1.  S LA7I=0
  1.  F  S LA7I=$O(^XTMP(LA7IC,LA7I)) Q:'LA7I  D  Q:$G(LA7EXIT)
  1.  . I $Y+5>IOSL D HED Q:$G(LA7EXIT)
  1.  . W !,^XTMP(LA7IC,LA7I)
  1.  I '$G(LA7EXIT) D
  1.  . I $Y+5>IOSL D HED Q:$G(LA7EXIT)
  1.  . W !!,"   Total number of entries: ",LA7TCNT
  1.  . W !,"    Total number of errors: ",LA7ECNT
  1.  . W !," Integrity Checker Started: ",$P(LA7SDT,"^",2)
  1.  . W !,"Integrity Checker Finished: ",$P(LA7EDT,"^",2)
  1.  I '$G(LA7EXIT),$E(IOST,1,2)="C-" D TERM
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  E  W:$E(IOST,1,2)="P-" @IOF D ^%ZISC
  1.  Q
  1.  ;
  1. TERM ;
  1.  I 'LA7PAGE W @IOF Q
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S DIR(0)="E" D ^DIR S:$D(DIRUT) LA7EXIT=1
  1.  Q
  1.  ;
  1. ASK ; Ask for report to print
  1.  N DIR,DIROUT,DIRUT,DUOUT,X,Y
  1.  W !
  1.  S DIR(0)="NO^1:"_LA7CNT_":0",DIR("A")="Select Report"
  1.  D ^DIR
  1.  I $D(DUOUT) S LA7QUIT=1 Q
  1.  I Y S LA7DA=Y
  1.  Q
  1.  ;
  1. HED1 ; Print selection header
  1.  W @IOF,$$CJ^XLFSTR("--- Lab Messaging Integrity Checker Report ---",IOM),!
  1.  Q
  1.  ;
  1. HED ; Print header
  1.  I $E(IOST,1,2)="C-" D TERM Q:$G(LA7EXIT)
  1.  I LA7PAGE W @IOF
  1.  S LA7PAGE=LA7PAGE+1
  1.  W !,"Lab Messaging File Integrity Checker Report",?IOM-30,"Printed: ",$P(LA7NOW,"^",2)
  1.  W !,"For Date: ",LA7RDT,?IOM-27,"Page: ",LA7PAGE
  1.  W !,LA7LINE,!
  1.  Q