QANQUCK ;HISC/GJC-Initial sighting of an Incident for a QA person ; 10/29/03 10:34am
;;2.0;Incident Reporting;**1,9,14,27,26,28,29,32**;08/07/1992;Build 3
;
K QANLOCK
D NEWREC^QANCDNT
D DIV^QANCDNT
I $G(QANQFLG)=1 Q
S QANDEATH=$O(^QA(742.1,"BUPPER","DEATH",0)),QANSUI=$O(^QA(742.1,"BUPPER","SUICIDE",0)),QANHOMCD=$O(^QA(742.1,"BUPPER","HOMICIDE",0))
S QANPTAB=$O(^QA(742.1,"BUPPER","PATIENT ABUSE",0))
S DIE="^QA(742.4,",DA=QANIEN,DR="[QAN QUICK EDIT]" D ^DIE K DIE,DR I $D(Y) D DEL D:QANXIT KILL Q
S QANLTTR=$P(^QA(742.4,QANIEN,0),U,2)
S QANST=$P(^QA(742.4,QANIEN,0),U,2) I "12"[$P(^QA(742.1,QANST,0),U,2) S $P(^QA(742.4,QANIEN,0),U,9)=DT,QAQADICT=742.4,QAQAFLD=".1",X=DT D ENSET^QAQAXREF
K QAUDIT S QAUDIT("FILE")="742.4^50",QAUDIT("DA")=QANIEN,QAUDIT("ACTION")="o",QAUDIT("COMMENT")="Open an incident record" D ^QAQAUDIT
S DIE="^QA(742.4,",DR=".09///"_3,DA=QANIEN D ^DIE ; Set 'Local Case' flag to brief.
;Get the patient.
K ^UTILITY($J,"QAN PAT") F D PAT Q:QANXIT!(QANOUT)
L -^QA(742.4,QANIEN) ;unlock record - it was locked in NEWREC^QANCDNT
KILL K D0,DA,QANADMDT,QANAGE,QANAME,QANCHK,QANCODE,QANDFN,QANDOB,QANDT,QANDUZ
K QANFLAG,QANHOMCD,QANHOME,QANIEN,QANINCR,QANINPAT,QANLTTR,QANOUT
K QANPTAB,QANPID,QANPIEN,QANPSDO,QANSSN,QANSUI,QANDEATH,QANST,QANST1
K QANTRSP,QANTTL,QANWARD,QANXIT,QANZERO,QAQADICT,QAQAFLD,QUES,VAERR,X
K QANPRS,X1,X2,Y,QANCODE,QANBFLG
Q
DEL ;
K DIK S DIK="^QA(742.4,",DA=QANIEN W !!,$C(7),"Insufficient data entered for an incident, deleting!!" D ^DIK K DA,DIK S QANXIT=1
Q
PAT ;Patient data.
K DIC S DIC="^DPT(",DIC(0)="QEAMNZ",DIC("A")="Select Patient: ",DIC("W")="W "" "",$P(^(0),U,9)",D="B^BS5"
D MIX^DIC1 K DIC S:+Y<1&(QANFLAG) QANOUT=1
D:+Y<1&('QANFLAG) DEL^QANCDNT Q:QANXIT!(QANOUT)
F D Q:"-12"[%
. W !?5,$G(Y(0,0))_" OK?"
. S %=1 D YN^DICN Q:"-12"[%
. W " Confirm that this is the correct patient."
D:%=-1&('QANFLAG) DEL^QANQUCK Q:QANXIT!(QANOUT)
I %=-1,(QANFLAG) S QANXIT=1 Q
I %=2 W " ??" G PAT
D PRIOR^QANCDNT I QANXIT D Q
. I 'QANFLAG K DA,DIK S DA=QANIEN,DIK="^QA(742.4," D ^DIK K DA,DIK
I $D(^UTILITY($J,"QAN PAT",+Y)) W !!,$C(7),$P(^DPT(+Y,0),U)_" has been previously entered for this incident." K Y G PAT
I $D(^DPT(+Y,.35)),$P(^DPT(+Y,.35),U)]"",($P(^DPT(+Y,.35),U)<$P(^QA(742.4,QANIEN,0),U,3)) W !!,$C(7),"The date of death for patient: "_$P(^DPT(+Y,0),U)_" precedes the incident date." K Y G PAT
S QANPIEN=+Y,QANZERO=Y(0),QANAME=Y(0,0),QANSSN=$P(QANZERO,U,9),^UTILITY($J,"QAN PAT",+Y)=""
S QANDOB=$P(^DPT(QANPIEN,0),U,3)
I QANDOB]"" S X=DT,X1=X,X2=QANDOB,X="" D:X2 ^%DTC S X=X\365.25,QANAGE=X
S QANPSDO(0)=Y(0),QANPSDO(0,0)=Y(0,0)
S QANPID=$$QANPID^QANCDNT(.Y)
D ADMDT^QANUTL1
;L +^QA(742):10 I '$T W !!,"Another user is editing this file." Q
K DIC,DD,DO,DINUM,DLAYGO S DLAYGO=742,DIC="^QA(742,",DIC(0)="L",X=QANPIEN D FILE^DICN K DIC,DD,DO,DINUM,DLAYGO
I +Y=-1,('QANFLAG) D DEL Q
I +Y=-1,(QANFLAG) S QANXIT=1 Q ;Something is wrong, exit.
S QANDFN=+Y
;L -^QA(742)
L +^QA(742,QANDFN):10 I '$T W !!,"Another user is editing this patient incident." Q
S $P(^QA(742,QANDFN,0),U,2,6)=QANPID_U_QANIEN_U_QANADMDT_U_QANINPAT_U_QANWARD
S $P(^QA(742,QANDFN,0),U,7)=QANTRSP,$P(^QA(742,QANDFN,0),U,12)=1
S DIK="^QA(742,",DA=QANDFN D IX1^DIK K DA,DIK
I (QANSUI=QANLTTR)!(QANDEATH=QANLTTR)!(QANHOMCD=QANLTTR) K DA,DIE,DR S DIE="^QA(742,",DA=QANDFN,DR=".1///^S X=3" D ^DIE K DA,DIE,DR
I (QANSUI'=QANLTTR),(QANDEATH'=QANLTTR),(QANHOMCD'=QANLTTR) K DA,DIE,DR S DIE="^QA(742,",DR=".1",DA=QANDFN D ^DIE K DA,DIE,DR
L -^QA(742,QANDFN)
S QANFLAG=1
K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANDFN,QAUDIT("ACTION")="o",QAUDIT("COMMENT")="Open a patient record" D ^QAQAUDIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANQUCK 3731 printed Dec 13, 2024@02:00:05 Page 2
QANQUCK ;HISC/GJC-Initial sighting of an Incident for a QA person ; 10/29/03 10:34am
+1 ;;2.0;Incident Reporting;**1,9,14,27,26,28,29,32**;08/07/1992;Build 3
+2 ;
+3 KILL QANLOCK
+4 DO NEWREC^QANCDNT
+5 DO DIV^QANCDNT
+6 IF $GET(QANQFLG)=1
QUIT
+7 SET QANDEATH=$ORDER(^QA(742.1,"BUPPER","DEATH",0))
SET QANSUI=$ORDER(^QA(742.1,"BUPPER","SUICIDE",0))
SET QANHOMCD=$ORDER(^QA(742.1,"BUPPER","HOMICIDE",0))
+8 SET QANPTAB=$ORDER(^QA(742.1,"BUPPER","PATIENT ABUSE",0))
+9 SET DIE="^QA(742.4,"
SET DA=QANIEN
SET DR="[QAN QUICK EDIT]"
DO ^DIE
KILL DIE,DR
IF $DATA(Y)
DO DEL
if QANXIT
DO KILL
QUIT
+10 SET QANLTTR=$PIECE(^QA(742.4,QANIEN,0),U,2)
+11 SET QANST=$PIECE(^QA(742.4,QANIEN,0),U,2)
IF "12"[$PIECE(^QA(742.1,QANST,0),U,2)
SET $PIECE(^QA(742.4,QANIEN,0),U,9)=DT
SET QAQADICT=742.4
SET QAQAFLD=".1"
SET X=DT
DO ENSET^QAQAXREF
+12 KILL QAUDIT
SET QAUDIT("FILE")="742.4^50"
SET QAUDIT("DA")=QANIEN
SET QAUDIT("ACTION")="o"
SET QAUDIT("COMMENT")="Open an incident record"
DO ^QAQAUDIT
+13 ; Set 'Local Case' flag to brief.
SET DIE="^QA(742.4,"
SET DR=".09///"_3
SET DA=QANIEN
DO ^DIE
+14 ;Get the patient.
+15 KILL ^UTILITY($JOB,"QAN PAT")
FOR
DO PAT
if QANXIT!(QANOUT)
QUIT
+16 ;unlock record - it was locked in NEWREC^QANCDNT
LOCK -^QA(742.4,QANIEN)
KILL KILL D0,DA,QANADMDT,QANAGE,QANAME,QANCHK,QANCODE,QANDFN,QANDOB,QANDT,QANDUZ
+1 KILL QANFLAG,QANHOMCD,QANHOME,QANIEN,QANINCR,QANINPAT,QANLTTR,QANOUT
+2 KILL QANPTAB,QANPID,QANPIEN,QANPSDO,QANSSN,QANSUI,QANDEATH,QANST,QANST1
+3 KILL QANTRSP,QANTTL,QANWARD,QANXIT,QANZERO,QAQADICT,QAQAFLD,QUES,VAERR,X
+4 KILL QANPRS,X1,X2,Y,QANCODE,QANBFLG
+5 QUIT
DEL ;
+1 KILL DIK
SET DIK="^QA(742.4,"
SET DA=QANIEN
WRITE !!,$CHAR(7),"Insufficient data entered for an incident, deleting!!"
DO ^DIK
KILL DA,DIK
SET QANXIT=1
+2 QUIT
PAT ;Patient data.
+1 KILL DIC
SET DIC="^DPT("
SET DIC(0)="QEAMNZ"
SET DIC("A")="Select Patient: "
SET DIC("W")="W "" "",$P(^(0),U,9)"
SET D="B^BS5"
+2 DO MIX^DIC1
KILL DIC
if +Y<1&(QANFLAG)
SET QANOUT=1
+3 if +Y<1&('QANFLAG)
DO DEL^QANCDNT
if QANXIT!(QANOUT)
QUIT
+4 FOR
Begin DoDot:1
+5 WRITE !?5,$GET(Y(0,0))_" OK?"
+6 SET %=1
DO YN^DICN
if "-12"[%
QUIT
+7 WRITE " Confirm that this is the correct patient."
End DoDot:1
if "-12"[%
QUIT
+8 if %=-1&('QANFLAG)
DO DEL^QANQUCK
if QANXIT!(QANOUT)
QUIT
+9 IF %=-1
IF (QANFLAG)
SET QANXIT=1
QUIT
+10 IF %=2
WRITE " ??"
GOTO PAT
+11 DO PRIOR^QANCDNT
IF QANXIT
Begin DoDot:1
+12 IF 'QANFLAG
KILL DA,DIK
SET DA=QANIEN
SET DIK="^QA(742.4,"
DO ^DIK
KILL DA,DIK
End DoDot:1
QUIT
+13 IF $DATA(^UTILITY($JOB,"QAN PAT",+Y))
WRITE !!,$CHAR(7),$PIECE(^DPT(+Y,0),U)_" has been previously entered for this incident."
KILL Y
GOTO PAT
+14 IF $DATA(^DPT(+Y,.35))
IF $PIECE(^DPT(+Y,.35),U)]""
IF ($PIECE(^DPT(+Y,.35),U)<$PIECE(^QA(742.4,QANIEN,0),U,3))
WRITE !!,$CHAR(7),"The date of death for patient: "_$PIECE(^DPT(+Y,0),U)_" precedes the incident date."
KILL Y
GOTO PAT
+15 SET QANPIEN=+Y
SET QANZERO=Y(0)
SET QANAME=Y(0,0)
SET QANSSN=$PIECE(QANZERO,U,9)
SET ^UTILITY($JOB,"QAN PAT",+Y)=""
+16 SET QANDOB=$PIECE(^DPT(QANPIEN,0),U,3)
+17 IF QANDOB]""
SET X=DT
SET X1=X
SET X2=QANDOB
SET X=""
if X2
DO ^%DTC
SET X=X\365.25
SET QANAGE=X
+18 SET QANPSDO(0)=Y(0)
SET QANPSDO(0,0)=Y(0,0)
+19 SET QANPID=$$QANPID^QANCDNT(.Y)
+20 DO ADMDT^QANUTL1
+21 ;L +^QA(742):10 I '$T W !!,"Another user is editing this file." Q
+22 KILL DIC,DD,DO,DINUM,DLAYGO
SET DLAYGO=742
SET DIC="^QA(742,"
SET DIC(0)="L"
SET X=QANPIEN
DO FILE^DICN
KILL DIC,DD,DO,DINUM,DLAYGO
+23 IF +Y=-1
IF ('QANFLAG)
DO DEL
QUIT
+24 ;Something is wrong, exit.
IF +Y=-1
IF (QANFLAG)
SET QANXIT=1
QUIT
+25 SET QANDFN=+Y
+26 ;L -^QA(742)
+27 LOCK +^QA(742,QANDFN):10
IF '$TEST
WRITE !!,"Another user is editing this patient incident."
QUIT
+28 SET $PIECE(^QA(742,QANDFN,0),U,2,6)=QANPID_U_QANIEN_U_QANADMDT_U_QANINPAT_U_QANWARD
+29 SET $PIECE(^QA(742,QANDFN,0),U,7)=QANTRSP
SET $PIECE(^QA(742,QANDFN,0),U,12)=1
+30 SET DIK="^QA(742,"
SET DA=QANDFN
DO IX1^DIK
KILL DA,DIK
+31 IF (QANSUI=QANLTTR)!(QANDEATH=QANLTTR)!(QANHOMCD=QANLTTR)
KILL DA,DIE,DR
SET DIE="^QA(742,"
SET DA=QANDFN
SET DR=".1///^S X=3"
DO ^DIE
KILL DA,DIE,DR
+32 IF (QANSUI'=QANLTTR)
IF (QANDEATH'=QANLTTR)
IF (QANHOMCD'=QANLTTR)
KILL DA,DIE,DR
SET DIE="^QA(742,"
SET DR=".1"
SET DA=QANDFN
DO ^DIE
KILL DA,DIE,DR
+33 LOCK -^QA(742,QANDFN)
+34 SET QANFLAG=1
+35 KILL QAUDIT
SET QAUDIT("FILE")="742^50"
SET QAUDIT("DA")=QANDFN
SET QAUDIT("ACTION")="o"
SET QAUDIT("COMMENT")="Open a patient record"
DO ^QAQAUDIT
+36 QUIT
