source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANQUCK.m@ 1094

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