source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANEDIT.m@ 901

Last change on this file since 901 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1QANEDIT ;WCIOFO/ERC-Edit a Brief Incident ;4/22/99
2 ;;2.0;Incident Reporting;**27,26,32**;08/07/1992;Build 3
3 ;
4START ;
5 W @IOF
6 N QANBFLG,QANIEN,QANNOPAT
7 F W !!,"Do you want to edit one of your open Incident Reports" S %=1 D YN^DICN Q:"-112"[% W !!,"Enter (Y)es, (N)o or ""^"" to exit"
8 I %=1 D EDIT
9 K QANXIT
10 Q
11EDIT ;
12 K ^TMP("QAN EDIT")
13 S QANCNT=1
14 S QANDUZ=DUZ
15 S QANEE=0
16 F S QANEE=$O(^QA(742.4,"ACS",1,QANEE)) Q:QANEE'>0 D
17 . I QANDUZ=$P(^QA(742.4,QANEE,0),U,5) S ^TMP("QAN EDIT",$J,QANCNT,QANEE)="",QANCNT=QANCNT+1
18 W @IOF
19 I '$D(^TMP("QAN EDIT")) D Q
20 . W !!,"**** You have no open Incident Reports to edit. Exiting.",!!
21 W !!,"Here are your open Incident Reports."
22 S QANEE=0
23 S QANTOT=0
24 F S QANEE=$O(^TMP("QAN EDIT",$J,QANEE)) Q:QANEE'>0 D
25 . S QANIEN=$O(^TMP("QAN EDIT",$J,QANEE,0)) Q:QANIEN'>0
26 . S QAN0=^QA(742.4,QANIEN,0)
27 . S QANCC=0,QANCNT=1
28 . S QANTOT=QANTOT+1 ;gets number of IRs for selecting record to edit
29 . F S QANCC=$O(^QA(742,"BCS",QANIEN,QANCC)) Q:QANCC'>0 D
30 . . S QANNAME=$P(^DPT($P(^QA(742,QANCC,0),U),0),U)
31 . . S Y=$P(QAN0,U,3) D DD^%DT S QANDATE=Y
32 . . S QANINC=$P(^QA(742.1,$P(QAN0,U,2),0),U)
33 . . I $Y>(IOSL-6) K DIR S DIR(0)="E" D ^DIR K DIR W @IOF
34 . . I QANCNT=1 W !,QANEE,?4,QANDATE,?25,$E(QANINC,1,25),?51,QANNAME
35 . . I QANCNT>1 W !?51,QANNAME
36 . . S QANCNT=QANCNT+1
37DIR ;
38 I $G(QANTOT)=1 S QANIEN=$O(^TMP("QAN EDIT",$J,1,0)) G DIE
39 K DIR
40 S DIR(0)="NOA"
41 S DIR("A")="Select a number from 1 to "_QANTOT_": "
42 D ^DIR K DIR Q:$D(DIRUT)!(+Y<1)
43 I +Y>QANTOT W !,"Number selected must be from 1 to "_QANTOT_", try again." G DIR
44 S QANIEN=$O(^TMP("QAN EDIT",$J,+Y,0))
45 I $G(QANIEN)]"",($D(^QA(742.4,QANIEN,0))) D
46 . L +^QA(742.4,QANIEN):5 I '$T W !!,"Another user is editing this record." Q
47 . S QANEDFLG=1
48 . D DIE
49 . I $O(^QA(742,"BCS",QANIEN,0))']"" D
50 . . ;if no patients entered, delete the incident
51 . . W !!,"No patients on this Incident Report - deleting Report."
52 . . S DIK="^QA(742.4,",DA=QANIEN D ^DIK K DIK
53 . D EXIT
54 Q
55DIE ;
56 W !!
57 N QANCNT,QANEE
58 S QANEFLG=0
59 S QANEE=0
60 S QANCNT=1
61 F S QANEE=$O(^QA(742,"BCS",QANIEN,QANEE)) Q:QANEE'>0 D
62 . S QANPAT(QANCNT)=QANEE
63 . S QANCNT=QANCNT+1
64 K DIE S DIE="^QA(742.4,",DA=QANIEN,DR=".02;.03;.04"
65 D ^DIE K DIE
66 L -^QA(742.4,QANIEN)
67PAT ;edit patient(s) on report
68 ;if no patients entered go directly to PTADD
69 I $O(^QA(742,"BCS",QANIEN,0))']"" G PTADD
70 K QANPNAM,QANPNUM
71 W !,"Patient(s) on this Incident Report."
72 S QANEE=0
73 S QANCNT=1
74 F S QANEE=$O(QANPAT(QANEE)) Q:QANEE'>0 D
75 . S QANPNUM(QANEE)=$P(^QA(742,QANPAT(QANEE),0),U)
76 . S QANPNAM(QANEE)=$P(^DPT(QANPNUM(QANEE),0),U)
77 . W !?5,QANCNT," ",QANPNAM(QANEE)
78 . S QANCNT=QANCNT+1
79 S DIR("A")="Is this correct"
80 S DIR("B")="YES"
81 S DIR(0)="Y"
82 D ^DIR K DIR Q:$D(DIRUT)
83 I Y<1 D
84 . S DIR(0)="Y",DIR("A")="Would you like to add a patient"
85 . S DIR("B")="YES"
86 . K DIRUT
87 . D ^DIR K DIR Q:$D(DIRUT)
88 . I Y=1 D PTADD S (QANEFLG,QANEDFLG)=1 Q
89 . ;deleting patients from record only allowed if editing a new record
90 . I $G(QANBFLG)'=1 Q
91 . K DIR S DIR(0)="Y",DIR("A")="Would you like to delete a patient"
92 . S DIR("B")="NO"
93 . K DIRUT
94 . D ^DIR K DIR Q:$D(DIRUT)
95 . I Y=1 D PTDEL S (QANEFLG,QANEDFLG)=1
96 ;if the user has deleted all patients and has not re-entered one,
97 ;exit the subroutine (a message will be displayed & the record deleted)
98 I $G(QANNOPAT)=1 K QANNOPAT Q
99 I $G(QANEFLG)=1 S QANEFLG=0 G PAT
100 ;if no patients on report skip description and witnessed and quit
101 I $O(^QA(742,"BCS",QANIEN,0))']"" Q
102 K DIE S DIE="^QA(742.4,",DR=".05;.08"
103 D ^DIE K DIE
104 Q
105PTADD ;
106 K DIC S DIC="^DPT(",DIC(0)="QEAMNZ",DIC("A")="Select Patient: ",DIC("W")="W "" "",$P(^(0),U,9)",D="B^BS5"
107 D MIX^DIC1 K DIC
108 I +Y<1 S QANXIT=1 Q
109 F D Q:"-12"[%
110 . W !?5,$G(Y(0,0))_" OK"
111 . S %=1 D YN^DICN Q:"-12"[%
112 . W " Confirm that this is the correct patient."
113 I %=-1 S QANXIT=1 Q
114 I %=2 W " ??" G PTADD
115 S QANEE=0
116 F S QANEE=$O(QANPNUM(QANEE)) Q:QANEE'>0 D
117 . I +Y=QANPNUM(QANEE) W !!,$C(7),$P(^DPT(+Y,0),U)_" has been previously entered for this incident." K Y S QANXFLG=1 Q
118 I $G(QANXFLG)=1 S QANXFLG=0 G PTADD
119 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 PTADD
120 S QANPIEN=+Y,QANZERO=Y(0),QANAME=Y(0,0),QANSSN=$P(QANZERO,U,9),^UTILITY($J,"QAN PAT",+Y)=""
121 S QANDOB=$P(^DPT(QANPIEN,0),U,3)
122 I QANDOB]"" S X=DT,X1=X,X2=QANDOB,X="" D:X2 ^%DTC S X=X\365.25,QANAGE=X
123 S QANPSDO(0)=Y(0),QANPSDO(0,0)=Y(0,0)
124 S QANPID=$$QANPID^QANCDNT(.Y)
125 D ADMDT^QANUTL1
126 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
127 I +Y=-1,($G(QANFLAG)) S QANXIT=1 Q
128 S QANDFN=+Y
129 S $P(^QA(742,QANDFN,0),U,2,6)=QANPID_U_QANIEN_U_QANADMDT_U_QANINPAT_U_QANWARD
130 S $P(^QA(742,QANDFN,0),U,7)=QANTRSP,$P(^QA(742,QANDFN,0),U,12)=1
131 S DIK="^QA(742,",DA=QANDFN D IX1^DIK K DA,DIK
132 S QANNUM=$O(QANPAT(" "),-1)+1
133 S QANPAT(QANNUM)=QANDFN
134 S QANPNUM(QANNUM)=QANPIEN
135 S QANPNAM(QANNUM)=QANAME
136 S QANFLAG=1 D:'$D(QANF) BULL^QANUTL3
137 K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANDFN,QAUDIT("ACTION")="e",QAUDIT("COMMENT")="Edit a brief patient record" D ^QAQAUDIT
138 Q
139PTDEL ;
140 S QANCC=0
141 F S QANCC=$O(QANPNUM(QANCC)) Q:QANCC'>0 D
142 . S QANNUM=QANCC
143 . W !?5,QANCC_" "_QANPNAM(QANCC)
144 I '$G(QANNUM) S QANXIT=1 Q
145 S DIR(0)="NOA"
146 S DIR("A")="Delete which patient number: "
147 D ^DIR K DIR Q:$D(DIRUT)
148 I $G(QANPNAM(+Y))']"" W !!?5,"Choice must be one of the displayed numbers." G PTDEL
149 I Y>QANNUM W !!?5,"Answer must be a number less than ",QANNUM+1 G PTDEL
150 I Y<1 S QANXIT=1 Q
151 S QANTEMP=+Y
152 S QANDFN=QANPAT(+Y)
153 S QANAME=QANPNAM(+Y)
154 S DIK="^QA(742,",DA=QANPAT(+Y) D ^DIK
155 ;D BULL^QANUTL3
156 ;K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANDFN,QAUDIT("ACTION")="d",QAUDIT("COMMENT")="Delete a brief patient record" D ^QAQAUDIT
157 K QANPAT(QANTEMP),QANPNUM(QANTEMP),QANPNAM(QANTEMP)
158 ;if there are no patients on the report set a flag and go back to PTADD
159 I $O(^QA(742,"BCS",QANIEN,0))']"" W !!,"You must have at least one patient on an incident report." S QANNOPAT=1 G PTADD
160 G PTDEL
161 Q
162EXIT ;
163 K QAN0,QANADMDT,QANCC,QANCNT,QANDATE,QANDFN,QANDOB,QANEE
164 K QANEDFLG,QANELFG,QANFLAG,QANIEN,QANINC,QANAME,QANNAME,QANNOPAT
165 K QANNUM,QANPAT,QANPID,QANPIEN,QANPNAM,QANPNUM,QANPSDO,QANTEMP
166 K QANTOT,QANTRSP,QANXFLG,QANXIT,QANY,QANZERO
167 Q
168DIKAUDIT(QANFIL) ;
169 ;deletes the entries for this Incident Report from
170 ;the QA Audit file. Input is the QA file (742 for the patient,
171 ;742.4 for the incident).
172 ;
173 S QANID=$S(QANFIL=742:QANDFN,1:QANIEN)
174 S QANEE=$O(^QA(740.5,"B",QANFIL," "),-1)+1
175 F S QANEE=$O(^QA(740.5,"B",QANFIL,QANEE),-1) Q:QANEE'>0 I $P(^QA(740.5,QANEE,0),U,2)=QANID S QANAUD=QANID Q
176 I $G(QANAUD)]"" D
177 . S DIK="^QA(740.5,",DA=QANEE
178 . D ^DIK K DIK
179 . K QANID,QANAUD,QANEE
180 Q
Note: See TracBrowser for help on using the repository browser.