source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7CHKF.m@ 1170

Last change on this file since 1170 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1LA7CHKF ;DALOI/JMC - Check Lab Messaging File Integrity ; 2/26/97 11:00
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46**;Sep 27, 1994
3 ;This routine checks file integrity for Lab Messaging.
4EN ; Run an integrity check
5 ;
6 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
7 N LA7FIX,LA7ION,LA7LOG,LA7QUIT
8 ;
9 S LA7LOG=1
10 S DIR(0)="SO^1:Check File Integrity;2:Fix File Entries"
11 S DIR("A")="Select Option",DIR("B")=1
12 D ^DIR
13 I $D(DIRUT) Q
14 I Y=1 S LA7FIX=0
15 I Y=2 S LA7FIX=1
16 ;
17 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
18 S DIR(0)="YO",DIR("A")="Print Report",DIR("B")="YES",DIR("?")="Enter 'YES' to print the integrity report."
19 D ^DIR
20 I $D(DIRUT) Q
21 I Y=1 D
22 . N %ZIS
23 . S %ZIS="NQ0",%ZIS("A")="Select Device: ",%ZIS("B")=""
24 . D ^%ZIS
25 . I POP S LA7QUIT=1
26 . S LA7ION=ION
27 I $G(LA7QUIT) D HOME^%ZIS Q
28 ;
29 S ZTRTN="DQ^LA7CHKF",ZTDESC="Lab Messaging File Integrity Checker"
30 S ZTSAVE("LA7*")="",ZTIO=""
31 D ^%ZTLOAD,HOME^%ZIS
32 W !,"Request ",$S($G(ZTSK):"",1:"NOT "),"Queued"
33 Q
34 ;
35DQ ; Entry point from taskman
36 D IC
37 Q
38 ;
39IC ; File 62.49 Integrity checker and fix-er-upper.
40 ;
41 ; Check that all the cross-references have entries
42 ;
43 N LA7CFG,LA7DA,LA7DAT,LA7ECNT,LA7IC,LA7INAME,LA7Q,LA7ROOT,X,Y
44 S LA7FIX=$G(LA7FIX,0) ; Set flag to fix problems 1=yes, 0=just check (default)
45 S LA7LOG=$G(LA7LOG,0) ; Set flag to report problems, 1=yes, 0=no (default)
46 I LA7LOG D
47 . F S LA7IC="LA7IC^"_$$NOW^XLFDT L +^XTMP(LA7IC):9999 Q:'$D(^XTMP(LA7IC)) L -^XTMP(LA7IC) H 1
48 . S DT=$$DT^XLFDT
49 . S ^XTMP(LA7IC,0)=$$FMADD^XLFDT(DT,7)_"^"_DT_"^Lab Messaging Integrity Checker"_"^"_$$NOW^XLFDT
50 S LA7ECNT=0 ; Count of number of errors
51 ;
52 ; Check the "AD" cross-reference
53 S LA7ROOT="^LAHM(62.49,""AD"")"
54 F S LA7ROOT=$Q(LA7ROOT) Q:LA7ROOT="" Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="AD") D
55 . S LA7DAT=$QS(LA7ROOT,3),LA7DA=$QS(LA7ROOT,4)
56 . I '$$LOCK(LA7DA) Q
57 . I LA7DAT'=$P($P($G(^LAHM(62.49,LA7DA,0)),"^",5),".") D
58 . . I LA7FIX K @LA7ROOT
59 . . I LA7LOG D LOG("Bad ""AD"" cross-reference of "_LA7ROOT_" for entry "_LA7DA)
60 . D UNLOCK(LA7DA)
61 ;
62 ; Check the "B" cross-reference
63 S LA7ROOT="^LAHM(62.49,""B"")"
64 F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT="" Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="B") D
65 . S LA7DA=$QS(LA7ROOT,4)
66 . I '$$LOCK(LA7DA) Q
67 . I LA7DA'=$QS(LA7ROOT,3) D
68 . . I LA7FIX K @LA7ROOT
69 . . I LA7LOG D LOG("""B"" cross-reference "_LA7ROOT_" points to incorrect entry "_$QS(LA7ROOT,4))
70 . I '$D(^LAHM(62.49,LA7DA,0)) D
71 . . I LA7FIX K @LA7ROOT
72 . . I LA7LOG D LOG("""B"" cross-reference "_LA7ROOT_" points to missing entry "_LA7DA)
73 . D UNLOCK(LA7DA)
74 ;
75 ; Check the "C" cross-reference
76 S LA7ROOT="^LAHM(62.49,""C"")"
77 F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT="" Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="C") D
78 . S LA7INAME=$QS(LA7ROOT,3),LA7DA=$QS(LA7ROOT,4)
79 . I '$$LOCK(LA7DA) Q
80 . I LA7INAME'=$E($P($G(^LAHM(62.49,LA7DA,0)),"^",6),1,30) D
81 . . I LA7FIX K @LA7ROOT
82 . . I LA7LOG D LOG("Bad ""C"" cross-reference of "_LA7ROOT_" on entry "_LA7DA)
83 . D UNLOCK(LA7DA)
84 ;
85 ; Check the "Q" cross-reference
86 S LA7ROOT="^LAHM(62.49,""Q"")"
87 F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT="" Q:$QS(LA7ROOT,1)'=62.49!($QS(LA7ROOT,2)'="Q") D
88 . S LA7CFG=$QS(LA7ROOT,3)
89 . S LA7Q=$QS(LA7ROOT,4)
90 . S LA7DA=$QS(LA7ROOT,5)
91 . I '$$LOCK(LA7DA) Q
92 . S X(0)=$G(^LAHM(62.49,LA7DA,0))
93 . S X(.5)=$G(^LAHM(62.49,LA7DA,.5))
94 . I LA7CFG'=$P(X(.5),"^")!(LA7Q'=($P(X(0),"^",2)_$P(X(0),"^",3))) D
95 . . I LA7LOG D LOG("Bad ""Q"" cross-reference of "_LA7ROOT_" for entry: "_LA7DA)
96 . . I LA7FIX K @LA7ROOT
97 . D UNLOCK(LA7DA)
98 ;
99 ; Check that all entries have "AD" cross-reference set.
100 ; "B" cross-reference set
101 ; "C" cross-reference set
102 ; "Q" cross-reference set
103 S (LA7DA,LA7TCNT)=0
104 F S LA7DA=$O(^LAHM(62.49,LA7DA)) Q:'LA7DA D
105 . I '$$LOCK(LA7DA) Q
106 . S LA7TCNT=LA7TCNT+1 ; Count of entries in file.
107 . S X(0)=$G(^LAHM(62.49,LA7DA,0))
108 . S X(.5)=$G(^LAHM(62.49,LA7DA,.5))
109 . S Y=$P(X(0),"^") ; Message number (.01 field)
110 . I 'Y D
111 . . I LA7FIX K ^LAHM(62.49,LA7DA)
112 . . I LA7LOG D LOG("Entry "_LA7DA_" missing .01 field")
113 . S Y=$P(X(0),"^",5) ; date/time entered
114 . I Y,'$D(^LAHM(62.49,"AD",$P(Y,"."),LA7DA)) D
115 . . I LA7FIX S ^LAHM(62.49,"AD",$P(Y,"."),LA7DA)=""
116 . . I LA7LOG D LOG("Entry "_LA7DA_" missing ""AD"" cross-reference "_$P(Y,"."))
117 . S Y=$P(X(0),"^")
118 . I Y,'$D(^LAHM(62.49,"B",Y,LA7DA)) D
119 . . I LA7FIX S ^LAHM(62.49,"B",Y,LA7DA)=""
120 . . I LA7LOG D LOG("Entry "_LA7DA_" missing ""B"" cross-reference")
121 . S Y=$P(X(0),"^",6) ; instrument name
122 . I $L(Y),'$D(^LAHM(62.49,"C",$E(Y,1,30),LA7DA)) D
123 . . I LA7FIX S ^LAHM(62.49,"C",$E(Y,1,30),LA7DA)=""
124 . . I LA7LOG D LOG("Entry "_LA7DA_" missing ""C"" cross-reference "_Y)
125 . S Y=$P(X(0),"^",2)_$P(X(0),"^",3) ; concatentate configuration_status
126 . I +X(.5),$L(Y),'$D(^LAHM(62.49,"Q",+X(.5),Y,LA7DA)) D
127 . . I LA7FIX S ^LAHM(62.49,"Q",+X(.5),Y,LA7DA)=""
128 . . I LA7LOG D LOG("Entry "_LA7DA_" missing ^LAHM(62.49,""Q"","_+X(.5)_","""_Y_""","_LA7DA_") cross-reference")
129 . D UNLOCK(LA7DA)
130 I LA7LOG D
131 . S $P(^XTMP(LA7IC,0),"^",5)=$$NOW^XLFDT ; End date/time
132 . S $P(^XTMP(LA7IC,0),"^",6,7)=LA7TCNT_"^"_LA7ECNT ; Total^Error count
133 . L -^XTMP(LA7IC) ; Release lock
134 I LA7ECNT D
135 . N XQA,XQAID,XQADATA,XQAMSG,XQAOPT,XQAROU
136 . S XQAMSG="Lab Messaging -Warning- "_LA7ECNT_" errors found in File #62.49, LA7 MESSAGE QUEUE."
137 . I LA7LOG S XQADATA=LA7IC,XQAROU="DISIC^LA7UXQA"
138 . S XQAID="LA7ERR-"_$TR(LA7IC,"^",":")
139 . I $G(DUZ)>.9 S XQA(DUZ)=""
140 . S XQA("G.LAB MESSAGING")=""
141 . D SETUP^XQALERT
142 I $L($G(LA7ION)) D ; Task print of integrity report
143 . N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
144 . S ZTRTN="DQ^LA7CHKFP",ZTDTH=$H,ZTSAVE("LA7IC")="",ZTIO=LA7ION
145 . S ZTDESC="Print LA7 File Integrity Report"
146 . D ^%ZTLOAD
147 K LA7FIX,LA7ION,LA7LOG
148 Q
149 ;
150LOG(X) ; Log error in XTMP global.
151 ; Call with X = error message to store.
152 S LA7ECNT=$G(LA7ECNT)+1
153 S ^XTMP(LA7IC,LA7ECNT)=X
154 Q
155 ;
156LOCK(LA7DA) ; Lock entry in #62.49
157 ; Call with LA7DA = entry to lock
158 ; Returns 0 = failure to obtain lock
159 ; 1 = lock obtained
160 N LA7Y
161 S LA7Y=0,LA7DA=+$G(LA7DA)
162 L +^LAHM(62.49,LA7DA):10
163 I $T S LA7Y=1
164 I 'LA7Y,$G(LA7LOG) D LOG("Unable to obtain lock on entry "_LA7DA_" in file #62.49")
165 Q LA7Y
166 ;
167UNLOCK(LA7DA) ; Unlock entry in #62.49
168 ; Call with LA7DA = entry to lock
169 ;
170 S LA7DA=+$G(LA7DA)
171 L -^LAHM(62.49,LA7DA)
172 Q
173 ;
174LACHK() ; Check ^LA("ADL","Q") for build up of entries.
175 ; Send alert to mail group LAB MESSAGING warning about large # of entries.
176 N LA7CNT,LA7DA,X,Y
177 S LA7DA="",LA7CNT=0
178 F S LA7DA=$O(^LA("ADL","Q",LA7DA)) Q:LA7DA="" S LA7CNT=LA7CNT+1
179 I LA7CNT>500 D
180 . N XQA,XQAID,XQADATA,XQAMSG,XQAOPT,XQAROU
181 . S XQAMSG="Lab Messaging -Warning- "_LA7CNT_" entries in LA(""ADL"",""Q"") global - please check."
182 . S XQAID="LA7ADL-"_$H
183 . I $G(DUZ)>.9 S XQA(DUZ)=""
184 . S XQA("G.LAB MESSAGING")=""
185 . D SETUP^XQALERT
186 Q LA7CNT
Note: See TracBrowser for help on using the repository browser.