QANUTL ;;HISC/GJC-Utilities for Incident Reporting ; 5/11/12 2:55pm
;;2.0;Incident Reporting;**1,3,32,33**;08/07/1992;Build 12
EN0 ;Sets up and builds the patients ID.
S QANDFN(0)=X,QANZERO(3)=^DPT(QANDFN(0),0),QANAME=$P(QANZERO(3),U),QANSSN=$P(QANZERO(3),U,9)
S QANPID=$$QANPID^QANCDNT(QANAME)
K QANDFN(0),QANZERO(3),QANAME,QANSSN
Q
EN1 ;Used for DIC("W") used in QANMAIL and QANVAL.
I QANTYPE=1 S QANTEMP=Y,Y=$P(^QA(742.4,+Y,0),U,3) X ^DD("DD") W " "_Y_" " S Y=QANTEMP Q:'$P(^QA(742.4,+Y,0),U,2) W $P(^QA(742.1,$P(^QA(742.4,+Y,0),U,2),0),U) K QANTEMP Q
I QANTYPE=2 Q:'$P(^QA(742.4,+Y,0),U,2) W " "_$P(^QA(742.1,$P(^QA(742.4,+Y,0),U,2),0),U) Q
I QANTYPE=4 S QANTEMP=Y,Y=$P(^QA(742.4,+QANTEMP,0),U,3) X ^DD("DD") W " "_Y S Y=QANTEMP K QANTEMP
Q
EN10 ;Medication Errors (Other).
K DIE,DR S DIE="^QA(742,",DR=".14",DA=QANDFN D ^DIE K DA,DR,DIE
Q
HOMCIDE ;Patient Abuse changed to Homicide.
W !!,*7,"Incident: Patient Abuse Severity Level: Death (3)"
W !,"Changed to Incident: Homicide Severity Level: Death (3)",!!,*7
K DA,DIE,DR
S DA=QANIEN,DIE="^QA(742.4,",DR=".02///"_$O(^QA(742.1,"BUPPER","HOMICIDE",0)) D ^DIE
K DA,DIE,DR
S:$G(QANIRIN)]"" QANIRIN=+$O(^QA(742.1,"BUPPER","HOMICIDE",0))
Q
SUIATMP ;Suicide Attempt changed to Suicide.
W !!,*7,"Incident: Suicide Attempt Severity Level: Death (3)"
W !,"Changed to Incident: Suicide Severity Level: Death (3)",!!,*7
K DA,DIE,DR
S DA=QANIEN,DIE="^QA(742.4,",DR=".02///"_$O(^QA(742.1,"BUPPER","SUICIDE",0)) D ^DIE
K DA,DIE,DR
S:$G(QANIRIN)]"" QANIRIN=+$O(^QA(742.1,"BUPPER","SUICIDE",0))
Q
ABUSE ;Abuse Message
I +$P(QANGLB1,U,10)=0 X MSSG1,MSSG2
E X MSSG0,MSSG1,MSSG2
Q
DEATH ;Special broadcasts for 'Death' cases.
S DTHQAN("DEATH CONJ PROC")=$O(^QA(742.14,"BUPPER","CONJUNCTION WITH A PROCEDURE",0))
S DTHQAN("DURING ANES.")=$O(^QA(742.14,"BUPPER","DURING INDUCTION OF ANES.",0))
S DTHQAN("DIAG/TREAT")=$O(^QA(742.14,"BUPPER","FAILURE TO DIAGNOSE OR TREAT",0))
S DTHQAN("MED CNTR GRNDS")=$O(^QA(742.14,"BUPPER","ON MEDICAL CENTER GROUNDS",0))
S DTHQAN("OR")=$O(^QA(742.14,"BUPPER","OPERATING ROOM",0))
S DTHQAN("RR")=$O(^QA(742.14,"BUPPER","RECOVERY ROOM",0))
S DTHQAN("EQUIPT")=$O(^QA(742.14,"BUPPER","EQUIPMENT MALFUNCTION",0))
S DTHQAN("48 HOURS")=$O(^QA(742.14,"BUPPER","WITHIN 48 HOURS OF SURGERY",0))
S DTHQAN("CASES M.E.")=$O(^QA(742.14,"BUPPER","CASES ACCEPTED BY M.E.",0))
I +$P(QANGLB2,U,14)=DTHQAN("CASES M.E.") X MSSG0,MSSG1
I +$P(QANGLB2,U,14)=DTHQAN("DEATH CONJ PROC") X MSSG1
I +$P(QANGLB2,U,14)=DTHQAN("DURING ANES.") X MSSG1
I +$P(QANGLB2,U,14)=DTHQAN("DIAG/TREAT") X MSSG1,MSSG2
I +$P(QANGLB2,U,14)=DTHQAN("MED CNTR GRNDS") X MSSG1
I +$P(QANGLB2,U,14)=DTHQAN("OR") X MSSG1
I +$P(QANGLB2,U,14)=DTHQAN("RR") X MSSG1
I +$P(QANGLB2,U,14)=DTHQAN("EQUIPT") X MSSG0,MSSG1,MSSG2
I +$P(QANGLB2,U,14)=DTHQAN("48 HOURS") X MSSG1
K DTHQAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANUTL 2910 printed Dec 13, 2024@02:00:09 Page 2
QANUTL ;;HISC/GJC-Utilities for Incident Reporting ; 5/11/12 2:55pm
+1 ;;2.0;Incident Reporting;**1,3,32,33**;08/07/1992;Build 12
EN0 ;Sets up and builds the patients ID.
+1 SET QANDFN(0)=X
SET QANZERO(3)=^DPT(QANDFN(0),0)
SET QANAME=$PIECE(QANZERO(3),U)
SET QANSSN=$PIECE(QANZERO(3),U,9)
+2 SET QANPID=$$QANPID^QANCDNT(QANAME)
+3 KILL QANDFN(0),QANZERO(3),QANAME,QANSSN
+4 QUIT
EN1 ;Used for DIC("W") used in QANMAIL and QANVAL.
+1 IF QANTYPE=1
SET QANTEMP=Y
SET Y=$PIECE(^QA(742.4,+Y,0),U,3)
XECUTE ^DD("DD")
WRITE " "_Y_" "
SET Y=QANTEMP
if '$PIECE(^QA(742.4,+Y,0),U,2)
QUIT
WRITE $PIECE(^QA(742.1,$PIECE(^QA(742.4,+Y,0),U,2),0),U)
KILL QANTEMP
QUIT
+2 IF QANTYPE=2
if '$PIECE(^QA(742.4,+Y,0),U,2)
QUIT
WRITE " "_$PIECE(^QA(742.1,$PIECE(^QA(742.4,+Y,0),U,2),0),U)
QUIT
+3 IF QANTYPE=4
SET QANTEMP=Y
SET Y=$PIECE(^QA(742.4,+QANTEMP,0),U,3)
XECUTE ^DD("DD")
WRITE " "_Y
SET Y=QANTEMP
KILL QANTEMP
+4 QUIT
EN10 ;Medication Errors (Other).
+1 KILL DIE,DR
SET DIE="^QA(742,"
SET DR=".14"
SET DA=QANDFN
DO ^DIE
KILL DA,DR,DIE
+2 QUIT
HOMCIDE ;Patient Abuse changed to Homicide.
+1 WRITE !!,*7,"Incident: Patient Abuse Severity Level: Death (3)"
+2 WRITE !,"Changed to Incident: Homicide Severity Level: Death (3)",!!,*7
+3 KILL DA,DIE,DR
+4 SET DA=QANIEN
SET DIE="^QA(742.4,"
SET DR=".02///"_$ORDER(^QA(742.1,"BUPPER","HOMICIDE",0))
DO ^DIE
+5 KILL DA,DIE,DR
+6 if $GET(QANIRIN)]""
SET QANIRIN=+$ORDER(^QA(742.1,"BUPPER","HOMICIDE",0))
+7 QUIT
SUIATMP ;Suicide Attempt changed to Suicide.
+1 WRITE !!,*7,"Incident: Suicide Attempt Severity Level: Death (3)"
+2 WRITE !,"Changed to Incident: Suicide Severity Level: Death (3)",!!,*7
+3 KILL DA,DIE,DR
+4 SET DA=QANIEN
SET DIE="^QA(742.4,"
SET DR=".02///"_$ORDER(^QA(742.1,"BUPPER","SUICIDE",0))
DO ^DIE
+5 KILL DA,DIE,DR
+6 if $GET(QANIRIN)]""
SET QANIRIN=+$ORDER(^QA(742.1,"BUPPER","SUICIDE",0))
+7 QUIT
ABUSE ;Abuse Message
+1 IF +$PIECE(QANGLB1,U,10)=0
XECUTE MSSG1
XECUTE MSSG2
+2 IF '$TEST
XECUTE MSSG0
XECUTE MSSG1
XECUTE MSSG2
+3 QUIT
DEATH ;Special broadcasts for 'Death' cases.
+1 SET DTHQAN("DEATH CONJ PROC")=$ORDER(^QA(742.14,"BUPPER","CONJUNCTION WITH A PROCEDURE",0))
+2 SET DTHQAN("DURING ANES.")=$ORDER(^QA(742.14,"BUPPER","DURING INDUCTION OF ANES.",0))
+3 SET DTHQAN("DIAG/TREAT")=$ORDER(^QA(742.14,"BUPPER","FAILURE TO DIAGNOSE OR TREAT",0))
+4 SET DTHQAN("MED CNTR GRNDS")=$ORDER(^QA(742.14,"BUPPER","ON MEDICAL CENTER GROUNDS",0))
+5 SET DTHQAN("OR")=$ORDER(^QA(742.14,"BUPPER","OPERATING ROOM",0))
+6 SET DTHQAN("RR")=$ORDER(^QA(742.14,"BUPPER","RECOVERY ROOM",0))
+7 SET DTHQAN("EQUIPT")=$ORDER(^QA(742.14,"BUPPER","EQUIPMENT MALFUNCTION",0))
+8 SET DTHQAN("48 HOURS")=$ORDER(^QA(742.14,"BUPPER","WITHIN 48 HOURS OF SURGERY",0))
+9 SET DTHQAN("CASES M.E.")=$ORDER(^QA(742.14,"BUPPER","CASES ACCEPTED BY M.E.",0))
+10 IF +$PIECE(QANGLB2,U,14)=DTHQAN("CASES M.E.")
XECUTE MSSG0
XECUTE MSSG1
+11 IF +$PIECE(QANGLB2,U,14)=DTHQAN("DEATH CONJ PROC")
XECUTE MSSG1
+12 IF +$PIECE(QANGLB2,U,14)=DTHQAN("DURING ANES.")
XECUTE MSSG1
+13 IF +$PIECE(QANGLB2,U,14)=DTHQAN("DIAG/TREAT")
XECUTE MSSG1
XECUTE MSSG2
+14 IF +$PIECE(QANGLB2,U,14)=DTHQAN("MED CNTR GRNDS")
XECUTE MSSG1
+15 IF +$PIECE(QANGLB2,U,14)=DTHQAN("OR")
XECUTE MSSG1
+16 IF +$PIECE(QANGLB2,U,14)=DTHQAN("RR")
XECUTE MSSG1
+17 IF +$PIECE(QANGLB2,U,14)=DTHQAN("EQUIPT")
XECUTE MSSG0
XECUTE MSSG1
XECUTE MSSG2
+18 IF +$PIECE(QANGLB2,U,14)=DTHQAN("48 HOURS")
XECUTE MSSG1
+19 KILL DTHQAN
+20 QUIT
