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

LA7CHKF.m

Go to the documentation of this file. 
  1. LA7CHKF ;VA/DALOI/JMC - Check Lab Messaging File Integrity ; 22-Oct-2013 09:22 ; MAW
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,1033**;NOV 1, 1997
  1.  ;This routine checks file integrity for Lab Messaging.
  1. EN ; Run an integrity check
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  N LA7FIX,LA7ION,LA7LOG,LA7QUIT
  1.  ;
  1.  S LA7LOG=1
  1.  S DIR(0)="SO^1:Check File Integrity;2:Fix File Entries"
  1.  S DIR("A")="Select Option",DIR("B")=1
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  I Y=1 S LA7FIX=0
  1.  I Y=2 S LA7FIX=1
  1.  ;
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="YO",DIR("A")="Print Report",DIR("B")="YES",DIR("?")="Enter 'YES' to print the integrity report."
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  I Y=1 D
  1.  . N %ZIS
  1.  . S %ZIS="NQ0",%ZIS("A")="Select Device: ",%ZIS("B")=""
  1.  . D ^%ZIS
  1.  . I POP S LA7QUIT=1
  1.  . S LA7ION=ION
  1.  I $G(LA7QUIT) D HOME^%ZIS Q
  1.  ;
  1.  S ZTRTN="DQ^LA7CHKF",ZTDESC="Lab Messaging File Integrity Checker"
  1.  S ZTSAVE("LA7*")="",ZTIO=""
  1.  D ^%ZTLOAD,HOME^%ZIS
  1.  W !,"Request ",$S($G(ZTSK):"",1:"NOT "),"Queued"
  1.  Q
  1.  ;
  1. DQ ; Entry point from taskman
  1.  D IC
  1.  Q
  1.  ;
  1. IC ; File 62.49 Integrity checker and fix-er-upper.
  1.  ;
  1.  ; Check that all the cross-references have entries
  1.  ;
  1.  N LA7CFG,LA7DA,LA7DAT,LA7ECNT,LA7IC,LA7INAME,LA7Q,LA7ROOT,X,Y
  1.  S LA7FIX=$G(LA7FIX,0) ; Set flag to fix problems 1=yes, 0=just check (default)
  1.  S LA7LOG=$G(LA7LOG,0) ; Set flag to report problems, 1=yes, 0=no (default)
  1.  I LA7LOG D
  1.  . F  S LA7IC="LA7IC^"_$$NOW^XLFDT L +^XTMP(LA7IC):9999 Q:'$D(^XTMP(LA7IC))  L -^XTMP(LA7IC) H 1
  1.  . S DT=$$DT^XLFDT
  1.  . S ^XTMP(LA7IC,0)=$$FMADD^XLFDT(DT,7)_"^"_DT_"^Lab Messaging Integrity Checker"_"^"_$$NOW^XLFDT
  1.  S LA7ECNT=0 ; Count of number of errors
  1.  ;
  1.  ; Check the "AD" cross-reference
  1.  S LA7ROOT="^LAHM(62.49,""AD"")"
  1.  F  S LA7ROOT=$Q(LA7ROOT) Q:LA7ROOT=""  Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="AD")  D
  1.  . S LA7DAT=$QS(LA7ROOT,3),LA7DA=$QS(LA7ROOT,4)
  1.  . I '$$LOCK(LA7DA) Q
  1.  . I LA7DAT'=$P($P($G(^LAHM(62.49,LA7DA,0)),"^",5),".") D
  1.  . . I LA7FIX K @LA7ROOT
  1.  . . I LA7LOG D LOG("Bad ""AD"" cross-reference of "_LA7ROOT_" for entry "_LA7DA)
  1.  . D UNLOCK(LA7DA)
  1.  ;
  1.  ; Check the "B" cross-reference
  1.  S LA7ROOT="^LAHM(62.49,""B"")"
  1.  F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""  Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="B")  D
  1.  . S LA7DA=$QS(LA7ROOT,4)
  1.  . I '$$LOCK(LA7DA) Q
  1.  . I LA7DA'=$QS(LA7ROOT,3) D
  1.  . . I LA7FIX K @LA7ROOT
  1.  . . I LA7LOG D LOG("""B"" cross-reference "_LA7ROOT_" points to incorrect entry "_$QS(LA7ROOT,4))
  1.  . I '$D(^LAHM(62.49,LA7DA,0)) D
  1.  . . I LA7FIX K @LA7ROOT
  1.  . . I LA7LOG D LOG("""B"" cross-reference "_LA7ROOT_" points to missing entry "_LA7DA)
  1.  . D UNLOCK(LA7DA)
  1.  ;
  1.  ; Check the "C" cross-reference
  1.  S LA7ROOT="^LAHM(62.49,""C"")"
  1.  F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""  Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="C")  D
  1.  . S LA7INAME=$QS(LA7ROOT,3),LA7DA=$QS(LA7ROOT,4)
  1.  . I '$$LOCK(LA7DA) Q
  1.  . I LA7INAME'=$E($P($G(^LAHM(62.49,LA7DA,0)),"^",6),1,30) D
  1.  . . I LA7FIX K @LA7ROOT
  1.  . . I LA7LOG D LOG("Bad ""C"" cross-reference of "_LA7ROOT_" on entry "_LA7DA)
  1.  . D UNLOCK(LA7DA)
  1.  ;
  1.  ; Check the "Q" cross-reference
  1.  S LA7ROOT="^LAHM(62.49,""Q"")"
  1.  F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""  Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="Q")  D
  1.  . S LA7CFG=$QS(LA7ROOT,3)
  1.  . S LA7Q=$QS(LA7ROOT,4)
  1.  . S LA7DA=$QS(LA7ROOT,5)
  1.  . I '$$LOCK(LA7DA) Q
  1.  . S X(0)=$G(^LAHM(62.49,LA7DA,0))
  1.  . S X(.5)=$G(^LAHM(62.49,LA7DA,.5))
  1.  . I LA7CFG'=$P(X(.5),"^")!(LA7Q'=($P(X(0),"^",2)_$P(X(0),"^",3))) D
  1.  . . I LA7LOG D LOG("Bad ""Q"" cross-reference of "_LA7ROOT_" for entry: "_LA7DA)
  1.  . . I LA7FIX K @LA7ROOT
  1.  . D UNLOCK(LA7DA)
  1.  ;
  1.  ; Check that all entries have "AD" cross-reference set.
  1.  ;                              "B" cross-reference set
  1.  ;                              "C" cross-reference set
  1.  ;                              "Q" cross-reference set
  1.  S (LA7DA,LA7TCNT)=0
  1.  F  S LA7DA=$O(^LAHM(62.49,LA7DA)) Q:'LA7DA  D
  1.  . I '$$LOCK(LA7DA) Q
  1.  . S LA7TCNT=LA7TCNT+1 ; Count of entries in file.
  1.  . S X(0)=$G(^LAHM(62.49,LA7DA,0))
  1.  . S X(.5)=$G(^LAHM(62.49,LA7DA,.5))
  1.  . S Y=$P(X(0),"^") ; Message number (.01 field)
  1.  . I 'Y D
  1.  . . I LA7FIX K ^LAHM(62.49,LA7DA)
  1.  . . I LA7LOG D LOG("Entry "_LA7DA_" missing .01 field")
  1.  . S Y=$P(X(0),"^",5) ; date/time entered
  1.  . I Y,'$D(^LAHM(62.49,"AD",$P(Y,"."),LA7DA)) D
  1.  . . I LA7FIX S ^LAHM(62.49,"AD",$P(Y,"."),LA7DA)=""
  1.  . . I LA7LOG D LOG("Entry "_LA7DA_" missing ""AD"" cross-reference "_$P(Y,"."))
  1.  . S Y=$P(X(0),"^")
  1.  . I Y,'$D(^LAHM(62.49,"B",Y,LA7DA)) D
  1.  . . I LA7FIX S ^LAHM(62.49,"B",Y,LA7DA)=""
  1.  . . I LA7LOG D LOG("Entry "_LA7DA_" missing ""B"" cross-reference")
  1.  . S Y=$P(X(0),"^",6) ; instrument name
  1.  . I $L(Y),'$D(^LAHM(62.49,"C",$E(Y,1,30),LA7DA)) D
  1.  . . I LA7FIX S ^LAHM(62.49,"C",$E(Y,1,30),LA7DA)=""
  1.  . . I LA7LOG D LOG("Entry "_LA7DA_" missing ""C"" cross-reference "_Y)
  1.  . S Y=$P(X(0),"^",2)_$P(X(0),"^",3) ; concatentate configuration_status
  1.  . I +X(.5),$L(Y),'$D(^LAHM(62.49,"Q",+X(.5),Y,LA7DA)) D
  1.  . . I LA7FIX S ^LAHM(62.49,"Q",+X(.5),Y,LA7DA)=""
  1.  . . I LA7LOG D LOG("Entry "_LA7DA_" missing ^LAHM(62.49,""Q"","_+X(.5)_","""_Y_""","_LA7DA_") cross-reference")
  1.  . D UNLOCK(LA7DA)
  1.  I LA7LOG D
  1.  . S $P(^XTMP(LA7IC,0),"^",5)=$$NOW^XLFDT ; End date/time
  1.  . S $P(^XTMP(LA7IC,0),"^",6,7)=LA7TCNT_"^"_LA7ECNT ; Total^Error count
  1.  . L -^XTMP(LA7IC) ; Release lock
  1.  I LA7ECNT D
  1.  . N XQA,XQAID,XQADATA,XQAMSG,XQAOPT,XQAROU
  1.  . S XQAMSG="Lab Messaging -Warning- "_LA7ECNT_" errors found in File #62.49, LA7 MESSAGE QUEUE."
  1.  . I LA7LOG S XQADATA=LA7IC,XQAROU="DISIC^LA7UXQA"
  1.  . S XQAID="LA7ERR-"_$TR(LA7IC,"^",":")
  1.  . I $G(DUZ)>.9 S XQA(DUZ)=""
  1.  . S XQA("G.LAB MESSAGING")=""
  1.  . D SETUP^XQALERT
  1.  I $L($G(LA7ION)) D  ; Task print of integrity report
  1.  . N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
  1.  . S ZTRTN="DQ^LA7CHKFP",ZTDTH=$H,ZTSAVE("LA7IC")="",ZTIO=LA7ION
  1.  . S ZTDESC="Print LA7 File Integrity Report"
  1.  . D ^%ZTLOAD
  1.  K LA7FIX,LA7ION,LA7LOG
  1.  Q
  1.  ;
  1. LOG(X) ; Log error in XTMP global.
  1.  ; Call with X = error message to store.
  1.  S LA7ECNT=$G(LA7ECNT)+1
  1.  S ^XTMP(LA7IC,LA7ECNT)=X
  1.  Q
  1.  ;
  1. LOCK(LA7DA) ; Lock entry in #62.49
  1.  ; Call with LA7DA = entry to lock
  1.  ; Returns       0 = failure to obtain lock
  1.  ;               1 = lock obtained
  1.  N LA7Y
  1.  S LA7Y=0,LA7DA=+$G(LA7DA)
  1.  L +^LAHM(62.49,LA7DA):10
  1.  I $T S LA7Y=1
  1.  I 'LA7Y,$G(LA7LOG) D LOG("Unable to obtain lock on entry "_LA7DA_" in file #62.49")
  1.  Q LA7Y
  1.  ;
  1. UNLOCK(LA7DA) ; Unlock entry in #62.49
  1.  ; Call with LA7DA = entry to lock
  1.  ;
  1.  S LA7DA=+$G(LA7DA)
  1.  L -^LAHM(62.49,LA7DA)
  1.  Q
  1.  ;
  1. LACHK() ; Check ^LA("ADL","Q") for build up of entries.
  1.  ; Send alert to mail group LAB MESSAGING warning about large # of entries.
  1.  N LA7CNT,LA7DA,X,Y
  1.  S LA7DA="",LA7CNT=0
  1.  F  S LA7DA=$O(^LA("ADL","Q",LA7DA)) Q:LA7DA=""  S LA7CNT=LA7CNT+1
  1.  I LA7CNT>500 D
  1.  . N XQA,XQAID,XQADATA,XQAMSG,XQAOPT,XQAROU
  1.  . S XQAMSG="Lab Messaging -Warning- "_LA7CNT_" entries in LA(""ADL"",""Q"") global - please check."
  1.  . S XQAID="LA7ADL-"_$H
  1.  . I $G(DUZ)>.9 S XQA(DUZ)=""
  1.  . S XQA("G.LAB MESSAGING")=""
  1.  . D SETUP^XQALERT
  1.  Q LA7CNT