source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANDBXX.m@ 1582

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1QANDBXX ;GJC/HISC-Database Checker ;4/1/92
2 ;;2.0;Incident Reporting;;08/07/1992
3 ;
4 S (QANFLG,QANPG,QANXIT)=0
5 S QANHD1="Quality Assurance Database Integrity Checker"
6 S QANHD2="Incident Reporting Version 2.0"
7 S QANHD3="No evidence of database corruption found."
8 S $P(QANLINE,"*",81)=""
9DEV ;Select Device
10 K IOP,%ZIS S %ZIS("A")="Print on Device: ",%ZIS="MQ" W ! D ^%ZIS W !!
11 G:POP KILL
12 I $D(IO("Q")) S ZTRTN="START^QANDBXX",ZTDESC="IR database report",ZTSAVE("QAN*")="" D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued.",1:"Request Cancelled."),! G EXIT
13START U IO D HDR
14 F QA=0:0 S QA=$O(^QA(742,"BCS",QA)) Q:QA'>0 D CASE Q:QANXIT
15 W !?(IOM-$L(QANHD3)\2),$S('QANFLG:QANHD3,1:"")
16EXIT ;Exit
17 W ! D ^%ZISC,HOME^%ZIS
18KILL ;Kill and quit
19 K %H,%ZIS,IZ,POP,QANFLG,QANHD1,QANHD2,QANHD3,QANLINE,QANPG,QANXIT,ZTSK
20 K D,QA,QAN742,QAN7424,QANCS,QB,TODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE
21 Q
22CASE ;Case Number information
23 S QAN7424=$G(^QA(742.4,QA,0))
24 S QANCS(1)=$P(QAN7424,U),QANCS(2)=$P(QAN7424,U,2),QANCS(3)=$P(QAN7424,U,3)
25 I QAN7424']"" W !,"Incident Record Number: ",QA," does NOT have data associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
26 I QANCS(1)']"" W !,"Incident Record Number: ",QA," does NOT have a Case Number associated with the",!,"record!" D:$Y>(IOSL-4) HDH Q:QANXIT
27 I QANCS(2)']"" W !,"Incident Record Number: ",QA," does NOT have a Incident associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
28 I QANCS(3)']"" W !,"Incident Record Number: ",QA," does NOT have a Incident Date associated with the",!,"record!" D:$Y>(IOSL-4) HDH Q:QANXIT
29 F QB=0:0 S QB=$O(^QA(742,"BCS",QA,QB)) Q:QB'>0 D PAT Q:QANXIT
30 Q
31PAT ;Patient Information
32 S QAN742=$G(^QA(742,QB,0))
33 I QAN742']"" W !,"Patient Record Number: ",QB," does NOT have data associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
34 I '$D(^QA(742.4,"ACN",QB,QA)) S QANFLG=1 W !,"'ACN' x-ref missing for Patient Record: ",QB," Incident Record: ",QA D:$Y>(IOSL-4) HDH Q:QANXIT
35 S QANCS(4)=$P(QAN742,U),QANCS(5)=$P(QAN742,U,2),QANCS(6)=$P(QAN742,U,3)
36 I QANCS(4)']"" S QANFLG=1 W !,"Patient Record Number: ",QA," does NOT have a Patient associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
37 I QANCS(5)']"" S QANFLG=1 W !,"Patient Record Number: ",QA," does NOT have a Patient ID associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
38 I QANCS(6)']"" S QANFLG=1 W !,"Patient Record Number: ",QA," does NOT have a Incident associated with the record!" D:$Y>(IOSL-4) HDH Q:QANXIT
39 Q
40HDH ;Header Prompt
41 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 QANXIT=1 Q:QANXIT
42HDR ;Header
43 W @IOF
44 S QANPG=QANPG+1,%H=$H D YX^%DTC S TODAY=Y
45 W ?69,"Page: ",QANPG,!?58,TODAY,!!
46 W ?(IOM-$L(QANHD1)\2),QANHD1,!?(IOM-$L(QANHD2)\2),QANHD2,!!
47 F IZ=1:1:2 W QANLINE,!
48 W !
49 Q
Note: See TracBrowser for help on using the repository browser.