source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANQUCK.m@ 1261

Last change on this file since 1261 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1QANQUCK ;HISC/GJC-Initial sighting of an Incident for a QA person ; 10/29/03 10:34am
2 ;;2.0;Incident Reporting;**1,9,14,27,26,28,29,32**;08/07/1992;Build 3
3 ;
4 K QANLOCK
5 D NEWREC^QANCDNT
6 D DIV^QANCDNT
7 I $G(QANQFLG)=1 Q
8 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))
9 S QANPTAB=$O(^QA(742.1,"BUPPER","PATIENT ABUSE",0))
10 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
11 S QANLTTR=$P(^QA(742.4,QANIEN,0),U,2)
12 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
13 K QAUDIT S QAUDIT("FILE")="742.4^50",QAUDIT("DA")=QANIEN,QAUDIT("ACTION")="o",QAUDIT("COMMENT")="Open an incident record" D ^QAQAUDIT
14 S DIE="^QA(742.4,",DR=".09///"_3,DA=QANIEN D ^DIE ; Set 'Local Case' flag to brief.
15 ;Get the patient.
16 K ^UTILITY($J,"QAN PAT") F D PAT Q:QANXIT!(QANOUT)
17 L -^QA(742.4,QANIEN) ;unlock record - it was locked in NEWREC^QANCDNT
18KILL K D0,DA,QANADMDT,QANAGE,QANAME,QANCHK,QANCODE,QANDFN,QANDOB,QANDT,QANDUZ
19 K QANFLAG,QANHOMCD,QANHOME,QANIEN,QANINCR,QANINPAT,QANLTTR,QANOUT
20 K QANPTAB,QANPID,QANPIEN,QANPSDO,QANSSN,QANSUI,QANDEATH,QANST,QANST1
21 K QANTRSP,QANTTL,QANWARD,QANXIT,QANZERO,QAQADICT,QAQAFLD,QUES,VAERR,X
22 K QANPRS,X1,X2,Y,QANCODE,QANBFLG
23 Q
24DEL ;
25 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
26 Q
27PAT ;Patient data.
28 K DIC S DIC="^DPT(",DIC(0)="QEAMNZ",DIC("A")="Select Patient: ",DIC("W")="W "" "",$P(^(0),U,9)",D="B^BS5"
29 D MIX^DIC1 K DIC S:+Y<1&(QANFLAG) QANOUT=1
30 D:+Y<1&('QANFLAG) DEL^QANCDNT Q:QANXIT!(QANOUT)
31 F D Q:"-12"[%
32 . W !?5,$G(Y(0,0))_" OK?"
33 . S %=1 D YN^DICN Q:"-12"[%
34 . W " Confirm that this is the correct patient."
35 D:%=-1&('QANFLAG) DEL^QANQUCK Q:QANXIT!(QANOUT)
36 I %=-1,(QANFLAG) S QANXIT=1 Q
37 I %=2 W " ??" G PAT
38 D PRIOR^QANCDNT I QANXIT D Q
39 . I 'QANFLAG K DA,DIK S DA=QANIEN,DIK="^QA(742.4," D ^DIK K DA,DIK
40 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
41 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
42 S QANPIEN=+Y,QANZERO=Y(0),QANAME=Y(0,0),QANSSN=$P(QANZERO,U,9),^UTILITY($J,"QAN PAT",+Y)=""
43 S QANDOB=$P(^DPT(QANPIEN,0),U,3)
44 I QANDOB]"" S X=DT,X1=X,X2=QANDOB,X="" D:X2 ^%DTC S X=X\365.25,QANAGE=X
45 S QANPSDO(0)=Y(0),QANPSDO(0,0)=Y(0,0)
46 S QANPID=$$QANPID^QANCDNT(.Y)
47 D ADMDT^QANUTL1
48 ;L +^QA(742):10 I '$T W !!,"Another user is editing this file." Q
49 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
50 I +Y=-1,('QANFLAG) D DEL Q
51 I +Y=-1,(QANFLAG) S QANXIT=1 Q ;Something is wrong, exit.
52 S QANDFN=+Y
53 ;L -^QA(742)
54 L +^QA(742,QANDFN):10 I '$T W !!,"Another user is editing this patient incident." Q
55 S $P(^QA(742,QANDFN,0),U,2,6)=QANPID_U_QANIEN_U_QANADMDT_U_QANINPAT_U_QANWARD
56 S $P(^QA(742,QANDFN,0),U,7)=QANTRSP,$P(^QA(742,QANDFN,0),U,12)=1
57 S DIK="^QA(742,",DA=QANDFN D IX1^DIK K DA,DIK
58 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
59 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
60 L -^QA(742,QANDFN)
61 S QANFLAG=1
62 K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANDFN,QAUDIT("ACTION")="o",QAUDIT("COMMENT")="Open a patient record" D ^QAQAUDIT
63 Q
Note: See TracBrowser for help on using the repository browser.