QANBENE1 ;HISC/GJC-Special incidents invol. a beneficiary ;3/3/92
;;2.0;Incident Reporting;**1,8,11,18,26,28**;08/07/1992
;
EN1 ;Format of the print for our Beneficiary Report.
S QANWHICH=$S(QANFLG("WARD")="D":"Domiciliary",QANFLG("WARD")="NH":"NHCU",QANFLG("WARD")="I":"Inpatient",QANFLG("WARD")="O":"Outpatient",1:"total")
Q:QANQUIT
I '$D(^TMP("QANBEN",$J,"BEN")) D PRINT^QANBENE3 Q
Q:QANQUIT
S QANAA=""
F S QANAA=$O(^TMP("QANBEN",$J,"BEN",QANAA)) Q:QANAA']"" D
. S QANBB=""
. F S QANBB=$O(^TMP("QANBEN",$J,"BEN",QANAA,QANBB)) Q:QANBB']"" D
. . S QANLP(1)=0
. . F S QANLP(1)=$O(^TMP("QANBEN",$J,"BEN",QANAA,QANBB,QANLP(1))) Q:QANLP(1)'>0 D INC
I '$D(^TMP("QANBEN",$J,"BEN")) W !!,"There exist zero (0) "_QANWHICH_" incidents for this date range."
D EN1^QANBENE2 ;Prints out the data.
Q
INC ;Checks for appropriate incident data.
K QANLBL S QAN7424=$G(^QA(742.4,QANLP(1),0)) Q:QAN7424']""
S QANINPT=$P(QAN7424,U,2),QANINVST=+$P(QAN7424,U,11)
I $D(^QA(742.1,"BUPPER","PATIENT ABUSE",QANINPT)) D PROVE Q
I $D(^QA(742.1,"BUPPER","DEATH",QANINPT)) D DEATH Q
I $D(^QA(742.1,"BUPPER","FALL",QANINPT)) S QANLBL="FALLS"
I $D(^QA(742.1,"BUPPER","INFORMED CONSENT-FAIL. TO OBTAIN",QANINPT)) S QANLBL="INFORMED"
I $D(^QA(742.1,"BUPPER","INFORMED CONSENT, FAIL. TO OBTAIN",QANINPT)) S QANLBL="INFORMED"
I $D(^QA(742.1,"BUPPER","HOMICIDE",QANINPT)) S QANLBL="HOMICIDE"
I $D(^QA(742.1,"BUPPER","MEDICATION ERROR",QANINPT)) S QANLBL="MED ERR"
I $D(^QA(742.1,"BUPPER","MISSING PATIENT",QANINPT)) S QANLBL="MISSING PAT"
I $D(^QA(742.1,"BUPPER","ASSAULT-PATIENT TO PATIENT",QANINPT)) S QANLBL="ASSAULT PAT/PAT"
I $D(^QA(742.1,"BUPPER","ASSAULT, PATIENT TO PATIENT",QANINPT)) S QANLBL="ASSAULT PAT/PAT"
I $D(^QA(742.1,"BUPPER","ASSAULT-PATIENT/STAFF",QANINPT)) S QANLBL="ASSAULT PAT/STAFF"
I $D(^QA(742.1,"BUPPER","ASSAULT, PATIENT/STAFF",QANINPT)) S QANLBL="ASSAULT PAT/STAFF"
I $D(^QA(742.1,"BUPPER","INJURY NOT OTHERWISE LISTED",QANINPT)) S QANLBL="OTHER"
I $D(^QA(742.1,"BUPPER","FIRE-PATIENT INVOLVED IN",QANINPT)) S QANLBL="FIRE"
I $D(^QA(742.1,"BUPPER","FIRE, PATIENT INVOLVED IN",QANINPT)) S QANLBL="FIRE"
I $D(^QA(742.1,"BUPPER","SEXUAL ASSAULT",QANINPT)) S QANLBL="SEX"
I $D(^QA(742.1,"BUPPER","SUICIDE ATTEMPT",QANINPT)) S QANLBL="SUI ATT"
I $D(^QA(742.1,"BUPPER","SUICIDE",QANINPT)) S QANLBL="SUICIDE"
I $D(^QA(742.1,"BUPPER","TRANSFUSION ERROR",QANINPT)) S QANLBL="TRANS ERR"
Q:$G(QANLBL)']"" ;Not a valid label
F QANLP(2)=0:0 S QANLP(2)=$O(^TMP("QANBEN",$J,"BEN",QANAA,QANBB,QANLP(1),QANLP(2))) Q:QANLP(2)'>0 D
. S QANSLEV=$P(^QA(742,QANLP(2),0),U,10) Q:$G(QANSLEV)']""
. I $G(QANLBL)]"" D TALLY^QANBENE0
I '$D(^TMP("QANBEN",$J,"BEN")) W !!,"There exist zero (0) incidents within this data range." Q
Q
DEATH ;Tracking Deaths.
F QANLP(2)=0:0 S QANLP(2)=$O(^TMP("QANBEN",$J,"BEN",QANAA,QANBB,QANLP(1),QANLP(2))) Q:QANLP(2)'>0 D
. S QANSLEV=$P(^QA(742,QANLP(2),0),U,10) Q:'$G(QANSLEV)
. D DEATH1
. Q:$G(QANDTH)']""
. D:$G(QANLBL)]"" TALLY^QANBENE0
Q
DEATH1 ;Tracking Deaths.
S QANDTH=$P(QAN7424,U,14) Q:QANDTH']""
Q:$D(^QA(742.14,"BUPPER","OTHER",QANDTH))
Q:$D(^QA(742.14,"BUPPER","WITHIN 24 HOURS OF ADMISSION (EX. DOA'S AND TERMINALS)",QANDTH))
I $D(^QA(742.14,"BUPPER","CONJUNCTION WITH A PROCEDURE",QANDTH)) S QANLBL="DEATH-CON"
I $D(^QA(742.14,"BUPPER","DURING INDUCTION OF ANES.",QANDTH)) S QANLBL="DEATH-ANESTH"
I $D(^QA(742.14,"BUPPER","FAILURE TO DIAGNOSE OR TREAT",QANDTH)) S QANLBL="DEATH-FAIL"
I $D(^QA(742.14,"BUPPER","ON MEDICAL CENTER GROUNDS",QANDTH)) S QANLBL="DEATH-MED CEN"
I $D(^QA(742.14,"BUPPER","OPERATING ROOM",QANDTH)) S QANLBL="DEATH-OR"
I $D(^QA(742.14,"BUPPER","RECOVERY ROOM",QANDTH)) S QANLBL="DEATH-RR"
I $D(^QA(742.14,"BUPPER","CASES ACCEPTED BY M.E.",QANDTH)) S QANLBL="DEATH-M.E."
I $D(^QA(742.14,"BUPPER","EQUIPMENT MALFUNCTION",QANDTH)) S QANLBL="DEATH-EQ"
I $D(^QA(742.14,"BUPPER","WITHIN 48 HOURS OF SURGERY",QANDTH)) S QANLBL="DEATH-48"
Q
PROVE ;Sets Patient Abuse Array.
S QANAB=+$P(QAN7424,U,16),QANLBL=$S(QANAB=1:"PATIENT ABUSE/PROVEN",1:"PATIENT ABUSE/ALLEGED")
F QANLP(2)=0:0 S QANLP(2)=$O(^TMP("QANBEN",$J,"BEN",QANAA,QANBB,QANLP(1),QANLP(2))) Q:QANLP(2)'>0 D
. S QANSLEV=$P(^QA(742,QANLP(2),0),U,10)
. Q:$G(QANLBL)']""!('$G(QANSLEV))
. D TALLY^QANBENE0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANBENE1 4344 printed Dec 13, 2024@01:59:33 Page 2
QANBENE1 ;HISC/GJC-Special incidents invol. a beneficiary ;3/3/92
+1 ;;2.0;Incident Reporting;**1,8,11,18,26,28**;08/07/1992
+2 ;
EN1 ;Format of the print for our Beneficiary Report.
+1 SET QANWHICH=$SELECT(QANFLG("WARD")="D":"Domiciliary",QANFLG("WARD")="NH":"NHCU",QANFLG("WARD")="I":"Inpatient",QANFLG("WARD")="O":"Outpatient",1:"total")
+2 if QANQUIT
QUIT
+3 IF '$DATA(^TMP("QANBEN",$JOB,"BEN"))
DO PRINT^QANBENE3
QUIT
+4 if QANQUIT
QUIT
+5 SET QANAA=""
+6 FOR
SET QANAA=$ORDER(^TMP("QANBEN",$JOB,"BEN",QANAA))
if QANAA']""
QUIT
Begin DoDot:1
+7 SET QANBB=""
+8 FOR
SET QANBB=$ORDER(^TMP("QANBEN",$JOB,"BEN",QANAA,QANBB))
if QANBB']""
QUIT
Begin DoDot:2
+9 SET QANLP(1)=0
+10 FOR
SET QANLP(1)=$ORDER(^TMP("QANBEN",$JOB,"BEN",QANAA,QANBB,QANLP(1)))
if QANLP(1)'>0
QUIT
DO INC
End DoDot:2
End DoDot:1
+11 IF '$DATA(^TMP("QANBEN",$JOB,"BEN"))
WRITE !!,"There exist zero (0) "_QANWHICH_" incidents for this date range."
+12 ;Prints out the data.
DO EN1^QANBENE2
+13 QUIT
INC ;Checks for appropriate incident data.
+1 KILL QANLBL
SET QAN7424=$GET(^QA(742.4,QANLP(1),0))
if QAN7424']""
QUIT
+2 SET QANINPT=$PIECE(QAN7424,U,2)
SET QANINVST=+$PIECE(QAN7424,U,11)
+3 IF $DATA(^QA(742.1,"BUPPER","PATIENT ABUSE",QANINPT))
DO PROVE
QUIT
+4 IF $DATA(^QA(742.1,"BUPPER","DEATH",QANINPT))
DO DEATH
QUIT
+5 IF $DATA(^QA(742.1,"BUPPER","FALL",QANINPT))
SET QANLBL="FALLS"
+6 IF $DATA(^QA(742.1,"BUPPER","INFORMED CONSENT-FAIL. TO OBTAIN",QANINPT))
SET QANLBL="INFORMED"
+7 IF $DATA(^QA(742.1,"BUPPER","INFORMED CONSENT, FAIL. TO OBTAIN",QANINPT))
SET QANLBL="INFORMED"
+8 IF $DATA(^QA(742.1,"BUPPER","HOMICIDE",QANINPT))
SET QANLBL="HOMICIDE"
+9 IF $DATA(^QA(742.1,"BUPPER","MEDICATION ERROR",QANINPT))
SET QANLBL="MED ERR"
+10 IF $DATA(^QA(742.1,"BUPPER","MISSING PATIENT",QANINPT))
SET QANLBL="MISSING PAT"
+11 IF $DATA(^QA(742.1,"BUPPER","ASSAULT-PATIENT TO PATIENT",QANINPT))
SET QANLBL="ASSAULT PAT/PAT"
+12 IF $DATA(^QA(742.1,"BUPPER","ASSAULT, PATIENT TO PATIENT",QANINPT))
SET QANLBL="ASSAULT PAT/PAT"
+13 IF $DATA(^QA(742.1,"BUPPER","ASSAULT-PATIENT/STAFF",QANINPT))
SET QANLBL="ASSAULT PAT/STAFF"
+14 IF $DATA(^QA(742.1,"BUPPER","ASSAULT, PATIENT/STAFF",QANINPT))
SET QANLBL="ASSAULT PAT/STAFF"
+15 IF $DATA(^QA(742.1,"BUPPER","INJURY NOT OTHERWISE LISTED",QANINPT))
SET QANLBL="OTHER"
+16 IF $DATA(^QA(742.1,"BUPPER","FIRE-PATIENT INVOLVED IN",QANINPT))
SET QANLBL="FIRE"
+17 IF $DATA(^QA(742.1,"BUPPER","FIRE, PATIENT INVOLVED IN",QANINPT))
SET QANLBL="FIRE"
+18 IF $DATA(^QA(742.1,"BUPPER","SEXUAL ASSAULT",QANINPT))
SET QANLBL="SEX"
+19 IF $DATA(^QA(742.1,"BUPPER","SUICIDE ATTEMPT",QANINPT))
SET QANLBL="SUI ATT"
+20 IF $DATA(^QA(742.1,"BUPPER","SUICIDE",QANINPT))
SET QANLBL="SUICIDE"
+21 IF $DATA(^QA(742.1,"BUPPER","TRANSFUSION ERROR",QANINPT))
SET QANLBL="TRANS ERR"
+22 ;Not a valid label
if $GET(QANLBL)']""
QUIT
+23 FOR QANLP(2)=0:0
SET QANLP(2)=$ORDER(^TMP("QANBEN",$JOB,"BEN",QANAA,QANBB,QANLP(1),QANLP(2)))
if QANLP(2)'>0
QUIT
Begin DoDot:1
+24 SET QANSLEV=$PIECE(^QA(742,QANLP(2),0),U,10)
if $GET(QANSLEV)']""
QUIT
+25 IF $GET(QANLBL)]""
DO TALLY^QANBENE0
End DoDot:1
+26 IF '$DATA(^TMP("QANBEN",$JOB,"BEN"))
WRITE !!,"There exist zero (0) incidents within this data range."
QUIT
+27 QUIT
DEATH ;Tracking Deaths.
+1 FOR QANLP(2)=0:0
SET QANLP(2)=$ORDER(^TMP("QANBEN",$JOB,"BEN",QANAA,QANBB,QANLP(1),QANLP(2)))
if QANLP(2)'>0
QUIT
Begin DoDot:1
+2 SET QANSLEV=$PIECE(^QA(742,QANLP(2),0),U,10)
if '$GET(QANSLEV)
QUIT
+3 DO DEATH1
+4 if $GET(QANDTH)']""
QUIT
+5 if $GET(QANLBL)]""
DO TALLY^QANBENE0
End DoDot:1
+6 QUIT
DEATH1 ;Tracking Deaths.
+1 SET QANDTH=$PIECE(QAN7424,U,14)
if QANDTH']""
QUIT
+2 if $DATA(^QA(742.14,"BUPPER","OTHER",QANDTH))
QUIT
+3 if $DATA(^QA(742.14,"BUPPER","WITHIN 24 HOURS OF ADMISSION (EX. DOA'S AND TERMINALS)",QANDTH))
QUIT
+4 IF $DATA(^QA(742.14,"BUPPER","CONJUNCTION WITH A PROCEDURE",QANDTH))
SET QANLBL="DEATH-CON"
+5 IF $DATA(^QA(742.14,"BUPPER","DURING INDUCTION OF ANES.",QANDTH))
SET QANLBL="DEATH-ANESTH"
+6 IF $DATA(^QA(742.14,"BUPPER","FAILURE TO DIAGNOSE OR TREAT",QANDTH))
SET QANLBL="DEATH-FAIL"
+7 IF $DATA(^QA(742.14,"BUPPER","ON MEDICAL CENTER GROUNDS",QANDTH))
SET QANLBL="DEATH-MED CEN"
+8 IF $DATA(^QA(742.14,"BUPPER","OPERATING ROOM",QANDTH))
SET QANLBL="DEATH-OR"
+9 IF $DATA(^QA(742.14,"BUPPER","RECOVERY ROOM",QANDTH))
SET QANLBL="DEATH-RR"
+10 IF $DATA(^QA(742.14,"BUPPER","CASES ACCEPTED BY M.E.",QANDTH))
SET QANLBL="DEATH-M.E."
+11 IF $DATA(^QA(742.14,"BUPPER","EQUIPMENT MALFUNCTION",QANDTH))
SET QANLBL="DEATH-EQ"
+12 IF $DATA(^QA(742.14,"BUPPER","WITHIN 48 HOURS OF SURGERY",QANDTH))
SET QANLBL="DEATH-48"
+13 QUIT
PROVE ;Sets Patient Abuse Array.
+1 SET QANAB=+$PIECE(QAN7424,U,16)
SET QANLBL=$SELECT(QANAB=1:"PATIENT ABUSE/PROVEN",1:"PATIENT ABUSE/ALLEGED")
+2 FOR QANLP(2)=0:0
SET QANLP(2)=$ORDER(^TMP("QANBEN",$JOB,"BEN",QANAA,QANBB,QANLP(1),QANLP(2)))
if QANLP(2)'>0
QUIT
Begin DoDot:1
+3 SET QANSLEV=$PIECE(^QA(742,QANLP(2),0),U,10)
+4 if $GET(QANLBL)']""!('$GET(QANSLEV))
QUIT
+5 DO TALLY^QANBENE0
End DoDot:1
+6 QUIT
