source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANUTL0.m@ 792

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

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1QANUTL0 ;HISC/GJC-Utility for Incident Record Manipulation ;9/16/93 08:58
2 ;;2.0;Incident Reporting;**1,20**;08/07/1992
3 ;
4EN ;Choose your patient.
5 N QANINCD,QANXIT S QANXIT=0
6 S DIC=742,DIC(0)="QEAMZ",DIC("A")="Select Patient: ",DIC("W")="D EN1^QANUTL0"
7 D ^DIC K DIC Q:+Y'>0
8 S QANDFN=+Y
9 W @IOF D HDR
10 S PAT2=^DPT($P(^QA(742,QANDFN,0),U),0) W !,"Patient: "_$P(PAT2,U),?40," Social Security Number: "_$P(PAT2,U,9)
11 S QANIEN=$P(^QA(742,QANDFN,0),U,3),QAN0=$G(^QA(742.4,QANIEN,0))
12 I QAN0']"" W !!,*7,"The incident global is incomplete, contact you site manager." G KILL
13 S Y=$P(QAN0,U,2),C=$P(^DD(742.4,.02,0),U,2) D Y^DIQ S QANINC=$S(Y]"":Y,1:"")
14 S Y=$P(QAN0,U,3),C=$P(^DD(742.4,.03,0),U,2) D Y^DIQ S QANDATE=$S(Y]"":Y,1:"")
15 W !,"Incident: "_QANINC_" on date "_QANDATE_".",!
16 S QANLSTA=+$P(QAN0,U,8)
17 K DIR S DIR("B")=$S("13"[QANLSTA:"OPEN",QANLSTA=2:"DELETED",1:"CLOSED"),DIR("A")="Local Case Status: ",DIR(0)="SO^1:OPEN;0:CLOSED;-1:DELETED" D ^DIR K DIR
18 I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) W !!,*7,"No action taken, premature exit action encountered." G KILL
19 S QAN("Y")=Y
20 S DIE="^QA(742.4,",DA=QANIEN,DR=$S(QAN("Y")=1:".09///^S X=""1""",QAN("Y")=0:".09///^S X=""0""",1:".09///^S X=""2""") D ^DIE K DA,DIE,DR
21 K QAUDIT S QAUDIT("FILE")="742.4^50",QAUDIT("DA")=QANIEN,QAUDIT("ACTION")=$S(QAN("Y")=1:"o",QAN("Y")=0:"c",1:"d"),QAUDIT("COMMENT")=$S(QAN("Y")=1:"Open ",QAN("Y")=0:"Close ",1:"Delete ")_"an incident record" D ^QAQAUDIT
22EN0 S QAN0=$G(^QA(742.4,QANIEN,0)),QANACT=+$P(QAN0,U,8)
23 I QANLSTA'=QANACT S DIE="^QA(742.4,",DA=QANIEN,DR=".21///@" D ^DIE
24 S QANMSS(0)="W !!,*7,""Appropriate Patient(s) records now being marked as deleted!"""
25 S QANMSS(1)="W !!,*7,""Appropriate Patient(s) records now being marked as closed!"""
26 S QANMSS(2)="W !!,*7,""Appropriate Patient(s) records now being marked as open!"""
27 X $S(QANACT=2:QANMSS(0),QANACT=0:QANMSS(1),1:QANMSS(2))
28 K DIE,DR S DIE="^QA(742,",DR=$S(QANACT=2:".13///^S X=""-1""",QANACT=0:".13///^S X=""0""",1:".13///^S X=""1""")
29 S QANSLEV=+$P(^QA(742,QANDFN,0),U,10),QANNCDNT=$P(QAN0,U,2)
30 S QANNCDNT=$P($G(^QA(742.1,QANNCDNT,0)),U)
31 S QANINCD=$$UP^XLFSTR(QANNCDNT)
32 F QAN=0:0 S QAN=$O(^QA(742,"BCS",QANIEN,QAN)) Q:QAN'>0 S DA=QAN D AUDIT
33 S QANOK=0 D INCK^QANFULL0 ;Is the incident reportable???
34 I QANOK,(QAN("Y")=1) S DIE="^QA(742.4,",DA=QANIEN,DR=".17///"_1 D ^DIE
35 I 'QANOK S DIE="^QA(742.4,",DA=QANIEN,DR=".17///@" D ^DIE
36KILL K C,D,DD,DIC,DIE,DIR,DR,DTOUT,DUOUT,PAT2,QAN,QAN0,QAN7424,QANDATE,QANIEN
37 K %,D0,DI,DA,QANOK,QANACT,QANINC,QANDFN,QANSLEV,QANLSTA,QANMSS,TEMPY,X,Y
38 K QANNCDNT
39 Q
40EN1 ;
41 S TEMPY=Y
42 S QANIEN=$O(^QA(742.4,"ACN",+TEMPY,0)) Q:+QANIEN'>0
43 S QAN7424=$G(^QA(742.4,QANIEN,0)) Q:QAN7424']""
44 S Y=$P(QAN7424,U,2),C=$P(^DD(742.4,.02,0),U,2) D Y^DIQ S QANINC=$S(Y]"":Y,1:"")
45 S Y=$P(QAN7424,U,3),C=$P(^DD(742.4,.03,0),U,2) D Y^DIQ S QANDATE=$S(Y]"":Y,1:"")
46 W " "_$P(^DPT($P(^QA(742,+TEMPY,0),U),0),U,9)_" "_QANINC_" "_QANDATE_" "
47 S Y=TEMPY
48 Q
49HDH ;
50 I $E(IOST,1)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 QANXIT=1
51 Q:QANXIT
52 W @IOF D HDR
53 Q
54HDR ;
55 W !!,"This option will allow the user to open, close, or delete a record at the local level.",!,"The appropriate patient(s) records are marked to reflect the change for ",!,"incident: "_QANINC_" on date "_QANDATE_".",!
56 Q
57AUDIT ;File changes in the QA Audit File.
58 K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QAN,QAUDIT("ACTION")=$S(QANACT=2:"d",QANACT=0:"c",1:"o"),QAUDIT("COMMENT")=$S(QANACT=2:"Delete ",QANACT=0:"Close ",1:"Open ")_"a patient record" D ^QAQAUDIT
59 D ^DIE
60 Q
Note: See TracBrowser for help on using the repository browser.