source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANQIP1.m@ 841

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1QANQIP1 ;HISC/GJC-Interface with QUIC, tracking IR V2.0 data. ;4/13/93 10:00
2 ;;2.0;Incident Reporting;**18**;08/07/1992
3 S QANINCD(1)=$O(^QA(742.1,"BUPPER","ASSAULT-PATIENT TO PATIENT",0))
4 S QANINCD(2)=$O(^QA(742.1,"BUPPER","PATIENT ABUSE",0))
5 I QANINCD(1)=""!(QANINCD(2)="") W !?5,"Incident data incomplete, check the QA Incident file." S QANEXIT=1 Q
6 F QAN=QANBDT:0 S QAN=$O(^QA(742.4,"BDT",QAN)) Q:QAN'>0!(QAN>QANEDT) F QAN7424=0:0 S QAN7424=$O(^QA(742.4,"BDT",QAN,QAN7424)) Q:QAN7424'>0 D EXTRCT1
7 Q
8EXTRCT1 ;Grab the appropriate data.
9 S QAN7424(0)=$G(^QA(742.4,QAN7424,0)) Q:QAN7424(0)']"" S QANINCD=$P(QAN7424(0),U,2)
10 Q:$P(QAN7424(0),U,8)=2 ;Deleted incident.
11 Q:QANINCD'=QANINCD(1)&(QANINCD'=QANINCD(2))
12 Q:QANINCD=QANINCD(2)&(+$P(QAN7424(0),U,16)'=1)
13 S QANINAM=$P(^QA(742.1,QANINCD,0),U)
14 S QANINAM=$S(QANINAM="Assault-Patient to Patient":"PATIENT ASSAULT",1:"PATIENT ABUSE")
15 F QAN742=0:0 S QAN742=$O(^QA(742,"BCS",QAN7424,QAN742)) Q:QAN742'>0 S QAN742(0)=$G(^QA(742,QAN742,0)) Q:QAN742(0)']"" D EXTRCT2
16 Q
17EXTRCT2 ;Total the data.
18 S QANPTTY=$S($P(QAN742(0),U,5)=1:"IN",$P(QAN742(0),U,5)=0:"OUT",1:"") Q:QANPTTY']""
19 I '$D(ARRAY(QANINAM,QANPTTY)) S ARRAY(QANINAM,QANPTTY)=1
20 E S ARRAY(QANINAM,QANPTTY)=ARRAY(QANINAM,QANPTTY)+1
21 S ^TMP($J,"XREF",QAN7424,QAN742)="" ;Setting xref node for data output.
22 Q
Note: See TracBrowser for help on using the repository browser.