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 ;DALOI/JMC - Check Lab Messaging File Integrity ;11/16/11  10:49
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,74**;Sep 27, 1994;Build 229
  1.  ;
  1.  ;This routine checks file integrity for Lab Messaging.
  1. EN ; Run an integrity check
  1.  ;
  1.  ;ZEXCEPT: ION,POP
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  N LA7CHKBX,LA7FIX,LA7ION,LA7LOG,LA7QUIT
  1.  ;
  1.  S (LA7CHKBX,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.  ;
  1. DQ ; Entry point from taskman
  1.  ;
  1.  ;ZEXCEPT: LA7CHKBX,LA7FIX,LA7ION,LA7LOG,ZTQUEUED,ZTREQ
  1.  ;
  1.  N LA7ECNT,LA7IC,LA7XQA
  1.  ;
  1.  D INIT,IC,CHECKMG
  1.  ;
  1.  I LA7LOG D
  1.  . S $P(^XTMP(LA7IC,0),"^",5)=$$NOW^XLFDT ; End date/time
  1.  . L -^XTMP(LA7IC) ; Release lock
  1.  ;
  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.  . M XQA=LA7XQA
  1.  . D SETUP^XQALERT
  1.  ;
  1.  ; Run check on certain files "B" index if first of the month or tasked by user.
  1.  I $G(LA7CHKBX)="" S LA7CHKBX=$S($E(DT,6,7)="01":1,1:0)
  1.  I LA7CHKBX D CHKBX
  1.  K LA7CHKBX
  1.  ;
  1.  ; Task print of integrity report
  1.  I $G(LA7ION)'="" D
  1.  . N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  . S ZTRTN="DQ^LA7CHKFP",ZTDTH=$H,ZTSAVE("LA7IC")="",ZTIO=LA7ION
  1.  . S ZTDESC="Print LA7 File Integrity Report"
  1.  . D ^%ZTLOAD
  1.  ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  Q
  1.  ;
  1.  ;
  1. IC ; File 62.49 Integrity checker and fix-er-upper.
  1.  ;
  1.  ; Check that all the cross-references have entries
  1.  ;
  1.  ;ZEXCEPT: LA7ECNT,LA7FIX,LA7IC,LA7LOG,LA7TCNT
  1.  ;
  1.  N LA7CFG,LA7DA,LA7DAT,LA7INAME,LA7Q,LA7ROOT,X,Y
  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=$P($G(^LAHM(62.49,LA7DA,0)),"^",6) D UNLOCK(LA7DA) Q
  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 Y'="",'$D(^LAHM(62.49,"C",$E(Y,1,45),LA7DA)) D
  1.  . . I LA7FIX S ^LAHM(62.49,"C",$E(Y,1,45),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),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.  ;
  1.  I LA7LOG D
  1.  . S $P(^XTMP(LA7IC,0),"^",6,7)=LA7TCNT_"^"_LA7ECNT ; Total^Error count
  1.  . S $P(^XTMP(LA7IC,0),"^",8)=LA7FIX
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CHKBX ; Check "B" index on selected Lab files
  1.  ;
  1.  N LRFN,LRROOT
  1.  F LRFN=61,61.1,61.2,61.3,61.4,61.5,61.6,62  D
  1.  . S LRROOT="^LAB("_LRFN_",""B"")"
  1.  . D FILE
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. FILE ; Check "B" index on this file
  1.  ;
  1.  ;ZEXCEPT: LRFN,LRROOT
  1.  ;
  1.  N DIK,LRIEN,LRNAME
  1.  F  S LRROOT=$Q(@LRROOT) Q:LRROOT=""  Q:$QS(LRROOT,2)'="B"  D
  1.  . S LRIEN=$QS(LRROOT,4)
  1.  . I LRFN<62,$G(@LRROOT) S LRNAME=$P($G(^LAB(LRFN,LRIEN,0)),"^",$S(((LRFN>61)&(LRFN<61.4)):7,1:5))
  1.  . E  S LRNAME=$P($G(^LAB(LRFN,LRIEN,0)),"^")
  1.  . I $QS(LRROOT,3)'=$E(LRNAME,1,30) K @LRROOT
  1.  ;
  1.  ; Reindex the "B" x-index on this file for fields #.01 and #6 (abbreviation)
  1.  S DIK="^LAB("_LRFN_",",DIK(1)=".01^B" D ENALL^DIK
  1.  K DIK
  1.  I LRFN<62 S DIK="^LAB("_LRFN_",",DIK(1)="6^B" D ENALL^DIK
  1.  Q
  1.  ;
  1.  ;
  1. LOG(X) ; Log error in XTMP global.
  1.  ; Call with X = error message to store.
  1.  ;
  1.  ;ZEXCEPT: LA7ECNT,LA7FIX,LA7IC
  1.  ;
  1.  S LA7ECNT=$G(LA7ECNT)+1
  1.  I LA7FIX S X=X_" **Fix attempted**"
  1.  S ^XTMP(LA7IC,LA7ECNT)=X
  1.  Q
  1.  ;
  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.  ;
  1.  ;ZEXCEPT: LA7LOG
  1.  ;
  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
  1.  ;
  1.  ;
  1. CHECKMG ; Check if LAB MESSAGING and LMI mail groups has active members.
  1.  ; Check mail groups specified for alerts in file #62.48 are valid and have active members.
  1.  ;
  1.  ;ZEXCEPT: LA7ECNT,LA7IC,LA7LOG,LA7XQA
  1.  ;
  1.  N LA76248,LA7FIX,LA7I,LA7MGERRORS,LA7X,LA7Y,XMERR,XQA,XQAID,XQAMSG
  1.  ;
  1.  ; Set flag that we've check the membership today.
  1.  S ^XTMP("LA7CHECKMG",0)=DT_"^"_DT_"^LAB HL7 CHECK LAB MESSAGING MAIL GROUP MEMBERS"
  1.  ;
  1.  K ^TMP("XMERR",$J)
  1.  S XQAMSG="",LA7FIX=0,LA7MGERRORS=LA7ECNT
  1.  ;
  1.  ; Doucment error message returned by GOTLOCAL API when mail group does not exist.
  1.  ;^TMP("XMERR",555809209,1)=39501
  1.  ;^TMP("XMERR",555809209,1,"TEXT",1)=Mail group 'LMI' not found.
  1.  ;^TMP("XMERR",555809209,"E",39501,1)=
  1.  ;
  1.  ; Mail group LAB MESSAGING has no active members
  1.  I '$$GOTLOCAL^XMXAPIG("LAB MESSAGING") D
  1.  . S LA7MGERRORS("LAB MESSAGING")=""
  1.  . S XQAMSG="Lab Messaging - Mail group LAB MESSAGING has no active members"
  1.  . I $D(^TMP("XMERR",$J,"E",39501)) S XQAMSG="Lab Messaging - Mail group LAB MESSAGING not found"
  1.  . S LA7XQA("G.LMI")=""
  1.  . I LA7LOG D
  1.  . . I $D(^TMP("XMERR",$J,"E",39501)) D  Q
  1.  . . . S XQAMSG="Lab Messaging - Mail group LAB MESSAGING not found"
  1.  . . . D LOG("Mail group LAB MESSAGING not found")
  1.  . . D LOG("Mail group LAB MESSAGING has no active members")
  1.  . K ^TMP("XMERR",$J)
  1.  E  S LA7XQA("G.LAB MESSAGING")=""
  1.  ;
  1.  ; Send alert to holders of mail group LMI
  1.  I '$$GOTLOCAL^XMXAPIG("LMI") D
  1.  . S LA7MGERRORS("LMI")=""
  1.  . I XQAMSG="" S XQAMSG="Lab Messaging - Mail group LMI has no active members"
  1.  . E  S XQAMSG="Lab Messaging - Mail groups LAB MESSAGING and LMI have no active members"
  1.  . I LA7LOG D
  1.  . . I $D(^TMP("XMERR",$J,"E",39501)) D LOG("Mail group LMI not found") Q
  1.  . . D LOG("Mail group LMI has no active members")
  1.  . K LA7XQA("G.LMI"),^TMP("XMERR",$J)
  1.  E  S LA7XQA("G.LMI")=""
  1.  ;
  1.  ; Neither LAB MESSAGING or LMI mail groups have active members - send alert to holders of LRLIASON security key
  1.  ; Delete previous alerts
  1.  I XQAMSG'="" D
  1.  . S XQAID="LA7-MESSAGE-CHECKMG"
  1.  . D DEL^LA7UXQA(XQAID)
  1.  . I $O(LA7XQA(""))="" M LA7XQA=^XUSEC("LRLIASON")
  1.  . M XQA=LA7XQA
  1.  . D SETUP^XQALERT
  1.  ;
  1.  S LA76248=0
  1.  F  S LA76248=$O(^LAHM(62.48,LA76248)) Q:LA76248<1  D
  1.  . S LA7I=0
  1.  . F LA7I=$O(^LAHM(62.48,LA76248,20,LA7I)) Q:LA7I<1  D
  1.  . . S LA7I(0)=$G(^LAHM(62.48,LA76248,0))
  1.  . . S LA7Y=$G(^LAHM(62.48,LA76248,20,LA7I,0))
  1.  . . I $P(LA7Y,"^",2)="" Q
  1.  . . K ^TMP("XMERR",$J)
  1.  . . I $$GOTLOCAL^XMXAPIG($P(LA7Y,"^",2)) Q
  1.  . . I '$D(LA7MGERRORS($P(LA7Y,"^",2))) D
  1.  . . . S XQAID="LA7-MESSAGE-CHECKMG-"_$P(LA7Y,"^",2)
  1.  .. .  D DEL^LA7UXQA(XQAID)
  1.  . . . S XQAMSG="Lab Messaging - Mail group "_$P(LA7Y,"^",2)_" has no active members"
  1.  . . . I $D(^TMP("XMERR",$J,"E",39501)) S XQAMSG="Lab Messaging - Mail group "_$P(LA7Y,"^",2)_" not found"
  1.  . . . K XQA
  1.  . . . M XQA=LA7XQA
  1.  . . . D SETUP^XQALERT
  1.  . . . S LA7MGERRORS($P(LA7Y,"^",2))=""
  1.  . . I LA7LOG D
  1.  . . . I $D(^TMP("XMERR",$J,"E",39501)) D LOG("Configuration "_$P(LA7I(0),"^")_" alert mail group "_$P(LA7Y,"^",2)_" not found") Q
  1.  . . . D LOG("Configuration "_$P(LA7I(0),"^")_" alert mail group "_$P(LA7Y,"^",2)_" has no active members")
  1.  ;
  1.  I LA7LOG D
  1.  . S LA7MGERRORS=LA7ECNT-LA7MGERRORS
  1.  . S $P(^XTMP(LA7IC,0),"^",9)=LA7MGERRORS ; Total error count
  1.  ;
  1.  K ^TMP("XMERR",$J)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. INIT ; Initialize variables
  1.  ;
  1.  ;ZEXCEPT: LA7ECNT,LA7FIX,LA7IC,LA7LOG
  1.  ;
  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.  ;
  1.  ; Count of number of errors
  1.  S LA7ECNT=0
  1.  ;
  1.  Q