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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1DGREGAED ;ALB/DW/PHH - Address Edit API; 9/1/2005
2 ;;5.3;Registration;**522,560,658,730**;Aug 13, 1993;Build 2
3EN(DFN,FLG) ;Entry point
4 ;Input:
5 ; DFN (required) - Internal Entry # of Patient File (#2)
6 ; FLG (optional) - Flags of 1 or 0; if null, 0 is assumed. Details:
7 ; FLG(1) - if 1, let user edit phone numbers (field #.131 and #.132)
8 ; FLG(2) - if 1, display before & after address for user confirmation
9 K EASZIPLK
10 N DGINPUT
11 N I,X,Y
12 I $G(DFN)="" Q
13 ;I ($G(DFN)'?.N) Q
14 S FLG(1)=$G(FLG(1)),FLG(2)=$G(FLG(2))
15 D INPUT(.DGINPUT,DFN)
16 I $G(DGINPUT)=-1 Q
17 I $G(FLG(2))=1 D COMPARE(.DGINPUT,DFN)
18 I '$$CONFIRM() W !,"Change aborted." D EOP Q
19 N DGPRIOR
20 D GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
21 D SAVE(.DGINPUT,DFN)
22 I +$G(DGNEW) Q
23 Q:'$$FILEYN^DGADDUTL(.DGPRIOR,.DGINPUT)
24 D GETUPDTS^DGADDUTL(DFN,.DGINPUT)
25 D UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGINPUT)
26 Q
27INPUT(DGINPUT,DFN) ;Let user input address changes
28 ;Output: DGINPUT(field#)=external^internal(if any)
29 N DIR,X,Y,DA,DGR,DTOUT,DUOUT,DIROUT,DGN,POP
30 S POP=0
31 F DGN=.111,.112,.113,.1112,.131,.132,.121 Q:POP D
32 . I ($G(DGINPUT(.111))="")&((DGN=.112)!(DGN=.113)) Q
33 . I ($G(DGINPUT(.112))="")&(DGN=.113) Q
34 . I ($G(FLG(1))'=1)&((DGN=.131)!(DGN=.132)) Q
35 . I DGN=.1112 D Q
36 .. D EN^DGREGAZL(.DGR,DFN)
37 .. I $G(DGR)=-1 S POP=1 Q
38 .. N DGM F DGM=.1112,.114,.115,.117 S DGINPUT(DGM)=$G(DGR(DGM))
39AGN . S DIR(0)=2_","_DGN
40 . S DA=DFN
41 . D ^DIR
42 . I $D(DTOUT) S POP=1 Q
43 . I $D(DUOUT)!$D(DIROUT) D UPCT G AGN
44 . I DGN'=.121 S DGINPUT(DGN)=$G(Y)
45 . I DGN=.121 D
46 .. I $P($G(Y),U)=$$GET1^DIQ(2,DFN_",",DGN,"I") D
47 ... S DGINPUT(DGN)=$$GET1^DIQ(2,DFN_",",DGN)_U_$P($G(Y),U)
48 .. I $P($G(Y),U)'=$$GET1^DIQ(2,DFN_",",DGN,"I") D
49 ... S DGINPUT(DGN)=$P($G(Y(0)),U)_U_$G(Y)
50 I $G(POP)=1 S DGINPUT=-1
51 Q
52COMPARE(DGINPUT,DFN) ;Display before & after address fields
53 N DGCURR,DGN,DGCMP,DGM,DGCNTY,DGCIEN,DGST
54 D GETS^DIQ(2,DFN_",",".111;.112;.113;.114;.115;.117;.1112;.131;.132;.121","EI","DGCURR")
55 F DGN=.111,.112,.113,.114,.115,.117,.1112,.131,.132,.121 D
56 . S DGCMP("OLD",DGN)=$G(DGCURR(2,DFN_",",DGN,"E"))
57 S DGCIEN=$G(DGCURR(2,DFN_",",.117,"I"))
58 S DGST=$G(DGCURR(2,DFN_",",.115,"I"))
59 S DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)
60 I DGCNTY=-1 S DGCNTY=""
61 S DGCMP("OLD",.117)=$P(DGCNTY,U)_" "_$P(DGCNTY,U,3)
62 M DGCMP("NEW")=DGINPUT
63 S DGCNTY=$P($G(DGCMP("NEW",.117)),U)_" "_$P($G(DGCMP("NEW",.117)),U,3)
64 S DGCMP("NEW",.117)=DGCNTY
65 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)
66 F DGM="OLD","NEW" D
67 . W !,?2,"[",DGM," ADDRESS]"
68 . W ?16,$P($G(DGCMP(DGM,.111)),U)
69 . I $P($G(DGCMP(DGM,.112)),U)'="" W !,?16,$P($G(DGCMP(DGM,.112)),U)
70 . I $P($G(DGCMP(DGM,.113)),U)'="" W !,?16,$P($G(DGCMP(DGM,.113)),U)
71 . W !,?16,$P($G(DGCMP(DGM,.114)),U)
72 . W:($P($G(DGCMP(DGM,.114)),U)'="")!($P($G(DGCMP(DGM,.115)),U)'="") ","
73 . W $P($G(DGCMP(DGM,.115)),U)
74 . W " ",$G(DGCMP(DGM,.1112))
75 . I $P($G(DGCMP(DGM,.117)),U)'="" W !,?6," County: ",$P($G(DGCMP(DGM,.117)),U)
76 . I $G(FLG(1))=1 D
77 .. W !,?6," Phone: ",?16,$P($G(DGCMP(DGM,.131)),U)
78 .. W !,?6," Office: ",?16,$P($G(DGCMP(DGM,.132)),U)
79 . W !,?6,"Bad Addr: ",?16,$P($G(DGCMP(DGM,.121)),U)
80 . W !
81 Q
82CONFIRM() ;Confirm if user wants to save the change
83 N DIR,X,Y,DTOUT,DUOUT,DIROUT
84 S DIR(0)="Y"
85 S DIR("A")="Are you sure that you want to save the above changes"
86 S DIR("?")="Please answer Y for YES or N for NO."
87 D ^DIR
88 I $D(DTOUT)!($G(Y)=0) Q 0
89 I $D(DUOUT)!$D(DIROUT) Q 0
90 Q 1
91SAVE(DGINPUT,DFN) ;Save changes
92 N DGN,DGER,DGM
93 S DGER=0
94 F DGN=.111,.112,.113,.131,.132,.1112,.114,.115,.117,.121 D
95 . I ($G(FLG(1))'=1)&((DGN=.131)!(DGN=.132)) Q
96 . N DGCODE,DGNAME,FDA,MSG
97 . S DGCODE=$P($G(DGINPUT(DGN)),U,2)
98 . S DGNAME=$P($G(DGINPUT(DGN)),U)
99 . S FDA(2,DFN_",",DGN)=$S(DGCODE:DGCODE,1:DGNAME)
100 . D FILE^DIE($S(DGCODE:"",1:"E"),"FDA","MSG")
101 . I $D(MSG) D
102 .. S DGM="",DGER=1
103 .. W !,"Please review the saved changes!!",!
104 .. F S DGM=$O(MSG("DIERR",1,"TEXT",DGM)) Q:DGM="" D
105 ... W $G(MSG("DIERR",1,"TEXT",DGM))
106 I $G(DGER)=0 W !,"Change saved."
107 D EOP
108 Q
109EOP ;End of page prompt
110 N DIR,DTOUT,DUOUT,DIROUT,X,Y
111 S DIR(0)="E"
112 S DIR("A")="Press ENTER to continue"
113 D ^DIR
114 Q
115UPCT ;Indicate "^" or "^^" are unacceptable inputs.
116 W !,"EXIT NOT ALLOWED ??"
117 Q
Note: See TracBrowser for help on using the repository browser.