| 1 | QANCDNT ;HISC/GJC-Initial sighting of an incident ; 10/29/03 10:39am
|
|---|
| 2 | ;;2.0;Incident Reporting;**1,9,14,27,26,28,29,30,32**;08/07/1992;Build 3
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | N QANQFLG
|
|---|
| 6 | D NEWREC ;I $G(QANLOCK)=1 L -^QA(742.4) S QANLOCK=0 Q
|
|---|
| 7 | D DIV
|
|---|
| 8 | I $G(QANQFLG)=1 D DEL Q
|
|---|
| 9 | D DIE
|
|---|
| 10 | Q
|
|---|
| 11 | NEWREC ;create new record number
|
|---|
| 12 | ;record number will be in the format XXX.YYnnnn where XXX is the
|
|---|
| 13 | ;three digit station number, YY is the 2 digit year and nnnn is
|
|---|
| 14 | ;the sequence number (and is also the IEN of file 742.4)
|
|---|
| 15 | N EE,QANCNT,QANLIST,QANNO,QANQFLG
|
|---|
| 16 | K QANLOCK
|
|---|
| 17 | 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)
|
|---|
| 18 | S QANDUZ=$S($D(DUZ):DUZ,1:""),QANTTL=$P(^VA(200,QANDUZ,0),U,9)
|
|---|
| 19 | ;set QANDT variable as "." concatonated with 2 digit year so that
|
|---|
| 20 | ;years 2000-2009 don't have leading zeroes.
|
|---|
| 21 | S QANDT=$S($D(DT):$E(DT,2,3),1:""),QANDT="."_QANDT
|
|---|
| 22 | S QANINCR=+$P($G(^QA(742.4,0)),U,3)+1 ;Grab the new IEN
|
|---|
| 23 | F Q:$D(^QA(742.4,QANINCR,0))=0 S QANINCR=QANINCR+1
|
|---|
| 24 | S QANCODE(0)=QANDT_QANINCR
|
|---|
| 25 | I $L(QANINCR)<4 S QANCODE(0)=QANDT_$E("000",1,(4-$L(QANINCR)))_QANINCR
|
|---|
| 26 | S QANCODE(1)=QANST1_QANCODE(0)
|
|---|
| 27 | S QANCHK=$O(^QA(742.4,"B",QANCODE(1),0)) I +QANCHK,$D(^(QANCHK))#2 D Q
|
|---|
| 28 | . W !!,$C(7),"CASE NUMBER VIOLATION, CONTACT YOUR QA COORDINATOR!!"
|
|---|
| 29 | . S QANXIT=1
|
|---|
| 30 | . K QANST,QANST1,QANDT,QANCODE,QANINCR,QANFLAG,QANOUT,QANDUZ,QANCHK,QANTTL
|
|---|
| 31 | I $G(QANXIT)=1 Q
|
|---|
| 32 | K DIC,DD,DO,DLAYGO,DINUM S (DIC,DIE)="^QA(742.4,",DIC(0)="L",X=QANCODE(1)
|
|---|
| 33 | D FILE^DICN
|
|---|
| 34 | K DIC,DD,DO,DLAYGO,DINUM
|
|---|
| 35 | L +^QA(742.4,+Y):3 I '$T W !!,"Another user is editing this incident." S QANLOCK=1 Q
|
|---|
| 36 | S QANBFLG=1 ;set brief flag so that if this subroutine was called
|
|---|
| 37 | ;from full incident edit you do not re-lock the record when you
|
|---|
| 38 | ;get back to full incident edit.
|
|---|
| 39 | Q:+Y<1 S QANIEN=+Y
|
|---|
| 40 | 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
|
|---|
| 41 | K DA,DIK S DIK="^QA(742.4,",DA=QANIEN,^QA(742.4,QANIEN,0)=QANHOME D IX1^DIK K DA,DIK
|
|---|
| 42 | Q
|
|---|
| 43 | DIV ;check to see if station is multi-divisional for Incid Reporting. If
|
|---|
| 44 | ;so, and there are hosp locations in file 740 (node "QAN2") then
|
|---|
| 45 | ;prompt user for Division.
|
|---|
| 46 | I $P($G(^QA(740,1,"QAN")),U,5)=1 S TEMPY=$G(Y) D S Y=$G(TEMPY)
|
|---|
| 47 | . W !!,"DIVISION: "
|
|---|
| 48 | . 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"
|
|---|
| 49 | LIST . S QANCNT=0 X QANLIST
|
|---|
| 50 | . 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"
|
|---|
| 51 | . 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."
|
|---|
| 52 | . S DIR(0)="NA"
|
|---|
| 53 | . S DIR("A")="Enter the number of your choice: "
|
|---|
| 54 | . S DIR("?")="Choose the number of your division."
|
|---|
| 55 | . S DIR("??")="^S X=QANCNT X QANLIST"
|
|---|
| 56 | . D ^DIR
|
|---|
| 57 | . I $G(Y)']""!($G(Y)="^") D
|
|---|
| 58 | . . W !!?5,"You must enter a Division.",!
|
|---|
| 59 | . . D ^DIR
|
|---|
| 60 | . . I $G(Y)']""!($G(Y)="^") S QANQFLG=1 Q
|
|---|
| 61 | . I $G(QANQFLG)=1 Q
|
|---|
| 62 | . I '$G(^QA(740,1,"QAN2",+Y,0)) W !,"Enter the number of your choice." S QANCNT=0 G LIST
|
|---|
| 63 | . S QANNO=+Y
|
|---|
| 64 | . S DIE="^QA(742.4,",DR="52///^S X=$P(^DIC(4,+^QA(740,1,""QAN2"",QANNO,0),0),U)"
|
|---|
| 65 | . S DA=QANIEN
|
|---|
| 66 | . D ^DIE I $D(Y)>0 S QANCNT=0 G LIST
|
|---|
| 67 | Q
|
|---|
| 68 | DIE S DIE="^QA(742.4,",DA=QANIEN,DR="[QAN ENTER TIME]"
|
|---|
| 69 | D ^DIE K DIE,DR I $D(Y) D DEL Q:QANXIT
|
|---|
| 70 | 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
|
|---|
| 71 | K ^UTILITY($J,"QAN PAT") F D PAT Q:QANXIT!(QANOUT) ;get the patient
|
|---|
| 72 | Q:QANXIT
|
|---|
| 73 | SC1 ;
|
|---|
| 74 | 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
|
|---|
| 75 | K QAUDIT S QAUDIT("FILE")="742.4^50",QAUDIT("DA")=QANIEN,QAUDIT("ACTION")="o",QAUDIT("COMMENT")="Open an incident record" D ^QAQAUDIT
|
|---|
| 76 | S DIE="^QA(742.4,",DR=".09///"_1,DA=QANIEN D ^DIE ; Set 'Local Case' flag to open.
|
|---|
| 77 | I $G(QANFFLG)<1 D DISP
|
|---|
| 78 | I $G(QANFFLG)<0 L -^QA(742.4,QANIEN) ;if this subroutine has not
|
|---|
| 79 | ;been called from the full incident edit, then unlock incident report.
|
|---|
| 80 | ;D ^QANBRIF ;transmit message to local mail group
|
|---|
| 81 | Q
|
|---|
| 82 | DEL ;Delete incident.
|
|---|
| 83 | 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
|
|---|
| 84 | Q
|
|---|
| 85 | PAT ;Patient data.
|
|---|
| 86 | K DIC S DIC="^DPT(",DIC(0)="QEAMNZ",DIC("A")="Select Patient: ",DIC("W")="W "" "",$P(^(0),U,9)",D="B^BS5"
|
|---|
| 87 | D MIX^DIC1 K DIC S:+Y<1&($G(QANFLAG)) QANOUT=1
|
|---|
| 88 | D:+Y<1&('$G(QANFLAG)) DEL^QANCDNT Q:QANXIT!(QANOUT)
|
|---|
| 89 | F D Q:"-12"[%
|
|---|
| 90 | . W !?5,$G(Y(0,0))_" OK?"
|
|---|
| 91 | . S %=1 D YN^DICN Q:"-12"[%
|
|---|
| 92 | . W " Confirm that this is the correct patient."
|
|---|
| 93 | D:%=-1&('$G(QANFLAG)) DEL^QANCDNT Q:QANXIT!(QANOUT)
|
|---|
| 94 | I %=-1,($G(QANFLAG)) S QANXIT=1 Q
|
|---|
| 95 | I %=2 W " ??" G PAT
|
|---|
| 96 | D PRIOR I QANXIT D Q
|
|---|
| 97 | . I '$G(QANFLAG) K DA,DIK S DA=QANIEN,DIK="^QA(742.4," D ^DIK K DA,DIK
|
|---|
| 98 | 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
|
|---|
| 99 | 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
|
|---|
| 100 | I $G(QANXIT)!($G(QANOUT)) D DEL Q
|
|---|
| 101 | S QANPIEN=+Y,QANZERO=Y(0),QANAME=Y(0,0),QANSSN=$P(QANZERO,U,9),^UTILITY($J,"QAN PAT",+Y)=""
|
|---|
| 102 | S QANDOB=$P(^DPT(QANPIEN,0),U,3)
|
|---|
| 103 | I QANDOB]"" S X=DT,X1=X,X2=QANDOB,X="" D:X2 ^%DTC S X=X\365.25,QANAGE=X
|
|---|
| 104 | S QANPSDO(0)=Y(0),QANPSDO(0,0)=Y(0,0)
|
|---|
| 105 | S QANPID=$$QANPID(.Y)
|
|---|
| 106 | D ADMDT^QANUTL1
|
|---|
| 107 | 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
|
|---|
| 108 | I +Y=-1,('$G(QANFLAG)) D DEL Q
|
|---|
| 109 | I +Y=-1,($G(QANFLAG)) S QANXIT=1 Q ;Something is wrong, exit.
|
|---|
| 110 | S QANDFN=+Y
|
|---|
| 111 | L +^QA(742,QANDFN):10 I '$T W !!,"Another user is editing this patient incident." Q
|
|---|
| 112 | S $P(^QA(742,QANDFN,0),U,2,6)=QANPID_U_QANIEN_U_QANADMDT_U_QANINPAT_U_QANWARD
|
|---|
| 113 | S $P(^QA(742,QANDFN,0),U,7)=QANTRSP,$P(^QA(742,QANDFN,0),U,12)=1
|
|---|
| 114 | S DIK="^QA(742,",DA=QANDFN D IX1^DIK K DA,DIK
|
|---|
| 115 | L -^QA(742,QANDFN)
|
|---|
| 116 | S QANFLAG=1 ;D:'$D(QANF) BULL^QANUTL3
|
|---|
| 117 | K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANDFN,QAUDIT("ACTION")="o",QAUDIT("COMMENT")="Open a patient record" D ^QAQAUDIT
|
|---|
| 118 | Q
|
|---|
| 119 | PRIOR ;
|
|---|
| 120 | S QANTST(1)=$G(^QA(742.4,QANIEN,0))
|
|---|
| 121 | S QANTST("INC")=$P(QANTST(1),U,2),QANTST("DATE")=$P(QANTST(1),U,3)
|
|---|
| 122 | 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
|
|---|
| 123 | K QAN99,QANPRS,QANTST
|
|---|
| 124 | Q
|
|---|
| 125 | PRIOR1 ;
|
|---|
| 126 | I (QANTST("INC")=$P(QANTST(2),U,2)),(QANTST("DATE")=$P(QANTST(2),U,3)) D
|
|---|
| 127 | . W !!,$C(7),"Patient "_$P(^DPT(+Y,0),U)_" has a duplicate incident on record."
|
|---|
| 128 | . W:'$G(QANFLAG) !,"Deleting the incident."
|
|---|
| 129 | . S:'$G(QANFLAG) QANXIT=1
|
|---|
| 130 | . W:$G(QANFLAG) !,"Please select new patient or press 'RETURN'!"
|
|---|
| 131 | ; . W:$G(QANFLAG) !,"Exiting!"
|
|---|
| 132 | ; . S QANXIT=1
|
|---|
| 133 | Q
|
|---|
| 134 | DISP ;display to user what has been entered and ask if it is okay
|
|---|
| 135 | N QANCC,QANEE
|
|---|
| 136 | W @IOF
|
|---|
| 137 | S QAN74240=^QA(742.4,QANIEN,0)
|
|---|
| 138 | W !!!,"Incident Report: "_$P(QAN74240,U)
|
|---|
| 139 | S Y=$P(QAN74240,U,3) D DD^%DT
|
|---|
| 140 | W ?35,"Date of Incident: "_Y
|
|---|
| 141 | W !,"Patient: "
|
|---|
| 142 | S QANCC=0 F S QANCC=$O(^QA(742,"BCS",QANIEN,QANCC)) Q:QANCC'>0 D
|
|---|
| 143 | . W ?10,$P(^DPT($P(^QA(742,QANCC,0),U),0),U),!
|
|---|
| 144 | W !,"Incident Type: "
|
|---|
| 145 | I $P(QAN74240,U,2)]"" W $P(^QA(742.1,$P(QAN74240,U,2),0),U)
|
|---|
| 146 | W !,"Incident Location: "
|
|---|
| 147 | I $P(QAN74240,U,4)]"" W $P(^QA(742.5,$P(QAN74240,U,4),0),U)
|
|---|
| 148 | W !,"Was the Incident Witnessed?: "_$S($P(QAN74240,U,7)=1:"Yes",$P(QAN74240,U,7)=0:"No",1:"")
|
|---|
| 149 | W !,"Incident Description: "
|
|---|
| 150 | S QANEE=0 F S QANEE=$O(^QA(742.4,QANIEN,1,QANEE)) Q:QANEE'>0 D
|
|---|
| 151 | . W !?3,^QA(742.4,QANIEN,1,QANEE,0)
|
|---|
| 152 | W !!
|
|---|
| 153 | S DIR("A")="Is this information correct?"
|
|---|
| 154 | S DIR("B")="Yes"
|
|---|
| 155 | S DIR("?")="Enter 'Yes' or 'No'."
|
|---|
| 156 | S DIR(0)="YAO"
|
|---|
| 157 | S DIR("?",1)="Enter 'Yes' if the information displayed is correct."
|
|---|
| 158 | S DIR("?",2)="Enter 'No' if you need to edit this information."
|
|---|
| 159 | D ^DIR
|
|---|
| 160 | GOEDIT ;
|
|---|
| 161 | ;if info is not right, use code from QANEDIT to edit just the fields
|
|---|
| 162 | ;in a brief incident. There must be at least one patient/report.
|
|---|
| 163 | I Y=0 S QANOUT=0 D
|
|---|
| 164 | . D DIE^QANEDIT
|
|---|
| 165 | . I $O(^QA(742,"BCS",QANIEN,0))']"" D
|
|---|
| 166 | . . W !!,"No patients on this Incident Report - deleting Report."
|
|---|
| 167 | . . S DIK="^QA(742.4,",DA=QANIEN D ^DIK K DIK
|
|---|
| 168 | . . ;also need to remove entry from QA Audit file (#740.5)
|
|---|
| 169 | . . ;get most recent entry for 742 and 742.4 and if matches
|
|---|
| 170 | . . ;this entry, delete
|
|---|
| 171 | . . F QANFILE=742,742.4 D DIKAUDIT^QANEDIT(QANFILE) K QANFILE
|
|---|
| 172 | I $G(^QA(742.4,QANIEN,0))]"" D
|
|---|
| 173 | . D ^QANBRIF ;transmit message to local mail group
|
|---|
| 174 | . S QANCC=0
|
|---|
| 175 | . F S QANCC=$O(^QA(742,"BCS",QANIEN,QANCC)) Q:QANCC'>0 D
|
|---|
| 176 | . . S QANPTNUM=$P(^QA(742,QANCC,0),U)
|
|---|
| 177 | . . S QANODE=^DPT(QANPTNUM,0)
|
|---|
| 178 | . . S QANAME=$P(QANODE,U)
|
|---|
| 179 | . . S QANSSN=$P(QANODE,U,9)
|
|---|
| 180 | . . D:'$D(QANF) BULL^QANUTL3
|
|---|
| 181 | QANPID(Y) ;Function to set up Patient ID.
|
|---|
| 182 | N QANF,QANM,QANL
|
|---|
| 183 | S QANL=$P(Y(0,0),",")
|
|---|
| 184 | I QANL[" " D
|
|---|
| 185 | .S QANF=$E($P(Y(0,0),",",2))
|
|---|
| 186 | .S QANM=$E($P(Y(0,0)," ",3))
|
|---|
| 187 | .S QANPID=$G(QANF)_$G(QANM)_$E(QANL)_$E(QANSSN,6,9)
|
|---|
| 188 | I QANL'[" " D
|
|---|
| 189 | .S QANF=$E($P(Y(0,0),",",2))
|
|---|
| 190 | .S QANM=$E($P(Y(0,0)," ",2))
|
|---|
| 191 | .S QANPID=$G(QANF)_$G(QANM)_$E(QANL)_$E(QANSSN,6,9)
|
|---|
| 192 | Q QANPID
|
|---|
| 193 | Q
|
|---|
