QANFULL0 ;HISC/GJC-Auto E-Mail for locally closed cases ;8/6/93 10:04
;;2.0;Incident Reporting;**1,13,18,20**;08/07/1992
;
EN1 ;Patient data
F QAN1=0:0 S QAN1=$O(^QA(742,"BCS",QAN0,QAN1)) Q:QAN1'>0 S QAN742=$G(^QA(742,QAN1,0)) S:QAN742]"" (QANOK,QANRSRV)=0 D:QAN742]"" PAT
Q
BULL ;Mail message
D KILL^XM
;S QANSERV="CEBELINSKI,G",QANDOM="SUP.QUA.ISC-CHICAGO.DOMAIN.EXT"
S XMY(QANSERV_"@"_QANDOM)="",XMDUZ=.5
S XMSUB="QAN Incident Event: "_^DD("SITE")_" ("_^DD("SITE",1)_")"
S XMTEXT="^UTILITY($J,""QAN MAIL""," D ^XMD,KILL^XM
Q
PAT ;Patient data
S QANSLEV=+$P(QAN742,U,10) D INCK Q:'QANOK
S (QANSRVCE,Y)=$P(QAN742,U,8),C=$P(^DD(742,.08,0),U,2) D:Y]"" Y^DIQ S QANSRVCE=$E(Y,1,35)
S QANINCR=QANINCR+1,QANQUIT=1
S (DFN,QANPAT)=$P(QAN742,U),QANDOB=$P(^DPT(DFN,0),U,3)
S ^UTILITY($J,"QAN PAT",QAN1)=$P(^DPT(QANPAT,0),U)
S:$D(^QA(742,QAN1,1,0)) QANRSRV=1
I +$P(QAN742,U,5) D
. S VAINDT=$G(QANDATE) D:VAINDT]"" INP^VADPT
. S QANADMIT=$P($G(VAIN(7)),U)
S ^UTILITY($J,"QAN SSN",QAN1)=$P(^DPT(QANPAT,0),U,9)
S ^UTILITY($J,"QAN MAIL",QANINCR)="FULL^"_$G(QANCASE)_"^INCD^"_$G(QANINCD)_"^"_$G(QANDATE)_"^"_$G(QANLVL)_"^"_$G(QANLRIN)_"^"_$G(QANLRCP)_"^"_$G(QANMLGP(0))_"^"_$G(VA1026)_"^"_$G(QANINLOC)_"^"_$G(QANPROV)_"^"
I QANDESC,$D(^UTILITY($J,"W",DIWL)) F QANY=0:0 S QANY=$O(^UTILITY($J,"W",DIWL,QANY)) Q:QANY'>0 S QANINCR=QANINCR+1,^UTILITY($J,"QAN MAIL",QANINCR)="FULL^"_QANCASE_"^DESC^"_^UTILITY($J,"W",DIWL,QANY,0)_"^"
I QANRSRV D
. S QAN=0
. F S QAN=$O(^QA(742,QAN1,1,QAN)) Q:QAN'>0 D
.. S QANRSRV("I")=$P($G(^QA(742,QAN1,1,QAN,0)),U)
.. Q:QANRSRV("I")']""
.. S QANRSRV("X")=$P($G(^ECC(730,QANRSRV("I"),0)),U)
.. S QANINCR=QANINCR+1
.. S ^UTILITY($J,"QAN MAIL",QANINCR)="FULL^"_$G(QANCASE)_"^RSRV^"_QANRSRV("X")_"^"
S QANINCR=QANINCR+1
S ^UTILITY($J,"QAN MAIL",QANINCR)="FULL^"_$G(QANCASE)_"^PAT^"_$G(^UTILITY($J,"QAN PAT",QAN1))_"^"_$G(^UTILITY($J,"QAN SSN",QAN1))_"^"_$G(QANSLEV)_"^"_$G(QANTYDTH)_"^"_$G(QANSRVCE)_"^"_$G(QANADMIT)_"^"_$G(QANDOB)_"^"
Q
INCK ;Check status of incident
I QANINCD="HOMICIDE" S QANOK=1
I QANINCD="DEATH" D
. S QANTYDTH=+$G(QANTYDTH)
. I '$D(^QA(742.14,"BUPPER","OTHER",QANTYDTH)),('$D(^QA(742.14,"BUPPER","WITHIN 24 HOURS OF ADMISSION (EX. DOA'S AND TERMINALS)",QANTYDTH))) S QANOK=1
I QANINCD="SUICIDE" S QANOK=1
I QANINCD="SEXUAL ASSAULT" S QANOK=1
I QANINCD="SUICIDE ATTEMPT" S QANOK=1
I QANINCD="INFORMED CONSENT-FAIL. TO OBTAIN" S QANOK=1
I QANINCD="PATIENT ABUSE" S QANOK=1
I QANINCD="INJURY NOT OTHERWISE LISTED",(QANSLEV'<2) S QANOK=1
I QANINCD="ASSAULT-PATIENT TO PATIENT",(QANSLEV'<2) S QANOK=1
I QANINCD="FIRE-PATIENT INVOLVED IN",(QANSLEV'<2) S QANOK=1
I QANINCD="ASSAULT-PATIENT/STAFF",(QANSLEV'<2) S QANOK=1
I QANINCD="FALL",(QANSLEV'<2) S QANOK=1
I QANINCD="MEDICATION ERROR",(QANSLEV'<2) S QANOK=1
I QANINCD="TRANSFUSION ERROR",(QANSLEV'<2) S QANOK=1
I QANINCD="MISSING PATIENT",(QANSLEV'<2) S QANOK=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANFULL0 2956 printed Dec 13, 2024@01:59:52 Page 2
QANFULL0 ;HISC/GJC-Auto E-Mail for locally closed cases ;8/6/93 10:04
+1 ;;2.0;Incident Reporting;**1,13,18,20**;08/07/1992
+2 ;
EN1 ;Patient data
+1 FOR QAN1=0:0
SET QAN1=$ORDER(^QA(742,"BCS",QAN0,QAN1))
if QAN1'>0
QUIT
SET QAN742=$GET(^QA(742,QAN1,0))
if QAN742]""
SET (QANOK,QANRSRV)=0
if QAN742]""
DO PAT
+2 QUIT
BULL ;Mail message
+1 DO KILL^XM
+2 ;S QANSERV="CEBELINSKI,G",QANDOM="SUP.QUA.ISC-CHICAGO.DOMAIN.EXT"
+3 SET XMY(QANSERV_"@"_QANDOM)=""
SET XMDUZ=.5
+4 SET XMSUB="QAN Incident Event: "_^DD("SITE")_" ("_^DD("SITE",1)_")"
+5 SET XMTEXT="^UTILITY($J,""QAN MAIL"","
DO ^XMD
DO KILL^XM
+6 QUIT
PAT ;Patient data
+1 SET QANSLEV=+$PIECE(QAN742,U,10)
DO INCK
if 'QANOK
QUIT
+2 SET (QANSRVCE,Y)=$PIECE(QAN742,U,8)
SET C=$PIECE(^DD(742,.08,0),U,2)
if Y]""
DO Y^DIQ
SET QANSRVCE=$EXTRACT(Y,1,35)
+3 SET QANINCR=QANINCR+1
SET QANQUIT=1
+4 SET (DFN,QANPAT)=$PIECE(QAN742,U)
SET QANDOB=$PIECE(^DPT(DFN,0),U,3)
+5 SET ^UTILITY($JOB,"QAN PAT",QAN1)=$PIECE(^DPT(QANPAT,0),U)
+6 if $DATA(^QA(742,QAN1,1,0))
SET QANRSRV=1
+7 IF +$PIECE(QAN742,U,5)
Begin DoDot:1
+8 SET VAINDT=$GET(QANDATE)
if VAINDT]""
DO INP^VADPT
+9 SET QANADMIT=$PIECE($GET(VAIN(7)),U)
End DoDot:1
+10 SET ^UTILITY($JOB,"QAN SSN",QAN1)=$PIECE(^DPT(QANPAT,0),U,9)
+11 SET ^UTILITY($JOB,"QAN MAIL",QANINCR)="FULL^"_$GET(QANCASE)_"^INCD^"_$GET(QANINCD)_"^"_$GET(QANDATE)_"^"_$GET(QANLVL)_"^"_$GET(QANLRIN)_"^"_$GET(QANLRCP)_"^"_$GET(QANMLGP(0))_"^"_$GET(VA1026)_"^"_$GET(QANINLOC)_"^"_$GET(QANPROV)_"^"
+12 IF QANDESC
IF $DATA(^UTILITY($JOB,"W",DIWL))
FOR QANY=0:0
SET QANY=$ORDER(^UTILITY($JOB,"W",DIWL,QANY))
if QANY'>0
QUIT
SET QANINCR=QANINCR+1
SET ^UTILITY($JOB,"QAN MAIL",QANINCR)="FULL^"_QANCASE_"^DESC^"_^UTILITY($JOB,"W",DIWL,QANY,0)_"^"
+13 IF QANRSRV
Begin DoDot:1
+14 SET QAN=0
+15 FOR
SET QAN=$ORDER(^QA(742,QAN1,1,QAN))
if QAN'>0
QUIT
Begin DoDot:2
+16 SET QANRSRV("I")=$PIECE($GET(^QA(742,QAN1,1,QAN,0)),U)
+17 if QANRSRV("I")']""
QUIT
+18 SET QANRSRV("X")=$PIECE($GET(^ECC(730,QANRSRV("I"),0)),U)
+19 SET QANINCR=QANINCR+1
+20 SET ^UTILITY($JOB,"QAN MAIL",QANINCR)="FULL^"_$GET(QANCASE)_"^RSRV^"_QANRSRV("X")_"^"
End DoDot:2
End DoDot:1
+21 SET QANINCR=QANINCR+1
+22 SET ^UTILITY($JOB,"QAN MAIL",QANINCR)="FULL^"_$GET(QANCASE)_"^PAT^"_$GET(^UTILITY($JOB,"QAN PAT",QAN1))_"^"_$GET(^UTILITY($JOB,"QAN SSN",QAN1))_"^"_$GET(QANSLEV)_"^"_$GET(QANTYDTH)_"^"_$GET(QANSRVCE)_"^"_$GET(QANADMIT)_"^"_$GET(QANDOB)_"^"
+23 QUIT
INCK ;Check status of incident
+1 IF QANINCD="HOMICIDE"
SET QANOK=1
+2 IF QANINCD="DEATH"
Begin DoDot:1
+3 SET QANTYDTH=+$GET(QANTYDTH)
+4 IF '$DATA(^QA(742.14,"BUPPER","OTHER",QANTYDTH))
IF ('$DATA(^QA(742.14,"BUPPER","WITHIN 24 HOURS OF ADMISSION (EX. DOA'S AND TERMINALS)",QANTYDTH)))
SET QANOK=1
End DoDot:1
+5 IF QANINCD="SUICIDE"
SET QANOK=1
+6 IF QANINCD="SEXUAL ASSAULT"
SET QANOK=1
+7 IF QANINCD="SUICIDE ATTEMPT"
SET QANOK=1
+8 IF QANINCD="INFORMED CONSENT-FAIL. TO OBTAIN"
SET QANOK=1
+9 IF QANINCD="PATIENT ABUSE"
SET QANOK=1
+10 IF QANINCD="INJURY NOT OTHERWISE LISTED"
IF (QANSLEV'<2)
SET QANOK=1
+11 IF QANINCD="ASSAULT-PATIENT TO PATIENT"
IF (QANSLEV'<2)
SET QANOK=1
+12 IF QANINCD="FIRE-PATIENT INVOLVED IN"
IF (QANSLEV'<2)
SET QANOK=1
+13 IF QANINCD="ASSAULT-PATIENT/STAFF"
IF (QANSLEV'<2)
SET QANOK=1
+14 IF QANINCD="FALL"
IF (QANSLEV'<2)
SET QANOK=1
+15 IF QANINCD="MEDICATION ERROR"
IF (QANSLEV'<2)
SET QANOK=1
+16 IF QANINCD="TRANSFUSION ERROR"
IF (QANSLEV'<2)
SET QANOK=1
+17 IF QANINCD="MISSING PATIENT"
IF (QANSLEV'<2)
SET QANOK=1
+18 QUIT
