QANQIP1 ;HISC/GJC-Interface with QUIC, tracking IR V2.0 data. ;4/13/93 10:00
;;2.0;Incident Reporting;**18**;08/07/1992
S QANINCD(1)=$O(^QA(742.1,"BUPPER","ASSAULT-PATIENT TO PATIENT",0))
S QANINCD(2)=$O(^QA(742.1,"BUPPER","PATIENT ABUSE",0))
I QANINCD(1)=""!(QANINCD(2)="") W !?5,"Incident data incomplete, check the QA Incident file." S QANEXIT=1 Q
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
Q
EXTRCT1 ;Grab the appropriate data.
S QAN7424(0)=$G(^QA(742.4,QAN7424,0)) Q:QAN7424(0)']"" S QANINCD=$P(QAN7424(0),U,2)
Q:$P(QAN7424(0),U,8)=2 ;Deleted incident.
Q:QANINCD'=QANINCD(1)&(QANINCD'=QANINCD(2))
Q:QANINCD=QANINCD(2)&(+$P(QAN7424(0),U,16)'=1)
S QANINAM=$P(^QA(742.1,QANINCD,0),U)
S QANINAM=$S(QANINAM="Assault-Patient to Patient":"PATIENT ASSAULT",1:"PATIENT ABUSE")
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
Q
EXTRCT2 ;Total the data.
S QANPTTY=$S($P(QAN742(0),U,5)=1:"IN",$P(QAN742(0),U,5)=0:"OUT",1:"") Q:QANPTTY']""
I '$D(ARRAY(QANINAM,QANPTTY)) S ARRAY(QANINAM,QANPTTY)=1
E S ARRAY(QANINAM,QANPTTY)=ARRAY(QANINAM,QANPTTY)+1
S ^TMP($J,"XREF",QAN7424,QAN742)="" ;Setting xref node for data output.
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANQIP1 1349 printed Nov 22, 2024@17:10:10 Page 2
QANQIP1 ;HISC/GJC-Interface with QUIC, tracking IR V2.0 data. ;4/13/93 10:00
+1 ;;2.0;Incident Reporting;**18**;08/07/1992
+2 SET QANINCD(1)=$ORDER(^QA(742.1,"BUPPER","ASSAULT-PATIENT TO PATIENT",0))
+3 SET QANINCD(2)=$ORDER(^QA(742.1,"BUPPER","PATIENT ABUSE",0))
+4 IF QANINCD(1)=""!(QANINCD(2)="")
WRITE !?5,"Incident data incomplete, check the QA Incident file."
SET QANEXIT=1
QUIT
+5 FOR QAN=QANBDT:0
SET QAN=$ORDER(^QA(742.4,"BDT",QAN))
if QAN'>0!(QAN>QANEDT)
QUIT
FOR QAN7424=0:0
SET QAN7424=$ORDER(^QA(742.4,"BDT",QAN,QAN7424))
if QAN7424'>0
QUIT
DO EXTRCT1
+6 QUIT
EXTRCT1 ;Grab the appropriate data.
+1 SET QAN7424(0)=$GET(^QA(742.4,QAN7424,0))
if QAN7424(0)']""
QUIT
SET QANINCD=$PIECE(QAN7424(0),U,2)
+2 ;Deleted incident.
if $PIECE(QAN7424(0),U,8)=2
QUIT
+3 if QANINCD'=QANINCD(1)&(QANINCD'=QANINCD(2))
QUIT
+4 if QANINCD=QANINCD(2)&(+$PIECE(QAN7424(0),U,16)'=1)
QUIT
+5 SET QANINAM=$PIECE(^QA(742.1,QANINCD,0),U)
+6 SET QANINAM=$SELECT(QANINAM="Assault-Patient to Patient":"PATIENT ASSAULT",1:"PATIENT ABUSE")
+7 FOR QAN742=0:0
SET QAN742=$ORDER(^QA(742,"BCS",QAN7424,QAN742))
if QAN742'>0
QUIT
SET QAN742(0)=$GET(^QA(742,QAN742,0))
if QAN742(0)']""
QUIT
DO EXTRCT2
+8 QUIT
EXTRCT2 ;Total the data.
+1 SET QANPTTY=$SELECT($PIECE(QAN742(0),U,5)=1:"IN",$PIECE(QAN742(0),U,5)=0:"OUT",1:"")
if QANPTTY']""
QUIT
+2 IF '$DATA(ARRAY(QANINAM,QANPTTY))
SET ARRAY(QANINAM,QANPTTY)=1
+3 IF '$TEST
SET ARRAY(QANINAM,QANPTTY)=ARRAY(QANINAM,QANPTTY)+1
+4 ;Setting xref node for data output.
SET ^TMP($JOB,"XREF",QAN7424,QAN742)=""
+5 QUIT
