source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCADR.m@ 1766

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1DVBCADR ;ALB/JLU-editing the address ;1/28/93
2 ;;2.7;AMIE;**19**;Apr 10, 1995
3 ;
4EN ;driver of the program
5 S DVBCSTP=0
6 F DO Q:DVBCSTP
7 .D PAT Q:DVBCSTP
8 .D INIT Q:DVBCSTP
9 .F D GUTS Q:DVBCSTP1
10 .I DVBCMAL D MAIL
11 D EXIT
12 Q
13 ;
14GUTS ;this is the interloop or guts of the driver
15 D DISPL
16 D ASK
17 I 'Y S DVBCSTP1=1 Q
18 D QUES^DGRPU1(DVBCDFN,"ADD1")
19 I DGERR D ERROR Q
20 I DGCHANGE S DVBCMAL=1
21 D VDPTP
22 Q
23 ;
24EXIT ;cleans variables
25 K %H,DFN,DGCHANGE,DGERR,DIC,DIR,DVBC,DVBCDATE,DVBCDFN,DVBCLINE,DVBCMAL,DVBCPATN,DVBCSSN,DVBCSTP,DVBCSTP1,VAERR,VAPA,Y,XMTEXT,XMY,XMB,XMDUZ,XMSUB,DVBCX,DVBCML,DVBCSP,DVBCSP1,ER,J,C,PNAM,SSN,DVBCSSNO
26 K DVBTMP,XMBTEXT
27 Q
28 ;
29ERROR ;this is an erro printing subroutine
30 I DGERR W !,*7
31 Q
32 ;
33INIT ;initialize variables
34 I '$D(IOF) D HOME^%ZIS
35 K VAPA,DVBTMP,DVBC
36 S %H=$H
37 D YX^%DTC
38 S DVBCDATE=$P(Y,"@",1)
39 S $P(DVBCLINE,"_",80)=""
40 S SSN=$P(^DPT(DVBCDFN,0),U,9)
41 D SSNOUT^DVBCUTIL
42 S DVBCSSN=DVBCSSNO
43 D VDPTTMP
44 I VAERR S DVBCSTP=1 Q
45 I +VAPA(9) DO
46 .D STORTMP
47 .K VAPA
48 .D VDPTP
49 I VAERR S DVBCSTP=1 Q
50 D STORE
51 S (DVBCSTP1,DVBCMAL)=0
52 Q
53 ;
54PAT ;get the patient
55 S DIC="^DPT(",DIC(0)="AEMQ"
56 D ^DIC
57 I Y<0 S DVBCSTP=1 Q
58 S DVBCDFN=+Y,(PNAM,DVBCPATN)=$P(Y,U,2)
59 Q
60 ;
61DISPL ;the display subroutine
62 W @IOF
63 W "Edit Address Information",?35,$$SITE^DVBCUTL4,?67,DVBCDATE
64 W !,"Name: ",DVBCPATN,?54,"SSN: ",DVBCSSN
65 W !,DVBCLINE
66 W !,?9,"Permanent"
67 I $D(DVBTMP) DO
68 .W ?40,"Temporary: ",$P(DVBTMP(9),U,2)
69 .I $P(DVBTMP(10),U,2)]"" W " to ",$P(DVBTMP(10),U,2)
70 W !,"Address: ",$E(VAPA(1),1,29)
71 I $D(DVBTMP) W ?40,$E(DVBTMP(1),1,29)
72 W !,?9,$E(VAPA(2),1,29)
73 I $D(DVBTMP) W ?40,$E(DVBTMP(2),1,29)
74 W !,?9,$E(VAPA(3),1,29)
75 I $D(DVBTMP) W ?40,$E(DVBTMP(3),1,29)
76 W !,"City:",?9,VAPA(4)
77 I $D(DVBTMP) W ?40,DVBTMP(4)
78 W !,"State:",?9,$P(VAPA(5),U,2)
79 I $D(DVBTMP) W ?40,$P(DVBTMP(5),U,2)
80 W !,"Zip+4:",?9,$S($D(VAPA(11)):$P(VAPA(11),"^",2),1:"")
81 I $D(DVBTMP) W ?40,DVBTMP(11)
82 W !,"County:",?9,$P(VAPA(7),U,2)
83 I $D(DVBTMP) W ?40,$P(DVBTMP(7),U,2)
84 W !,"Phone:",?9,VAPA(8)
85 I $D(DVBTMP) W ?40,DVBTMP(8)
86 W !,"Office:",?9,VAPA(9999)
87 W !,DVBCLINE
88 Q
89 ;
90ASK ;ask if yes or no
91 S DIR(0)="Y",DIR("A")="Do you wish to edit this address:",DIR("B")="YES"
92 D ^DIR
93 Q
94 ;
95STORE ;store original address fro possible bulletin
96 S DVBC(1)=VAPA(1),DVBC(2)=VAPA(2),DVBC(3)=VAPA(3)
97 S DVBC(4)=VAPA(4),DVBC(5)=$P(VAPA(5),U,2)
98 S DVBC(11)=$S($D(VAPA(11)):$P(VAPA(11),"^",2),1:"")
99 S DVBC(7)=$P(VAPA(7),U,2),DVBC(8)=VAPA(8)
100 S DVBC(9999)=VAPA(9999)
101 Q
102 ;
103VDPTP ;gets the permanent address
104 S VAPA("P")=""
105VDPTTMP ;gets the temporary address if one
106 S DFN=DVBCDFN
107 D ADD^VADPT
108 S VAPA(9999)=$S($D(^DPT(DFN,.13)):$P(^(.13),U,2),1:"")
109 Q
110 ;
111STORTMP ;saves the active temporary address
112 S DVBTMP(1)=VAPA(1),DVBTMP(2)=VAPA(2),DVBTMP(3)=VAPA(3),DVBTMP(4)=VAPA(4)
113 S DVBTMP(5)=VAPA(5),DVBTMP(11)=$S($D(VAPA(11)):$P(VAPA(11),"^",2),1:"")
114 S DVBTMP(7)=VAPA(7),DVBTMP(8)=VAPA(8)
115 S DVBTMP(9)=VAPA(9),DVBTMP(10)=VAPA(10)
116 Q
117 ;
118MAIL ;to fire a bulletin if necessary
119 S XMDUZ="AMIE Package",XMSUB="Edit of patient address"
120 S XMB(1)=DVBCPATN_" SSN: "_DVBCSSN,XMB(2)=DVBCDATE,XMB(3)=$P(^VA(200,DUZ,0),U,1)
121 S XMB="DVBA C EDIT ADDRESS"
122 D XMT
123 S XMTEXT="DVBCML("
124 D ^XMB
125 K XMBTEXT,XMTEXT,XMB,XMSUB
126 W !!,"A bulletin has been sent to the appropriate mail group regarding this",!,"address change!"
127 Q
128 ;
129XMT ;make the text of the bulletin
130 S DVBCX=1 D LIN
131 S DVBCML(1)="ADDR.: "_DVBC(1)_DVBCSP_VAPA(1)
132 S DVBCX=2 D LIN
133 S DVBCML(2)=" "_DVBC(2)_DVBCSP_VAPA(2)
134 S DVBCX=3 D LIN
135 S DVBCML(3)=" "_DVBC(3)_DVBCSP_VAPA(3)
136 S DVBCX=4 D LIN
137 S DVBCML(4)="City: "_DVBC(4)_DVBCSP_VAPA(4)
138 S DVBCX=5 D LIN
139 S DVBCML(5)="State: "_DVBC(5)_DVBCSP_$P(VAPA(5),U,2)
140 S DVBCX=11 D LIN
141 S DVBCML(6)="Zip+4: "_DVBC(11)_DVBCSP_$S($D(VAPA(11)):$P(VAPA(11),"^",2),1:"")
142 S DVBCX=7 D LIN
143 S DVBCML(7)="County: "_DVBC(7)_DVBCSP_$P(VAPA(7),U,2)
144 S DVBCX=8 D LIN
145 S DVBCML(8)="Phone: "_DVBC(8)_DVBCSP_VAPA(8)
146 S DVBCX=9999 D LIN
147 S DVBCML(9)="Office: "_DVBC(9999)_DVBCSP_VAPA(9999)
148 Q
149 ;
150LIN ;makes spaces
151 K DVBCSP,DVBCSP1
152 S DVBCSP1=37-$L(DVBC(DVBCX))
153 S $P(DVBCSP," ",DVBCSP1)=""
154 Q
Note: See TracBrowser for help on using the repository browser.