LA7CHKF ;VA/DALOI/JMC - Check Lab Messaging File Integrity ; 22-Oct-2013 09:22 ; MAW
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,1033**;NOV 1, 1997
;This routine checks file integrity for Lab Messaging.
EN ; Run an integrity check
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
N LA7FIX,LA7ION,LA7LOG,LA7QUIT
;
S LA7LOG=1
S DIR(0)="SO^1:Check File Integrity;2:Fix File Entries"
S DIR("A")="Select Option",DIR("B")=1
D ^DIR
I $D(DIRUT) Q
I Y=1 S LA7FIX=0
I Y=2 S LA7FIX=1
;
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("A")="Print Report",DIR("B")="YES",DIR("?")="Enter 'YES' to print the integrity report."
D ^DIR
I $D(DIRUT) Q
I Y=1 D
. N %ZIS
. S %ZIS="NQ0",%ZIS("A")="Select Device: ",%ZIS("B")=""
. D ^%ZIS
. I POP S LA7QUIT=1
. S LA7ION=ION
I $G(LA7QUIT) D HOME^%ZIS Q
;
S ZTRTN="DQ^LA7CHKF",ZTDESC="Lab Messaging File Integrity Checker"
S ZTSAVE("LA7*")="",ZTIO=""
D ^%ZTLOAD,HOME^%ZIS
W !,"Request ",$S($G(ZTSK):"",1:"NOT "),"Queued"
Q
;
DQ ; Entry point from taskman
D IC
Q
;
IC ; File 62.49 Integrity checker and fix-er-upper.
;
; Check that all the cross-references have entries
;
N LA7CFG,LA7DA,LA7DAT,LA7ECNT,LA7IC,LA7INAME,LA7Q,LA7ROOT,X,Y
S LA7FIX=$G(LA7FIX,0) ; Set flag to fix problems 1=yes, 0=just check (default)
S LA7LOG=$G(LA7LOG,0) ; Set flag to report problems, 1=yes, 0=no (default)
I LA7LOG D
. F S LA7IC="LA7IC^"_$$NOW^XLFDT L +^XTMP(LA7IC):9999 Q:'$D(^XTMP(LA7IC)) L -^XTMP(LA7IC) H 1
. S DT=$$DT^XLFDT
. S ^XTMP(LA7IC,0)=$$FMADD^XLFDT(DT,7)_"^"_DT_"^Lab Messaging Integrity Checker"_"^"_$$NOW^XLFDT
S LA7ECNT=0 ; Count of number of errors
;
; Check the "AD" cross-reference
S LA7ROOT="^LAHM(62.49,""AD"")"
F S LA7ROOT=$Q(LA7ROOT) Q:LA7ROOT="" Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="AD") D
. S LA7DAT=$QS(LA7ROOT,3),LA7DA=$QS(LA7ROOT,4)
. I '$$LOCK(LA7DA) Q
. I LA7DAT'=$P($P($G(^LAHM(62.49,LA7DA,0)),"^",5),".") D
. . I LA7FIX K @LA7ROOT
. . I LA7LOG D LOG("Bad ""AD"" cross-reference of "_LA7ROOT_" for entry "_LA7DA)
. D UNLOCK(LA7DA)
;
; Check the "B" cross-reference
S LA7ROOT="^LAHM(62.49,""B"")"
F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT="" Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="B") D
. S LA7DA=$QS(LA7ROOT,4)
. I '$$LOCK(LA7DA) Q
. I LA7DA'=$QS(LA7ROOT,3) D
. . I LA7FIX K @LA7ROOT
. . I LA7LOG D LOG("""B"" cross-reference "_LA7ROOT_" points to incorrect entry "_$QS(LA7ROOT,4))
. I '$D(^LAHM(62.49,LA7DA,0)) D
. . I LA7FIX K @LA7ROOT
. . I LA7LOG D LOG("""B"" cross-reference "_LA7ROOT_" points to missing entry "_LA7DA)
. D UNLOCK(LA7DA)
;
; Check the "C" cross-reference
S LA7ROOT="^LAHM(62.49,""C"")"
F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT="" Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="C") D
. S LA7INAME=$QS(LA7ROOT,3),LA7DA=$QS(LA7ROOT,4)
. I '$$LOCK(LA7DA) Q
. I LA7INAME'=$E($P($G(^LAHM(62.49,LA7DA,0)),"^",6),1,30) D
. . I LA7FIX K @LA7ROOT
. . I LA7LOG D LOG("Bad ""C"" cross-reference of "_LA7ROOT_" on entry "_LA7DA)
. D UNLOCK(LA7DA)
;
; Check the "Q" cross-reference
S LA7ROOT="^LAHM(62.49,""Q"")"
F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT="" Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="Q") D
. S LA7CFG=$QS(LA7ROOT,3)
. S LA7Q=$QS(LA7ROOT,4)
. S LA7DA=$QS(LA7ROOT,5)
. I '$$LOCK(LA7DA) Q
. S X(0)=$G(^LAHM(62.49,LA7DA,0))
. S X(.5)=$G(^LAHM(62.49,LA7DA,.5))
. I LA7CFG'=$P(X(.5),"^")!(LA7Q'=($P(X(0),"^",2)_$P(X(0),"^",3))) D
. . I LA7LOG D LOG("Bad ""Q"" cross-reference of "_LA7ROOT_" for entry: "_LA7DA)
. . I LA7FIX K @LA7ROOT
. D UNLOCK(LA7DA)
;
; Check that all entries have "AD" cross-reference set.
; "B" cross-reference set
; "C" cross-reference set
; "Q" cross-reference set
S (LA7DA,LA7TCNT)=0
F S LA7DA=$O(^LAHM(62.49,LA7DA)) Q:'LA7DA D
. I '$$LOCK(LA7DA) Q
. S LA7TCNT=LA7TCNT+1 ; Count of entries in file.
. S X(0)=$G(^LAHM(62.49,LA7DA,0))
. S X(.5)=$G(^LAHM(62.49,LA7DA,.5))
. S Y=$P(X(0),"^") ; Message number (.01 field)
. I 'Y D
. . I LA7FIX K ^LAHM(62.49,LA7DA)
. . I LA7LOG D LOG("Entry "_LA7DA_" missing .01 field")
. S Y=$P(X(0),"^",5) ; date/time entered
. I Y,'$D(^LAHM(62.49,"AD",$P(Y,"."),LA7DA)) D
. . I LA7FIX S ^LAHM(62.49,"AD",$P(Y,"."),LA7DA)=""
. . I LA7LOG D LOG("Entry "_LA7DA_" missing ""AD"" cross-reference "_$P(Y,"."))
. S Y=$P(X(0),"^")
. I Y,'$D(^LAHM(62.49,"B",Y,LA7DA)) D
. . I LA7FIX S ^LAHM(62.49,"B",Y,LA7DA)=""
. . I LA7LOG D LOG("Entry "_LA7DA_" missing ""B"" cross-reference")
. S Y=$P(X(0),"^",6) ; instrument name
. I $L(Y),'$D(^LAHM(62.49,"C",$E(Y,1,30),LA7DA)) D
. . I LA7FIX S ^LAHM(62.49,"C",$E(Y,1,30),LA7DA)=""
. . I LA7LOG D LOG("Entry "_LA7DA_" missing ""C"" cross-reference "_Y)
. S Y=$P(X(0),"^",2)_$P(X(0),"^",3) ; concatentate configuration_status
. I +X(.5),$L(Y),'$D(^LAHM(62.49,"Q",+X(.5),Y,LA7DA)) D
. . I LA7FIX S ^LAHM(62.49,"Q",+X(.5),Y,LA7DA)=""
. . I LA7LOG D LOG("Entry "_LA7DA_" missing ^LAHM(62.49,""Q"","_+X(.5)_","""_Y_""","_LA7DA_") cross-reference")
. D UNLOCK(LA7DA)
I LA7LOG D
. S $P(^XTMP(LA7IC,0),"^",5)=$$NOW^XLFDT ; End date/time
. S $P(^XTMP(LA7IC,0),"^",6,7)=LA7TCNT_"^"_LA7ECNT ; Total^Error count
. L -^XTMP(LA7IC) ; Release lock
I LA7ECNT D
. N XQA,XQAID,XQADATA,XQAMSG,XQAOPT,XQAROU
. S XQAMSG="Lab Messaging -Warning- "_LA7ECNT_" errors found in File #62.49, LA7 MESSAGE QUEUE."
. I LA7LOG S XQADATA=LA7IC,XQAROU="DISIC^LA7UXQA"
. S XQAID="LA7ERR-"_$TR(LA7IC,"^",":")
. I $G(DUZ)>.9 S XQA(DUZ)=""
. S XQA("G.LAB MESSAGING")=""
. D SETUP^XQALERT
I $L($G(LA7ION)) D ; Task print of integrity report
. N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
. S ZTRTN="DQ^LA7CHKFP",ZTDTH=$H,ZTSAVE("LA7IC")="",ZTIO=LA7ION
. S ZTDESC="Print LA7 File Integrity Report"
. D ^%ZTLOAD
K LA7FIX,LA7ION,LA7LOG
Q
;
LOG(X) ; Log error in XTMP global.
; Call with X = error message to store.
S LA7ECNT=$G(LA7ECNT)+1
S ^XTMP(LA7IC,LA7ECNT)=X
Q
;
LOCK(LA7DA) ; Lock entry in #62.49
; Call with LA7DA = entry to lock
; Returns 0 = failure to obtain lock
; 1 = lock obtained
N LA7Y
S LA7Y=0,LA7DA=+$G(LA7DA)
L +^LAHM(62.49,LA7DA):10
I $T S LA7Y=1
I 'LA7Y,$G(LA7LOG) D LOG("Unable to obtain lock on entry "_LA7DA_" in file #62.49")
Q LA7Y
;
UNLOCK(LA7DA) ; Unlock entry in #62.49
; Call with LA7DA = entry to lock
;
S LA7DA=+$G(LA7DA)
L -^LAHM(62.49,LA7DA)
Q
;
LACHK() ; Check ^LA("ADL","Q") for build up of entries.
; Send alert to mail group LAB MESSAGING warning about large # of entries.
N LA7CNT,LA7DA,X,Y
S LA7DA="",LA7CNT=0
F S LA7DA=$O(^LA("ADL","Q",LA7DA)) Q:LA7DA="" S LA7CNT=LA7CNT+1
I LA7CNT>500 D
. N XQA,XQAID,XQADATA,XQAMSG,XQAOPT,XQAROU
. S XQAMSG="Lab Messaging -Warning- "_LA7CNT_" entries in LA(""ADL"",""Q"") global - please check."
. S XQAID="LA7ADL-"_$H
. I $G(DUZ)>.9 S XQA(DUZ)=""
. S XQA("G.LAB MESSAGING")=""
. D SETUP^XQALERT
Q LA7CNT
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
+2 ;This routine checks file integrity for Lab Messaging.
EN ; Run an integrity check
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 NEW LA7FIX,LA7ION,LA7LOG,LA7QUIT
+4 ;
+5 SET LA7LOG=1
+6 SET DIR(0)="SO^1:Check File Integrity;2:Fix File Entries"
+7 SET DIR("A")="Select Option"
SET DIR("B")=1
+8 DO ^DIR
+9 IF $DATA(DIRUT)
QUIT
+10 IF Y=1
SET LA7FIX=0
+11 IF Y=2
SET LA7FIX=1
+12 ;
+13 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+14 SET DIR(0)="YO"
SET DIR("A")="Print Report"
SET DIR("B")="YES"
SET DIR("?")="Enter 'YES' to print the integrity report."
+15 DO ^DIR
+16 IF $DATA(DIRUT)
QUIT
+17 IF Y=1
Begin DoDot:1
+18 NEW %ZIS
+19 SET %ZIS="NQ0"
SET %ZIS("A")="Select Device: "
SET %ZIS("B")=""
+20 DO ^%ZIS
+21 IF POP
SET LA7QUIT=1
+22 SET LA7ION=ION
End DoDot:1
+23 IF $GET(LA7QUIT)
DO HOME^%ZIS
QUIT
+24 ;
+25 SET ZTRTN="DQ^LA7CHKF"
SET ZTDESC="Lab Messaging File Integrity Checker"
+26 SET ZTSAVE("LA7*")=""
SET ZTIO=""
+27 DO ^%ZTLOAD
DO HOME^%ZIS
+28 WRITE !,"Request ",$SELECT($GET(ZTSK):"",1:"NOT "),"Queued"
+29 QUIT
+30 ;
DQ ; Entry point from taskman
+1 DO IC
+2 QUIT
+3 ;
IC ; File 62.49 Integrity checker and fix-er-upper.
+1 ;
+2 ; Check that all the cross-references have entries
+3 ;
+4 NEW LA7CFG,LA7DA,LA7DAT,LA7ECNT,LA7IC,LA7INAME,LA7Q,LA7ROOT,X,Y
+5 ; Set flag to fix problems 1=yes, 0=just check (default)
SET LA7FIX=$GET(LA7FIX,0)
+6 ; Set flag to report problems, 1=yes, 0=no (default)
SET LA7LOG=$GET(LA7LOG,0)
+7 IF LA7LOG
Begin DoDot:1
+8 FOR
SET LA7IC="LA7IC^"_$$NOW^XLFDT
LOCK +^XTMP(LA7IC):9999
IF '$DATA(^XTMP(LA7IC))
QUIT
LOCK -^XTMP(LA7IC)
HANG 1
+9 SET DT=$$DT^XLFDT
+10 SET ^XTMP(LA7IC,0)=$$FMADD^XLFDT(DT,7)_"^"_DT_"^Lab Messaging Integrity Checker"_"^"_$$NOW^XLFDT
End DoDot:1
+11 ; Count of number of errors
SET LA7ECNT=0
+12 ;
+13 ; Check the "AD" cross-reference
+14 SET LA7ROOT="^LAHM(62.49,""AD"")"
+15 FOR
SET LA7ROOT=$QUERY(LA7ROOT)
IF LA7ROOT=""
QUIT
IF $QSUBSCRIPT(LA7ROOT,1)'=62.49!($QSUBSCRIPT(LA7ROOT,2)'="AD")
QUIT
Begin DoDot:1
+16 SET LA7DAT=$QSUBSCRIPT(LA7ROOT,3)
SET LA7DA=$QSUBSCRIPT(LA7ROOT,4)
+17 IF '$$LOCK(LA7DA)
QUIT
+18 IF LA7DAT'=$PIECE($PIECE($GET(^LAHM(62.49,LA7DA,0)),"^",5),".")
Begin DoDot:2
+19 IF LA7FIX
KILL @LA7ROOT
+20 IF LA7LOG
DO LOG("Bad ""AD"" cross-reference of "_LA7ROOT_" for entry "_LA7DA)
End DoDot:2
+21 DO UNLOCK(LA7DA)
End DoDot:1
+22 ;
+23 ; Check the "B" cross-reference
+24 SET LA7ROOT="^LAHM(62.49,""B"")"
+25 FOR
SET LA7ROOT=$QUERY(@LA7ROOT)
IF LA7ROOT=""
QUIT
IF $QSUBSCRIPT(LA7ROOT,1)'=62.49!($QSUBSCRIPT(LA7ROOT,2)'="B")
QUIT
Begin DoDot:1
+26 SET LA7DA=$QSUBSCRIPT(LA7ROOT,4)
+27 IF '$$LOCK(LA7DA)
QUIT
+28 IF LA7DA'=$QSUBSCRIPT(LA7ROOT,3)
Begin DoDot:2
+29 IF LA7FIX
KILL @LA7ROOT
+30 IF LA7LOG
DO LOG("""B"" cross-reference "_LA7ROOT_" points to incorrect entry "_$QSUBSCRIPT(LA7ROOT,4))
End DoDot:2
+31 IF '$DATA(^LAHM(62.49,LA7DA,0))
Begin DoDot:2
+32 IF LA7FIX
KILL @LA7ROOT
+33 IF LA7LOG
DO LOG("""B"" cross-reference "_LA7ROOT_" points to missing entry "_LA7DA)
End DoDot:2
+34 DO UNLOCK(LA7DA)
End DoDot:1
+35 ;
+36 ; Check the "C" cross-reference
+37 SET LA7ROOT="^LAHM(62.49,""C"")"
+38 FOR
SET LA7ROOT=$QUERY(@LA7ROOT)
IF LA7ROOT=""
QUIT
IF $QSUBSCRIPT(LA7ROOT,1)'=62.49!($QSUBSCRIPT(LA7ROOT,2)'="C")
QUIT
Begin DoDot:1
+39 SET LA7INAME=$QSUBSCRIPT(LA7ROOT,3)
SET LA7DA=$QSUBSCRIPT(LA7ROOT,4)
+40 IF '$$LOCK(LA7DA)
QUIT
+41 IF LA7INAME'=$EXTRACT($PIECE($GET(^LAHM(62.49,LA7DA,0)),"^",6),1,30)
Begin DoDot:2
+42 IF LA7FIX
KILL @LA7ROOT
+43 IF LA7LOG
DO LOG("Bad ""C"" cross-reference of "_LA7ROOT_" on entry "_LA7DA)
End DoDot:2
+44 DO UNLOCK(LA7DA)
End DoDot:1
+45 ;
+46 ; Check the "Q" cross-reference
+47 SET LA7ROOT="^LAHM(62.49,""Q"")"
+48 FOR
SET LA7ROOT=$QUERY(@LA7ROOT)
IF LA7ROOT=""
QUIT
IF $QSUBSCRIPT(LA7ROOT,1)'=62.49!($QSUBSCRIPT(LA7ROOT,2)'="Q")
QUIT
Begin DoDot:1
+49 SET LA7CFG=$QSUBSCRIPT(LA7ROOT,3)
+50 SET LA7Q=$QSUBSCRIPT(LA7ROOT,4)
+51 SET LA7DA=$QSUBSCRIPT(LA7ROOT,5)
+52 IF '$$LOCK(LA7DA)
QUIT
+53 SET X(0)=$GET(^LAHM(62.49,LA7DA,0))
+54 SET X(.5)=$GET(^LAHM(62.49,LA7DA,.5))
+55 IF LA7CFG'=$PIECE(X(.5),"^")!(LA7Q'=($PIECE(X(0),"^",2)_$PIECE(X(0),"^",3)))
Begin DoDot:2
+56 IF LA7LOG
DO LOG("Bad ""Q"" cross-reference of "_LA7ROOT_" for entry: "_LA7DA)
+57 IF LA7FIX
KILL @LA7ROOT
End DoDot:2
+58 DO UNLOCK(LA7DA)
End DoDot:1
+59 ;
+60 ; Check that all entries have "AD" cross-reference set.
+61 ; "B" cross-reference set
+62 ; "C" cross-reference set
+63 ; "Q" cross-reference set
+64 SET (LA7DA,LA7TCNT)=0
+65 FOR
SET LA7DA=$ORDER(^LAHM(62.49,LA7DA))
IF 'LA7DA
QUIT
Begin DoDot:1
+66 IF '$$LOCK(LA7DA)
QUIT
+67 ; Count of entries in file.
SET LA7TCNT=LA7TCNT+1
+68 SET X(0)=$GET(^LAHM(62.49,LA7DA,0))
+69 SET X(.5)=$GET(^LAHM(62.49,LA7DA,.5))
+70 ; Message number (.01 field)
SET Y=$PIECE(X(0),"^")
+71 IF 'Y
Begin DoDot:2
+72 IF LA7FIX
KILL ^LAHM(62.49,LA7DA)
+73 IF LA7LOG
DO LOG("Entry "_LA7DA_" missing .01 field")
End DoDot:2
+74 ; date/time entered
SET Y=$PIECE(X(0),"^",5)
+75 IF Y
IF '$DATA(^LAHM(62.49,"AD",$PIECE(Y,"."),LA7DA))
Begin DoDot:2
+76 IF LA7FIX
SET ^LAHM(62.49,"AD",$PIECE(Y,"."),LA7DA)=""
+77 IF LA7LOG
DO LOG("Entry "_LA7DA_" missing ""AD"" cross-reference "_$PIECE(Y,"."))
End DoDot:2
+78 SET Y=$PIECE(X(0),"^")
+79 IF Y
IF '$DATA(^LAHM(62.49,"B",Y,LA7DA))
Begin DoDot:2
+80 IF LA7FIX
SET ^LAHM(62.49,"B",Y,LA7DA)=""
+81 IF LA7LOG
DO LOG("Entry "_LA7DA_" missing ""B"" cross-reference")
End DoDot:2
+82 ; instrument name
SET Y=$PIECE(X(0),"^",6)
+83 IF $LENGTH(Y)
IF '$DATA(^LAHM(62.49,"C",$EXTRACT(Y,1,30),LA7DA))
Begin DoDot:2
+84 IF LA7FIX
SET ^LAHM(62.49,"C",$EXTRACT(Y,1,30),LA7DA)=""
+85 IF LA7LOG
DO LOG("Entry "_LA7DA_" missing ""C"" cross-reference "_Y)
End DoDot:2
+86 ; concatentate configuration_status
SET Y=$PIECE(X(0),"^",2)_$PIECE(X(0),"^",3)
+87 IF +X(.5)
IF $LENGTH(Y)
IF '$DATA(^LAHM(62.49,"Q",+X(.5),Y,LA7DA))
Begin DoDot:2
+88 IF LA7FIX
SET ^LAHM(62.49,"Q",+X(.5),Y,LA7DA)=""
+89 IF LA7LOG
DO LOG("Entry "_LA7DA_" missing ^LAHM(62.49,""Q"","_+X(.5)_","""_Y_""","_LA7DA_") cross-reference")
End DoDot:2
+90 DO UNLOCK(LA7DA)
End DoDot:1
+91 IF LA7LOG
Begin DoDot:1
+92 ; End date/time
SET $PIECE(^XTMP(LA7IC,0),"^",5)=$$NOW^XLFDT
+93 ; Total^Error count
SET $PIECE(^XTMP(LA7IC,0),"^",6,7)=LA7TCNT_"^"_LA7ECNT
+94 ; Release lock
LOCK -^XTMP(LA7IC)
End DoDot:1
+95 IF LA7ECNT
Begin DoDot:1
+96 NEW XQA,XQAID,XQADATA,XQAMSG,XQAOPT,XQAROU
+97 SET XQAMSG="Lab Messaging -Warning- "_LA7ECNT_" errors found in File #62.49, LA7 MESSAGE QUEUE."
+98 IF LA7LOG
SET XQADATA=LA7IC
SET XQAROU="DISIC^LA7UXQA"
+99 SET XQAID="LA7ERR-"_$TRANSLATE(LA7IC,"^",":")
+100 IF $GET(DUZ)>.9
SET XQA(DUZ)=""
+101 SET XQA("G.LAB MESSAGING")=""
+102 DO SETUP^XQALERT
End DoDot:1
+103 ; Task print of integrity report
IF $LENGTH($GET(LA7ION))
Begin DoDot:1
+104 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
+105 SET ZTRTN="DQ^LA7CHKFP"
SET ZTDTH=$HOROLOG
SET ZTSAVE("LA7IC")=""
SET ZTIO=LA7ION
+106 SET ZTDESC="Print LA7 File Integrity Report"
+107 DO ^%ZTLOAD
End DoDot:1
+108 KILL LA7FIX,LA7ION,LA7LOG
+109 QUIT
+110 ;
LOG(X) ; Log error in XTMP global.
+1 ; Call with X = error message to store.
+2 SET LA7ECNT=$GET(LA7ECNT)+1
+3 SET ^XTMP(LA7IC,LA7ECNT)=X
+4 QUIT
+5 ;
LOCK(LA7DA) ; Lock entry in #62.49
+1 ; Call with LA7DA = entry to lock
+2 ; Returns 0 = failure to obtain lock
+3 ; 1 = lock obtained
+4 NEW LA7Y
+5 SET LA7Y=0
SET LA7DA=+$GET(LA7DA)
+6 LOCK +^LAHM(62.49,LA7DA):10
+7 IF $TEST
SET LA7Y=1
+8 IF 'LA7Y
IF $GET(LA7LOG)
DO LOG("Unable to obtain lock on entry "_LA7DA_" in file #62.49")
+9 QUIT LA7Y
+10 ;
UNLOCK(LA7DA) ; Unlock entry in #62.49
+1 ; Call with LA7DA = entry to lock
+2 ;
+3 SET LA7DA=+$GET(LA7DA)
+4 LOCK -^LAHM(62.49,LA7DA)
+5 QUIT
+6 ;
LACHK() ; Check ^LA("ADL","Q") for build up of entries.
+1 ; Send alert to mail group LAB MESSAGING warning about large # of entries.
+2 NEW LA7CNT,LA7DA,X,Y
+3 SET LA7DA=""
SET LA7CNT=0
+4 FOR
SET LA7DA=$ORDER(^LA("ADL","Q",LA7DA))
IF LA7DA=""
QUIT
SET LA7CNT=LA7CNT+1
+5 IF LA7CNT>500
Begin DoDot:1
+6 NEW XQA,XQAID,XQADATA,XQAMSG,XQAOPT,XQAROU
+7 SET XQAMSG="Lab Messaging -Warning- "_LA7CNT_" entries in LA(""ADL"",""Q"") global - please check."
+8 SET XQAID="LA7ADL-"_$HOROLOG
+9 IF $GET(DUZ)>.9
SET XQA(DUZ)=""
+10 SET XQA("G.LAB MESSAGING")=""
+11 DO SETUP^XQALERT
End DoDot:1
+12 QUIT LA7CNT
