QANBENE ;HISC/GJC-Special incidents invol. a beneficiary ;3/3/92 [ 09/15/95 7:51 AM ]
;;2.0;Incident Reporting;**1,18,23,26,28**;08/07/1992
;
D KILL^QANBENE0,^QAQDATE I QAQQUIT D K^QAQDATE W !!,$C(7),"Invalid date range, no report will be produced." Q
S (PAGE,QANCONT,QANQUIT)=0
S Y=QAQNBEG D DD^%DT S QANDATE(0)=Y
S Y=QAQNEND D DD^%DT S QANDATE(1)=Y
S QANLWLT=QAQNBEG-.0000001,QANUPLT=QAQNEND_".9999999"
D DIV^QANRPT1
S QANSITE(0)=$S($G(^QA(740,1,0))]"":$P(^(0),U),1:"")
I QANSITE(0)']"" W !!,$C(7),"Site Parameters file incomplete, contact your site manager." D KILL^QANBENE0 Q
S QANSITE=$$PRIM^VASITE(DT),QANSITE=$$SITE^VASITE(DT,QANSITE)
S QANSITE(1)=$P(QANSITE,U,3)
S QANSITE=$P(QANSITE,U,2)
I $G(QANDVFLG)=1 S QANSITE=$$NAME^VASITE(DT)
S QANHEAD(0)="Summary of Incidents Involving Patients (RCS 10-0073)"
S QANHEAD(1)="For the period "_QANDATE(0)_" to "_QANDATE(1)
S QANHEAD(2)="Site Name: "_QANSITE_" FTS#:____________________"
;/*** SET UP TABS ***/
S QANTAB(1)=$J(((5/80)*IOM),2,0),QANTAB(2)=$J(((10/80)*IOM),2,0),QANTAB(3)=$J(((25/80)*IOM),2,0),QANTAB(4)=$J(((27/80)*IOM),2,0),QANTAB(5)=$J(((45/80)*IOM),2,0),QANTAB(6)=$J(((55/80)*IOM),2,0)
;/*** SET UP TABS ***/
;D DIV^QANRPT1
K DIR S DIR(0)="FAO^1:1^K:""BCO""'[X X",DIR("A")="Select Incident Status (B/C/O): ",DIR("?")="Enter ""O"" to select open cases, ""C"" for closed cases, or ""B"" for both open and closed cases" D ^DIR K DIR
I $D(DIRUT) D KILL^QANBENE0 Q
S QANFLG("IR STAT")=$S("B"[Y:"013","C"[Y:"0",1:"13") ;set IR Status flag
EN2 ;Call to ^QANBENE0
D EN1^QANBENE0
Q
VALID ;Validate as a reportable incident.
S QANSWCH=0
I $D(^QA(742.1,"BUPPER","PATIENT ABUSE",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","DEATH",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","INFORMED CONSENT-FAIL. TO OBTAIN",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","FALL",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","HOMICIDE",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","MEDICATION ERROR",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","MISSING PATIENT",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","ASSAULT-PATIENT TO PATIENT",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","INFORMED CONSENT, FAIL. TO OBTAIN",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","ASSAULT-PATIENT/STAFF",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","ASSAULT, PATIENT TO PATIENT",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","ASSAULT, PATIENT/STAFF",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","FIRE, PATIENT INVOLVED IN",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","INJURY NOT OTHERWISE LISTED",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","FIRE-PATIENT INVOLVED IN",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","SEXUAL ASSAULT",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","SUICIDE ATTEMPT",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","SUICIDE",QAN("INC"))) S QANSWCH=1 Q
I $D(^QA(742.1,"BUPPER","TRANSFUSION ERROR",QAN("INC"))) S QANSWCH=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANBENE 3076 printed Oct 16, 2024@18:00:16 Page 2
QANBENE ;HISC/GJC-Special incidents invol. a beneficiary ;3/3/92 [ 09/15/95 7:51 AM ]
+1 ;;2.0;Incident Reporting;**1,18,23,26,28**;08/07/1992
+2 ;
+3 DO KILL^QANBENE0
DO ^QAQDATE
IF QAQQUIT
DO K^QAQDATE
WRITE !!,$CHAR(7),"Invalid date range, no report will be produced."
QUIT
+4 SET (PAGE,QANCONT,QANQUIT)=0
+5 SET Y=QAQNBEG
DO DD^%DT
SET QANDATE(0)=Y
+6 SET Y=QAQNEND
DO DD^%DT
SET QANDATE(1)=Y
+7 SET QANLWLT=QAQNBEG-.0000001
SET QANUPLT=QAQNEND_".9999999"
+8 DO DIV^QANRPT1
+9 SET QANSITE(0)=$SELECT($GET(^QA(740,1,0))]"":$PIECE(^(0),U),1:"")
+10 IF QANSITE(0)']""
WRITE !!,$CHAR(7),"Site Parameters file incomplete, contact your site manager."
DO KILL^QANBENE0
QUIT
+11 SET QANSITE=$$PRIM^VASITE(DT)
SET QANSITE=$$SITE^VASITE(DT,QANSITE)
+12 SET QANSITE(1)=$PIECE(QANSITE,U,3)
+13 SET QANSITE=$PIECE(QANSITE,U,2)
+14 IF $GET(QANDVFLG)=1
SET QANSITE=$$NAME^VASITE(DT)
+15 SET QANHEAD(0)="Summary of Incidents Involving Patients (RCS 10-0073)"
+16 SET QANHEAD(1)="For the period "_QANDATE(0)_" to "_QANDATE(1)
+17 SET QANHEAD(2)="Site Name: "_QANSITE_" FTS#:____________________"
+18 ;/*** SET UP TABS ***/
+19 SET QANTAB(1)=$JUSTIFY(((5/80)*IOM),2,0)
SET QANTAB(2)=$JUSTIFY(((10/80)*IOM),2,0)
SET QANTAB(3)=$JUSTIFY(((25/80)*IOM),2,0)
SET QANTAB(4)=$JUSTIFY(((27/80)*IOM),2,0)
SET QANTAB(5)=$JUSTIFY(((45/80)*IOM),2,0)
SET QANTAB(6)=$JUSTIFY(((55/80)*IOM),2,0)
+20 ;/*** SET UP TABS ***/
+21 ;D DIV^QANRPT1
+22 KILL DIR
SET DIR(0)="FAO^1:1^K:""BCO""'[X X"
SET DIR("A")="Select Incident Status (B/C/O): "
SET DIR("?")="Enter ""O"" to select open cases, ""C"" for closed cases, or ""B"" for both open and closed cases"
DO ^DIR
KILL DIR
+23 IF $DATA(DIRUT)
DO KILL^QANBENE0
QUIT
+24 ;set IR Status flag
SET QANFLG("IR STAT")=$SELECT("B"[Y:"013","C"[Y:"0",1:"13")
EN2 ;Call to ^QANBENE0
+1 DO EN1^QANBENE0
+2 QUIT
VALID ;Validate as a reportable incident.
+1 SET QANSWCH=0
+2 IF $DATA(^QA(742.1,"BUPPER","PATIENT ABUSE",QAN("INC")))
SET QANSWCH=1
QUIT
+3 IF $DATA(^QA(742.1,"BUPPER","DEATH",QAN("INC")))
SET QANSWCH=1
QUIT
+4 IF $DATA(^QA(742.1,"BUPPER","INFORMED CONSENT-FAIL. TO OBTAIN",QAN("INC")))
SET QANSWCH=1
QUIT
+5 IF $DATA(^QA(742.1,"BUPPER","FALL",QAN("INC")))
SET QANSWCH=1
QUIT
+6 IF $DATA(^QA(742.1,"BUPPER","HOMICIDE",QAN("INC")))
SET QANSWCH=1
QUIT
+7 IF $DATA(^QA(742.1,"BUPPER","MEDICATION ERROR",QAN("INC")))
SET QANSWCH=1
QUIT
+8 IF $DATA(^QA(742.1,"BUPPER","MISSING PATIENT",QAN("INC")))
SET QANSWCH=1
QUIT
+9 IF $DATA(^QA(742.1,"BUPPER","ASSAULT-PATIENT TO PATIENT",QAN("INC")))
SET QANSWCH=1
QUIT
+10 IF $DATA(^QA(742.1,"BUPPER","INFORMED CONSENT, FAIL. TO OBTAIN",QAN("INC")))
SET QANSWCH=1
QUIT
+11 IF $DATA(^QA(742.1,"BUPPER","ASSAULT-PATIENT/STAFF",QAN("INC")))
SET QANSWCH=1
QUIT
+12 IF $DATA(^QA(742.1,"BUPPER","ASSAULT, PATIENT TO PATIENT",QAN("INC")))
SET QANSWCH=1
QUIT
+13 IF $DATA(^QA(742.1,"BUPPER","ASSAULT, PATIENT/STAFF",QAN("INC")))
SET QANSWCH=1
QUIT
+14 IF $DATA(^QA(742.1,"BUPPER","FIRE, PATIENT INVOLVED IN",QAN("INC")))
SET QANSWCH=1
QUIT
+15 IF $DATA(^QA(742.1,"BUPPER","INJURY NOT OTHERWISE LISTED",QAN("INC")))
SET QANSWCH=1
QUIT
+16 IF $DATA(^QA(742.1,"BUPPER","FIRE-PATIENT INVOLVED IN",QAN("INC")))
SET QANSWCH=1
QUIT
+17 IF $DATA(^QA(742.1,"BUPPER","SEXUAL ASSAULT",QAN("INC")))
SET QANSWCH=1
QUIT
+18 IF $DATA(^QA(742.1,"BUPPER","SUICIDE ATTEMPT",QAN("INC")))
SET QANSWCH=1
QUIT
+19 IF $DATA(^QA(742.1,"BUPPER","SUICIDE",QAN("INC")))
SET QANSWCH=1
QUIT
+20 IF $DATA(^QA(742.1,"BUPPER","TRANSFUSION ERROR",QAN("INC")))
SET QANSWCH=1
+21 QUIT
