QANQIP1.m

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 ---QANQIP1   1349     printed  Apr 09, 2024@21:01:48                                                                                                                                                                                                     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