source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZU6.m@ 1739

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

initial load of WorldVistAEHR
File size: 8.5 KB
RevLine 
[613]1EASEZU6 ;ALB/jap - Utilities for 1010EZ Processing ;10/31/00 13:08
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**53**;Mar 15, 2001
3 ;
4ANAME(EASLN,LN,DATANM) ;special update logic for Names
5 ;output UPDATE = new data entered by user thru input transform
6 ;
7 N SUBIEN,MULTIPLE,KEYIEN,DKEY,SECT,QUES,ORIGINAL,TYPE,XPART,KEY,SUB,NAME,UNAME,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
8 S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
9 S DKEY=$P($G(^TMP("EZDATA",$J,KEYIEN)),U,4),SECT=$P(DKEY,";",1),QUES=$P(DKEY,";",2)
10 S X=$G(^TMP("EZTEMP",$J,SECT,MULTIPLE,QUES))
11 Q:$P(X,U,1)'=KEYIEN
12 S ORIGINAL=$P(X,U,2) K X
13 ;user may update each name part
14 S TYPE=$P(DATANM," ",1)_" "
15 F XPART="LAST","FIRST","MIDDLE","SUFFIX" D Q:($D(DTOUT)!$D(DUOUT))
16 .;have keyien & subien (above) for last name, but need to get for each part
17 .S KEY=+$$KEY711^EASEZU1(TYPE_XPART_" NAME")
18 .Q:KEY<1
19 .;get name part & make sure it's all uppercase
20 .S X=$$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE)
21 .S NAME(XPART)=$$UC^EASEZT1($P(X,U,1)),SUB(XPART)=$P(X,U,2) K X
22 .S DIR("A")=TYPE_XPART_" NAME"
23 .I XPART="LAST" S DIR("??")="No punctuation is allowed other than ""-"" in a hyphenated name."
24 .E S DIR("??")="No punctuation or numerics are allowed."
25 .S X=$G(^EAS(711,KEY,3)) I X'="" X X
26 .;1st piece of DIR contains 'O', input is optional
27 .S:$G(DIR(0))="" DIR(0)="FO^1:30^K:X'?.A X"
28 .D ^DIR
29 .;don't continue if user exited w/o input
30 .Q:($D(DTOUT)!$D(DUOUT))
31 .;pickup the DIR output
32 .S UPDATE=$$UC^EASEZT1($G(Y)),UNAME(XPART)=UPDATE
33 .I UNAME(XPART)="" S UNAME(XPART)=$G(NAME(XPART))
34 Q:($D(DTOUT)!$D(DUOUT))
35 K DIR,DTOUT,DUOUT,DIRUT
36 ;file data element; a manually updated element is always 'accepted'
37 F XPART="LAST","FIRST","MIDDLE","SUFFIX" D
38 .Q:$G(UNAME(XPART))=$G(NAME(XPART)) Q:$G(UNAME(XPART))=""
39 .S DIE="^EAS(712,EASAPP,10,",DA=SUB(XPART),DA(1)=EASAPP,DR(1)="10;"
40 .S DR="1///^S X=UNAME(XPART);1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
41 .D ^DIE
42 ;put together updated full name
43 S X=UNAME("LAST")_","_UNAME("FIRST")
44 I $G(UNAME("MIDDLE"))'="" D
45 .I $L(X)+$L(UNAME("MIDDLE"))>45 S MDL=$E(UNAME("MIDDLE"),1),X=X_" "_MDL
46 .E S X=X_" "_UNAME("MIDDLE")
47 I $G(UNAME("SUFFIX"))'="" S X=X_" "_UNAME("SUFFIX")
48 S UPDATE=X
49 S VALMBCK="R"
50 ;update screen list
51 Q:UPDATE=ORIGINAL
52 D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
53 D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
54 D WRITE^VALM10(EASLN)
55 Q
56 ;
57APHONE(EASLN,LN,DATANM) ;special update logic for Phone Numbers
58 ;
59 N SUBIEN,MULTIPLE,KEYIEN,DKEY,SECT,QUES,ORIGINAL,TYPE,XPART,KEY,SUB,PHONE,UPHONE,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
60 S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
61 S DKEY=$P($G(^TMP("EZDATA",$J,KEYIEN)),U,4),SECT=$P(DKEY,";",1),QUES=$P(DKEY,";",2)
62 S X=$G(^TMP("EZTEMP",$J,SECT,MULTIPLE,QUES))
63 Q:$P(X,U,1)'=KEYIEN
64 S ORIGINAL=$P(X,U,2) K X
65 ;user may update each phone number part
66 S TYPE=$P(DATANM," ",1,3)_" "
67 F XPART="AREA CODE","NUMBER","EXTENSION" D Q:($D(DTOUT)!$D(DUOUT))
68 .;have keyien & subien (above) for area code, but need to get for each part
69 .S KEY=+$$KEY711^EASEZU1(TYPE_XPART)
70 .Q:KEY<1
71 .;get phone number part
72 .S X=$$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE)
73 .S PHONE(XPART)=$P(X,U,1),SUB(XPART)=$P(X,U,2) K X
74 .S DIR("A")=TYPE_XPART
75 .I XPART="NUMBER" S DIR("?")="Use format nnn-nnnn. Example: 222-1234"
76 .I XPART="EXTENSION" S DIR("?")="Use up to 5 digits; no other characters. Example: 12345"
77 .S X=$G(^EAS(711,KEY,3)) I X'="" X X
78 .;1st piece of DIR contains 'O', input is optional
79 .S:$G(DIR(0))="" DIR(0)="FO^1:8"
80 .D ^DIR
81 .;don't continue if user exited w/o input
82 .Q:($D(DTOUT)!$D(DUOUT))
83 .;pickup the DIR output
84 .S UPDATE=$G(Y),UPHONE(XPART)=UPDATE
85 .I UPHONE(XPART)="" S UPHONE(XPART)=$G(PHONE(XPART))
86 Q:($D(DTOUT)!$D(DUOUT))
87 K DIR,DTOUT,DUOUT,DIRUT
88 ;file data element; a manually updated element is always 'accepted'
89 F XPART="AREA CODE","NUMBER","EXTENSION" D
90 .Q:$G(UPHONE(XPART))=$G(PHONE(XPART)) Q:$G(UPHONE(XPART))=""
91 .S DIE="^EAS(712,EASAPP,10,",DA=SUB(XPART),DA(1)=EASAPP,DR(1)="10;"
92 .S DR="1///^S X=UPHONE(XPART);1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
93 .D ^DIE
94 ;put together updated full phone number
95 S X=$G(UPHONE("NUMBER"))
96 I $G(UPHONE("AREA CODE")) S X="("_UPHONE("AREA CODE")_")"_X
97 I $G(UPHONE("EXTENSION"))'="" S X=X_" X"_UPHONE("EXTENSION")
98 S UPDATE=X
99 S VALMBCK="R"
100 ;update screen list
101 Q:UPDATE=ORIGINAL
102 D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
103 D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
104 D WRITE^VALM10(EASLN)
105 Q
106 ;
107ASTATE(EASLN,LN,DATANM) ;special update logic for any STATE
108 ;
109 N I,SUBIEN,MULTIPLE,KEYIEN,ORIGINAL,IEN,ABBR,AB,ZX,OUT,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
110 S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
111 S ORIGINAL=$P($G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),U,1)
112 S DIR("A")=DATANM
113 S DIR(0)="P^5:EMZ"
114 D ^DIR
115 ;don't continue if user exited w/o input
116 Q:($D(DTOUT)!$D(DUOUT))
117 K DIR,DTOUT,DUOUT,DIRUT
118 ;pickup the DIR output
119 S UPDATE=$P($G(Y(0)),U,1)
120 ;don't continue if no data
121 Q:UPDATE=""
122 ;don't continue if no change to data
123 Q:UPDATE=ORIGINAL
124 S IEN=$P(Y,U,1)
125 S ABBR=$P($G(^DIC(5,IEN,0)),U,2)
126 ;make sure abbrev. matches web-based app
127 S OUT=0 F I=1:1 S X=$P($T(STDAT+I),";;",2) Q:X="QUIT" Q:OUT D
128 .S AB=$P(X,";",1),ZX=$P(X,";",2)
129 .I (ZX[UPDATE)!(UPDATE[ZX) S ABBR=AB,OUT=1
130 ;file data element; a manually updated element is always 'accepted'
131 S DIE="^EAS(712,EASAPP,10,",DA=SUBIEN,DA(1)=EASAPP,DR(1)="10;"
132 S DR="1///^S X=ABBR;1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
133 D ^DIE
134 S VALMBCK="R"
135 ;update screen list
136 D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
137 D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
138 D WRITE^VALM10(EASLN)
139 Q
140 ;
141STDAT ;
142 ;;AS;AMERICAN SAMOA
143 ;;DC;DISTRICT OF COLUMBIA
144 ;;FM;FEDERATED STATES OF MICRONESIA
145 ;;GU;GUAM
146 ;;MH;MARSHALL ISLANDS
147 ;;MP;NORTHERN MARIANA ISLANDS
148 ;;PW;PALAU (TRUST TERRITORY)
149 ;;PR;PUERTO RICO
150 ;;VI;VIRGIN ISLANDS
151 ;;QUIT
152 ;
153ACOUNTY(EASLN,LN,DATANM) ;special update logic for COUNTY
154 ;
155 N SUBIEN,MULTIPLE,KEYIEN,ORIGINAL,KEY,ABBR,STATE,SIEN,CIEN,CCODE,ROOT,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
156 S LN=^TMP("EASEXP",$J,"IDX",EASLN),SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
157 S ORIGINAL=$P($G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),U,1)
158 S KEY=+$$KEY711^EASEZU1("APPLICANT STATE")
159 Q:'KEY
160 S ABBR="",STATE="",SIEN="",CIEN="",CCODE=""
161 I KEY D
162 .S ABBR=$P($$DATA712^EASEZU1(EASAPP,KEY,1),U,1)
163 .I ABBR'="" S STATE=$$STATE^EASEZT1(ABBR)
164 .I STATE'="" S SIEN=$O(^DIC(5,"B",STATE,0))
165 Q:'SIEN
166 S ROOT="DIC(5,"_SIEN_",1,"
167 S DIR("A")=DATANM
168 S DIR(0)="P"_U_ROOT_":QEMZ"
169 D ^DIR
170 ;don't continue if user exited w/o input
171 Q:($D(DTOUT)!$D(DUOUT))
172 K DIR,DTOUT,DUOUT,DIRUT
173 ;pickup the DIR output
174 S UPDATE=$P($G(Y(0)),U,1)
175 ;don't continue if no data
176 Q:UPDATE=""
177 S CIEN=$P(Y,U,1) I CIEN'="" S CCODE=$P($G(^DIC(5,SIEN,1,CIEN,0)),U,3)
178 S COUNTY=UPDATE I CCODE'="" S UPDATE=UPDATE_" ("_CCODE_")"
179 ;don't continue if no change to data
180 Q:UPDATE=ORIGINAL
181 ;file data element; a manually updated element is always 'accepted'
182 S DIE="^EAS(712,EASAPP,10,",DA=SUBIEN,DA(1)=EASAPP,DR(1)="10;"
183 S DR="1///^S X=COUNTY;1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
184 D ^DIE
185 S VALMBCK="R"
186 ;update screen list
187 D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
188 D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
189 D WRITE^VALM10(EASLN)
190 Q
191 ;
192ASSN(EASLN,LN,DATANM,ACCEPT) ;special update logic for Spouse/Dependent SSN
193 N OUT,DIR,DIRUT,DTOUT,DUOUT,UPDATE,LINK13,OTHER,RESULT
194 ;only used if DATANM["SOCIAL SECURITY NUMBER" and FILE'=2
195 S OUT=0,UPDATE="" F D Q:OUT
196 .S DIR("A")=DATANM
197 .S DIR(0)="F^11:11^K:X'?3N1""-""2N1""-""4N X",DIR("?")="Use format nnn-nnn-nnn. Example: 222-33-4444"
198 .D ^DIR
199 .I $D(DIRUT) S OUT=1 Q
200 .I ($D(DTOUT)!$D(DUOUT)) S OUT=1 Q
201 .;pickup the DIR output
202 .S UPDATE=$P($G(Y(0)),U,1) S:UPDATE="" UPDATE=$P($G(Y),U,1)
203 .;don't continue if no data
204 .I UPDATE="" S OUT=1 Q
205 .S UPDATE=$TR(UPDATE,"-","")
206 .S LINK13=$P($G(^EAS(712,EASAPP,10,SUBIEN,2)),U,2)
207 .S RESULT="",OTHER=0
208 .F S OTHER=$O(^DGPR(408.13,"SSN",UPDATE,OTHER)) Q:OTHER="" Q:RESULT="^" I OTHER,LINK13,OTHER'=LINK13 D
209 ..S RESULT="^"
210 ..W !,?3,"Sorry... that SSN is already used by another person"
211 ..W !,?3,"in the INCOME PERSON File (#408.13). Try again."
212 .I RESULT="^" S UPDATE=""
213 .I UPDATE'="" S OUT=1
214 ;file the update, if any
215 Q:UPDATE=""
216 I 'ACCEPT S ACCEPT=1
217 S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
218 S $P(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1),U,1,2)=UPDATE_U_ACCEPT
219 ;file data element; any manually updated element is 'accepted'
220 S DIE="^EAS(712,EASAPP,10,",DA=SUBIEN,DA(1)=EASAPP,DR(1)="10;"
221 S DR="1.5///^S X=UPDATE;1.1///^S X=ACCEPT;1.2///^S X=DT;1.3////^S X=DUZ"
222 D ^DIE
223 S VALMBCK="R"
224 ;update screen list
225 D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
226 D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
227 D WRITE^VALM10(EASLN)
228 Q
Note: See TracBrowser for help on using the repository browser.