source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANDBASE.m@ 660

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1QANDBASE ;WCIOFO/ERC - TEST FOR BAD RECORDS IN ^QA(742 ;9/20/99
2 ;;2.0;Incident Reporting;;*26*;08/07/1992
3 S QANSIT=$P(^QA(740,1,0),U)
4 S QANSIT=$P(^DIC(4,QANSIT,0),U)
5 S QANCNT=1
6 N QANCC,QANEE,QANRR
7 S QANFLG=0
8START ; use date cross-reference to determine starting record in 742
9 S QANSTART=2990501 ; use date before QAN27
10 S QANSTART=$O(^QA(742.4,"BDT",QANSTART)) Q:QANSTART'>0 D
11 . S QANEE=$O(^QA(742.4,"BDT",QANSTART,0)) Q:QANEE'>0 D
12 . . S QANCC=$O(^QA(742,"BCS",QANEE,0)) Q:QANCC'>0 D 742
13 Q
14742 ; loop through 742, using QANCC as first record
15 S QANRR=QANCC-1
16 F S QANRR=$O(^QA(742,QANRR)) Q:QANRR'>0 D
17 . D NOZERO
18 . D NO7424
19 I $G(QANFLG)=0 S QANTXT(QANCNT)="No records in file 742 with missing .01 field.",QANCNT=QANCNT+1
20 S QANTXT(QANCNT)="Last entry in file 742 is "_$P(^QA(742,0),U,3)
21 D MAIL
22 Q
23NOZERO ; check for .01 FIELD
24 I $P(^QA(742,QANRR,0),U)']"" S QANTXT(QANCNT)="File 742 record #"_QANRR_" is bad - no .01 Field" S QANFLG=1,QANCNT=QANCNT+1
25 Q
26NO7424 ; sub-routine will check entries in 742 for valid pointer to 742.4
27 S QAN7424=$P(^QA(742,QANRR,0),U,3) Q:$G(QAN7424)']""
28 I '$D(^QA(742.4,QAN7424,0)) D
29 . S QANTXT(QANCNT)="File 742 record #"_QANRR_" points to a non-existent record in file 742.4.",QANCNT=QANCNT+1
30 . S DFN=$P(^QA(742,QANRR,0),U)
31 . D DEM^VADPT
32 . S QANTXT(QANCNT)=" Patient for file 742 record #"_QANRR_" is "_VADM(1),QANCNT=QANCNT+1
33 . K DFN,VADM
34 Q
35MAIL ;
36 N DIFROM,XMROU
37 D KILL^XM
38 S XMDUZ=.5,XMY(DUZ)=""
39 S XMTEXT="QANTXT("
40 S XMY("CURTIN,EDNA@FORUM.VA.GOV")=""
41 S XMSUB="QAN FILE 742 REPORT - "_QANSIT
42 D ^XMD
43 D KILL^XM
44KILL ;
45 K QAN7424,QANCNT,QANFLG,QANSIT,QANSTART,QANTXT
46 K XMDUZ,XMTEXT,XMY
47 Q
Note: See TracBrowser for help on using the repository browser.