194 lines
8.9 KiB
Mathematica
194 lines
8.9 KiB
Mathematica
QANCDNT ;HISC/GJC-Initial sighting of an incident ; 10/29/03 10:39am
|
|
;;2.0;Incident Reporting;**1,9,14,27,26,28,29,30,32**;08/07/1992;Build 3
|
|
;
|
|
;
|
|
N QANQFLG
|
|
D NEWREC ;I $G(QANLOCK)=1 L -^QA(742.4) S QANLOCK=0 Q
|
|
D DIV
|
|
I $G(QANQFLG)=1 D DEL Q
|
|
D DIE
|
|
Q
|
|
NEWREC ;create new record number
|
|
;record number will be in the format XXX.YYnnnn where XXX is the
|
|
;three digit station number, YY is the 2 digit year and nnnn is
|
|
;the sequence number (and is also the IEN of file 742.4)
|
|
N EE,QANCNT,QANLIST,QANNO,QANQFLG
|
|
K QANLOCK
|
|
S (QANFLAG,QANXIT,QANOUT)=0,QANST=$S($D(^QA(740,1,0))#2:$P(^(0),"^"),1:""),QANST1=$S($D(^DIC(4,QANST,99))#2:$P(^(99),"^"),1:QANST)
|
|
S QANDUZ=$S($D(DUZ):DUZ,1:""),QANTTL=$P(^VA(200,QANDUZ,0),U,9)
|
|
;set QANDT variable as "." concatonated with 2 digit year so that
|
|
;years 2000-2009 don't have leading zeroes.
|
|
S QANDT=$S($D(DT):$E(DT,2,3),1:""),QANDT="."_QANDT
|
|
S QANINCR=+$P($G(^QA(742.4,0)),U,3)+1 ;Grab the new IEN
|
|
F Q:$D(^QA(742.4,QANINCR,0))=0 S QANINCR=QANINCR+1
|
|
S QANCODE(0)=QANDT_QANINCR
|
|
I $L(QANINCR)<4 S QANCODE(0)=QANDT_$E("000",1,(4-$L(QANINCR)))_QANINCR
|
|
S QANCODE(1)=QANST1_QANCODE(0)
|
|
S QANCHK=$O(^QA(742.4,"B",QANCODE(1),0)) I +QANCHK,$D(^(QANCHK))#2 D Q
|
|
. W !!,$C(7),"CASE NUMBER VIOLATION, CONTACT YOUR QA COORDINATOR!!"
|
|
. S QANXIT=1
|
|
. K QANST,QANST1,QANDT,QANCODE,QANINCR,QANFLAG,QANOUT,QANDUZ,QANCHK,QANTTL
|
|
I $G(QANXIT)=1 Q
|
|
K DIC,DD,DO,DLAYGO,DINUM S (DIC,DIE)="^QA(742.4,",DIC(0)="L",X=QANCODE(1)
|
|
D FILE^DICN
|
|
K DIC,DD,DO,DLAYGO,DINUM
|
|
L +^QA(742.4,+Y):3 I '$T W !!,"Another user is editing this incident." S QANLOCK=1 Q
|
|
S QANBFLG=1 ;set brief flag so that if this subroutine was called
|
|
;from full incident edit you do not re-lock the record when you
|
|
;get back to full incident edit.
|
|
Q:+Y<1 S QANIEN=+Y
|
|
S QANHOME=$G(^QA(742.4,QANIEN,0)),$P(QANHOME,U,5)=QANDUZ,$P(QANHOME,U,6)=QANTTL,$P(QANHOME,U,15)=1,$P(QANHOME,U,8)=1
|
|
K DA,DIK S DIK="^QA(742.4,",DA=QANIEN,^QA(742.4,QANIEN,0)=QANHOME D IX1^DIK K DA,DIK
|
|
Q
|
|
DIV ;check to see if station is multi-divisional for Incid Reporting. If
|
|
;so, and there are hosp locations in file 740 (node "QAN2") then
|
|
;prompt user for Division.
|
|
I $P($G(^QA(740,1,"QAN")),U,5)=1 S TEMPY=$G(Y) D S Y=$G(TEMPY)
|
|
. W !!,"DIVISION: "
|
|
. S QANCNT=0 S QANLIST="S EE=0 F S EE=$O(^QA(740,1,""QAN2"",EE)) Q:EE'>0 W !?5,EE,?10,$P(^DIC(4,$P(^QA(740,1,""QAN2"",EE,0),U),0),U) S QANCNT=QANCNT+1"
|
|
LIST . S QANCNT=0 X QANLIST
|
|
. I $G(QANCNT)<1 W !?5,"There are no divisions entered in your QA Site Parameter File (#704).",!?5,"Ask your IRM support person to edit this file. If your site"
|
|
. I $G(QANCNT)<1 W !?5,"is entered in file #740 as a MULTI-DIVISIONAL INCID REP FACILITY you need",!?5,"entries in the IR HOSPITAL DIVISION multiple."
|
|
. S DIR(0)="NA"
|
|
. S DIR("A")="Enter the number of your choice: "
|
|
. S DIR("?")="Choose the number of your division."
|
|
. S DIR("??")="^S X=QANCNT X QANLIST"
|
|
. D ^DIR
|
|
. I $G(Y)']""!($G(Y)="^") D
|
|
. . W !!?5,"You must enter a Division.",!
|
|
. . D ^DIR
|
|
. . I $G(Y)']""!($G(Y)="^") S QANQFLG=1 Q
|
|
. I $G(QANQFLG)=1 Q
|
|
. I '$G(^QA(740,1,"QAN2",+Y,0)) W !,"Enter the number of your choice." S QANCNT=0 G LIST
|
|
. S QANNO=+Y
|
|
. S DIE="^QA(742.4,",DR="52///^S X=$P(^DIC(4,+^QA(740,1,""QAN2"",QANNO,0),0),U)"
|
|
. S DA=QANIEN
|
|
. D ^DIE I $D(Y)>0 S QANCNT=0 G LIST
|
|
Q
|
|
DIE S DIE="^QA(742.4,",DA=QANIEN,DR="[QAN ENTER TIME]"
|
|
D ^DIE K DIE,DR I $D(Y) D DEL Q:QANXIT
|
|
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 ^UTILITY($J,"QAN PAT") F D PAT Q:QANXIT!(QANOUT) ;get the patient
|
|
Q:QANXIT
|
|
SC1 ;
|
|
K Y S DIE="^QA(742.4,",DA=QANIEN,DR=".05;@1;.08;S X=X" D ^DIE K DIE,DR I $D(Y) Q:QANXIT
|
|
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///"_1,DA=QANIEN D ^DIE ; Set 'Local Case' flag to open.
|
|
I $G(QANFFLG)<1 D DISP
|
|
I $G(QANFFLG)<0 L -^QA(742.4,QANIEN) ;if this subroutine has not
|
|
;been called from the full incident edit, then unlock incident report.
|
|
;D ^QANBRIF ;transmit message to local mail group
|
|
Q
|
|
DEL ;Delete incident.
|
|
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&($G(QANFLAG)) QANOUT=1
|
|
D:+Y<1&('$G(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&('$G(QANFLAG)) DEL^QANCDNT Q:QANXIT!(QANOUT)
|
|
I %=-1,($G(QANFLAG)) S QANXIT=1 Q
|
|
I %=2 W " ??" G PAT
|
|
D PRIOR I QANXIT D Q
|
|
. I '$G(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
|
|
I $G(QANXIT)!($G(QANOUT)) D DEL Q
|
|
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(.Y)
|
|
D ADMDT^QANUTL1
|
|
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,('$G(QANFLAG)) D DEL Q
|
|
I +Y=-1,($G(QANFLAG)) S QANXIT=1 Q ;Something is wrong, exit.
|
|
S QANDFN=+Y
|
|
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
|
|
L -^QA(742,QANDFN)
|
|
S QANFLAG=1 ;D:'$D(QANF) BULL^QANUTL3
|
|
K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANDFN,QAUDIT("ACTION")="o",QAUDIT("COMMENT")="Open a patient record" D ^QAQAUDIT
|
|
Q
|
|
PRIOR ;
|
|
S QANTST(1)=$G(^QA(742.4,QANIEN,0))
|
|
S QANTST("INC")=$P(QANTST(1),U,2),QANTST("DATE")=$P(QANTST(1),U,3)
|
|
F QAN99=0:0 S QAN99=$O(^QA(742,"AA",+Y,QAN99)) Q:QAN99'>0!(QANXIT) S QANPRS=+$O(^QA(742,"AA",+Y,QAN99,"")) I QANPRS>0,($P(^QA(742,QANPRS,0),U,12)'<0) S QANTST(2)=$G(^QA(742.4,QAN99,0)) D PRIOR1
|
|
K QAN99,QANPRS,QANTST
|
|
Q
|
|
PRIOR1 ;
|
|
I (QANTST("INC")=$P(QANTST(2),U,2)),(QANTST("DATE")=$P(QANTST(2),U,3)) D
|
|
. W !!,$C(7),"Patient "_$P(^DPT(+Y,0),U)_" has a duplicate incident on record."
|
|
. W:'$G(QANFLAG) !,"Deleting the incident."
|
|
. S:'$G(QANFLAG) QANXIT=1
|
|
. W:$G(QANFLAG) !,"Please select new patient or press 'RETURN'!"
|
|
; . W:$G(QANFLAG) !,"Exiting!"
|
|
; . S QANXIT=1
|
|
Q
|
|
DISP ;display to user what has been entered and ask if it is okay
|
|
N QANCC,QANEE
|
|
W @IOF
|
|
S QAN74240=^QA(742.4,QANIEN,0)
|
|
W !!!,"Incident Report: "_$P(QAN74240,U)
|
|
S Y=$P(QAN74240,U,3) D DD^%DT
|
|
W ?35,"Date of Incident: "_Y
|
|
W !,"Patient: "
|
|
S QANCC=0 F S QANCC=$O(^QA(742,"BCS",QANIEN,QANCC)) Q:QANCC'>0 D
|
|
. W ?10,$P(^DPT($P(^QA(742,QANCC,0),U),0),U),!
|
|
W !,"Incident Type: "
|
|
I $P(QAN74240,U,2)]"" W $P(^QA(742.1,$P(QAN74240,U,2),0),U)
|
|
W !,"Incident Location: "
|
|
I $P(QAN74240,U,4)]"" W $P(^QA(742.5,$P(QAN74240,U,4),0),U)
|
|
W !,"Was the Incident Witnessed?: "_$S($P(QAN74240,U,7)=1:"Yes",$P(QAN74240,U,7)=0:"No",1:"")
|
|
W !,"Incident Description: "
|
|
S QANEE=0 F S QANEE=$O(^QA(742.4,QANIEN,1,QANEE)) Q:QANEE'>0 D
|
|
. W !?3,^QA(742.4,QANIEN,1,QANEE,0)
|
|
W !!
|
|
S DIR("A")="Is this information correct?"
|
|
S DIR("B")="Yes"
|
|
S DIR("?")="Enter 'Yes' or 'No'."
|
|
S DIR(0)="YAO"
|
|
S DIR("?",1)="Enter 'Yes' if the information displayed is correct."
|
|
S DIR("?",2)="Enter 'No' if you need to edit this information."
|
|
D ^DIR
|
|
GOEDIT ;
|
|
;if info is not right, use code from QANEDIT to edit just the fields
|
|
;in a brief incident. There must be at least one patient/report.
|
|
I Y=0 S QANOUT=0 D
|
|
. D DIE^QANEDIT
|
|
. I $O(^QA(742,"BCS",QANIEN,0))']"" D
|
|
. . W !!,"No patients on this Incident Report - deleting Report."
|
|
. . S DIK="^QA(742.4,",DA=QANIEN D ^DIK K DIK
|
|
. . ;also need to remove entry from QA Audit file (#740.5)
|
|
. . ;get most recent entry for 742 and 742.4 and if matches
|
|
. . ;this entry, delete
|
|
. . F QANFILE=742,742.4 D DIKAUDIT^QANEDIT(QANFILE) K QANFILE
|
|
I $G(^QA(742.4,QANIEN,0))]"" D
|
|
. D ^QANBRIF ;transmit message to local mail group
|
|
. S QANCC=0
|
|
. F S QANCC=$O(^QA(742,"BCS",QANIEN,QANCC)) Q:QANCC'>0 D
|
|
. . S QANPTNUM=$P(^QA(742,QANCC,0),U)
|
|
. . S QANODE=^DPT(QANPTNUM,0)
|
|
. . S QANAME=$P(QANODE,U)
|
|
. . S QANSSN=$P(QANODE,U,9)
|
|
. . D:'$D(QANF) BULL^QANUTL3
|
|
QANPID(Y) ;Function to set up Patient ID.
|
|
N QANF,QANM,QANL
|
|
S QANL=$P(Y(0,0),",")
|
|
I QANL[" " D
|
|
.S QANF=$E($P(Y(0,0),",",2))
|
|
.S QANM=$E($P(Y(0,0)," ",3))
|
|
.S QANPID=$G(QANF)_$G(QANM)_$E(QANL)_$E(QANSSN,6,9)
|
|
I QANL'[" " D
|
|
.S QANF=$E($P(Y(0,0),",",2))
|
|
.S QANM=$E($P(Y(0,0)," ",2))
|
|
.S QANPID=$G(QANF)_$G(QANM)_$E(QANL)_$E(QANSSN,6,9)
|
|
Q QANPID
|
|
Q
|