source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGREGAED.m@ 1742

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

WorldVistAEHR overlayed on FOIAVistA
File size: 6.1 KB
Line 
1DGREGAED ;ALB/DW/PHH - Address Edit API; 1/5/2006 23:03 ;10/10/06 08:05
2 ;;5.3;Registration;**522,560,658,730,634**;Aug 13, 1993;Build 28
3 ; Modified from FOIA VISTA,
4 ; Copyright (C) 2007 WorldVistA
5 ;
6 ; This program is free software; you can redistribute it and/or modify
7 ; it under the terms of the GNU General Public License as published by
8 ; the Free Software Foundation; either version 2 of the License, or
9 ; (at your option) any later version.
10 ;
11 ; This program is distributed in the hope that it will be useful,
12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ; GNU General Public License for more details.
15 ;
16 ; You should have received a copy of the GNU General Public License
17 ; along with this program; if not, write to the Free Software
18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
19EN(DFN,FLG) ;Entry point
20 ;Input:
21 ; DFN (required) - Internal Entry # of Patient File (#2)
22 ; FLG (optional) - Flags of 1 or 0; if null, 0 is assumed. Details:
23 ; FLG(1) - if 1, let user edit phone numbers (field #.131 and #.132)
24 ; FLG(2) - if 1, display before & after address for user confirmation
25 K EASZIPLK
26 N DGINPUT
27 N I,X,Y
28 I $G(DFN)="" Q
29 I ($G(DFN)'?.N) Q
30 S FLG(1)=$G(FLG(1)),FLG(2)=$G(FLG(2))
31 D INPUT(.DGINPUT,DFN)
32 I $G(DGINPUT)=-1 Q
33 I $G(FLG(2))=1 D COMPARE(.DGINPUT,DFN)
34 I '$$CONFIRM() W !,"Change aborted." D EOP Q
35 N DGPRIOR
36 D GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
37 D SAVE(.DGINPUT,DFN)
38 I +$G(DGNEW) Q
39 Q:'$$FILEYN^DGADDUTL(.DGPRIOR,.DGINPUT)
40 D GETUPDTS^DGADDUTL(DFN,.DGINPUT)
41 D UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGINPUT)
42 Q
43INPUT(DGINPUT,DFN) ;Let user input address changes
44 ;Output: DGINPUT(field#)=external^internal(if any)
45 N DIR,X,Y,DA,DGR,DTOUT,DUOUT,DIROUT,DGN,POP
46 S POP=0
47 ;
48 ; ** VOE change 1 of 3: DAOU/WCJ 2/7/2005,VA/CJS,WV/TOAD 1/5/2006 **
49 ;
50 ; .134 is new field ALTERNATE PHONE for VOE
51 ;
52 ; before change:
53 ;
54 ; F DGN=.111,.112,.113,.1112,.131,.132,.121 Q:POP D
55 ;
56 ; after change:
57 ;
58 F DGN=.111,.112,.113,.1112,.131,.132,.134,.121 Q:POP D
59 . ;
60 . ; end change
61 . ;
62 . I ($G(DGINPUT(.111))="")&((DGN=.112)!(DGN=.113)) Q
63 . I ($G(DGINPUT(.112))="")&(DGN=.113) Q
64 . I ($G(FLG(1))'=1)&((DGN=.131)!(DGN=.132)) Q
65 . I DGN=.1112 D Q
66 .. D EN^DGREGAZL(.DGR,DFN)
67 .. I $G(DGR)=-1 S POP=1 Q
68 .. N DGM F DGM=.1112,.114,.115,.117 S DGINPUT(DGM)=$G(DGR(DGM))
69 . ;
70 . ; new line:
71 . ;
72 . I DGN=.134,$G(DUZ("AG"))'="E" Q
73 . ;
74 . ; ** end of VOE change 1 **
75 . ;
76AGN . S DIR(0)=2_","_DGN
77 . S DA=DFN
78 . D ^DIR
79 . I $D(DTOUT) S POP=1 Q
80 . I $D(DUOUT)!$D(DIROUT) D UPCT G AGN
81 . I DGN'=.121 S DGINPUT(DGN)=$G(Y)
82 . I DGN=.121 D
83 .. I $P($G(Y),U)=$$GET1^DIQ(2,DFN_",",DGN,"I") D
84 ... S DGINPUT(DGN)=$$GET1^DIQ(2,DFN_",",DGN)_U_$P($G(Y),U)
85 .. I $P($G(Y),U)'=$$GET1^DIQ(2,DFN_",",DGN,"I") D
86 ... S DGINPUT(DGN)=$P($G(Y(0)),U)_U_$G(Y)
87 I $G(POP)=1 S DGINPUT=-1
88 Q
89COMPARE(DGINPUT,DFN) ;Display before & after address fields.
90 N DGCURR,DGN,DGCMP,DGM,DGCNTY,DGCIEN,DGST
91 D GETS^DIQ(2,DFN_",",".111;.112;.113;.114;.115;.117;.1112;.131;.132;.121","EI","DGCURR")
92 ;
93 ; ** VOE change 2 of 3: DAOU/WCJ 2/7/2005,VA/CJS,WV/TOAD 1/5/2006 **
94 ;
95 ; for VOE agency code, add new ALTERNATE PHONE field (.134)
96 ; to DGCMP("OLD") array
97 ;
98 ; before change:
99 ;
100 ; F DGN=.111,.112,.113,.114,.115,.117,.1112,.131,.132,.121 D
101 ; . S DGCMP("OLD",DGN)=$G(DGCURR(2,DFN_",",DGN,"E"))
102 ;
103 ; after change:
104 ;
105 I $G(DUZ("AG"))="E" D GETS^DIQ(2,DFN,.134,"EI","DGCURR")
106 F DGN=.111,.112,.113,.114,.115,.117,.1112,.131,.132,.134,.121 D
107 . I $G(DUZ("AG"))'="E",DGN=.134 Q ; skip for non-VOE
108 . ;
109 . ; ** end of VOE change 2 **
110 . ;
111 . S DGCMP("OLD",DGN)=$G(DGCURR(2,DFN_",",DGN,"E"))
112 S DGCIEN=$G(DGCURR(2,DFN_",",.117,"I"))
113 S DGST=$G(DGCURR(2,DFN_",",.115,"I"))
114 S DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)
115 I DGCNTY=-1 S DGCNTY=""
116 S DGCMP("OLD",.117)=$P(DGCNTY,U)_" "_$P(DGCNTY,U,3)
117 M DGCMP("NEW")=DGINPUT
118 S DGCNTY=$P($G(DGCMP("NEW",.117)),U)_" "_$P($G(DGCMP("NEW",.117)),U,3)
119 S DGCMP("NEW",.117)=DGCNTY
120 I ($L(DGCMP("NEW",.1112))>5)&($P(DGCMP("NEW",.1112),"-",2)="") S DGCMP("NEW",.1112)=$E(DGCMP("NEW",.1112),1,5)_"-"_$E(DGCMP("NEW",.1112),6,9)
121 F DGM="OLD","NEW" D
122 . W !,?2,"[",DGM," ADDRESS]"
123 . W ?16,$P($G(DGCMP(DGM,.111)),U)
124 . I $P($G(DGCMP(DGM,.112)),U)'="" W !,?16,$P($G(DGCMP(DGM,.112)),U)
125 . I $P($G(DGCMP(DGM,.113)),U)'="" W !,?16,$P($G(DGCMP(DGM,.113)),U)
126 . W !,?16,$P($G(DGCMP(DGM,.114)),U)
127 . W:($P($G(DGCMP(DGM,.114)),U)'="")!($P($G(DGCMP(DGM,.115)),U)'="") ","
128 . W $P($G(DGCMP(DGM,.115)),U)
129 . W " ",$G(DGCMP(DGM,.1112))
130 . I $P($G(DGCMP(DGM,.117)),U)'="" W !,?6," County: ",$P($G(DGCMP(DGM,.117)),U)
131 . I $G(FLG(1))=1 D
132 .. W !,?6," Phone: ",?16,$P($G(DGCMP(DGM,.131)),U)
133 .. W !,?6," Office: ",?16,$P($G(DGCMP(DGM,.132)),U)
134 .. ;
135 .. ; ** VOE change 3 of 3: DAOU/WCJ 2/7/2005,VA/CJS,WV/TOAD 1/5/2006 **
136 .. ;
137 .. ; for VOE agency code, display new ALTERNATE PHONE field (.134)
138 .. ;
139 .. ; insert line:
140 .. ;
141 .. I $G(DUZ("AG"))="E" W !,?6," Alt Phone: ",?16,$P($G(DGCMP(DGM,.134)),U)
142 .. ;
143 .. ; ** end of VOE change 3 **
144 .. ;
145 . W !,?6,"Bad Addr: ",?16,$P($G(DGCMP(DGM,.121)),U)
146 . W !
147 Q
148CONFIRM() ;Confirm if user wants to save the change
149 N DIR,X,Y,DTOUT,DUOUT,DIROUT
150 S DIR(0)="Y"
151 S DIR("A")="Are you sure that you want to save the above changes"
152 S DIR("?")="Please answer Y for YES or N for NO."
153 D ^DIR
154 I $D(DTOUT)!($G(Y)=0) Q 0
155 I $D(DUOUT)!$D(DIROUT) Q 0
156 Q 1
157SAVE(DGINPUT,DFN) ;Save changes
158 N DGN,DGER,DGM
159 S DGER=0
160 F DGN=.111,.112,.113,.131,.132,.1112,.114,.115,.117,.121 D
161 . I ($G(FLG(1))'=1)&((DGN=.131)!(DGN=.132)) Q
162 . N DGCODE,DGNAME,FDA,MSG
163 . S DGCODE=$P($G(DGINPUT(DGN)),U,2)
164 . S DGNAME=$P($G(DGINPUT(DGN)),U)
165 . S FDA(2,DFN_",",DGN)=$S(DGCODE:DGCODE,1:DGNAME)
166 . D FILE^DIE($S(DGCODE:"",1:"E"),"FDA","MSG")
167 . I $D(MSG) D
168 .. S DGM="",DGER=1
169 .. W !,"Please review the saved changes!!",!
170 .. F S DGM=$O(MSG("DIERR",1,"TEXT",DGM)) Q:DGM="" D
171 ... W $G(MSG("DIERR",1,"TEXT",DGM))
172 I $G(DGER)=0 W !,"Change saved."
173 D EOP
174 Q
175EOP ;End of page prompt
176 N DIR,DTOUT,DUOUT,DIROUT,X,Y
177 S DIR(0)="E"
178 S DIR("A")="Press ENTER to continue"
179 D ^DIR
180 Q
181UPCT ;Indicate "^" or "^^" are unacceptable inputs.
182 W !,"EXIT NOT ALLOWED ??"
183 Q
Note: See TracBrowser for help on using the repository browser.