source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZT1.m@ 623

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1EASEZT1 ;ALB/jap - Data Transformation Logic for 1010EZ Processing ;10/12/00 13:08
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**51**;Mar 15, 2001
3 ;
4 ;
5NAME(EASAPP,TYPE,MULTIPLE) ;get full name for person of interest
6 ;input EASAPP = application ien in file #712
7 ; TYPE = "APPLICANT", "SPOUSE", "CHILD1", "CHILD(N)", "NEXT-OF-KIN", "E-CONTACT"
8 ; MULTIPLE = default to 1, unless TYPE="CHILD(N)"
9 ;output NAME = LAST,FIRST MIDDLE SUFFIX
10 ;
11 ;sets entire name in Vista format;
12 ;places result in the first data element associated with name;
13 ;nulls unneeded ^TMP("EZDATA" nodes to avoid use in SORT^EASEZC3
14 N RTR,KEY,NAME,LAST,FIRST,MDL,SUFF,T
15 S NAME=""
16 S KEY=+$$KEY711^EASEZU1(TYPE_" LAST NAME") I KEY D
17 .S LAST=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
18 S KEY=+$$KEY711^EASEZU1(TYPE_" FIRST NAME") I KEY D
19 .S FIRST=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
20 .F T=1,2 S ^TMP("EZDATA",$J,KEY,MULTIPLE,T)=""
21 S KEY=+$$KEY711^EASEZU1(TYPE_" MIDDLE NAME") I KEY D
22 .S MDL=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
23 .F T=1,2 S ^TMP("EZDATA",$J,KEY,MULTIPLE,T)=""
24 S KEY=+$$KEY711^EASEZU1(TYPE_" SUFFIX NAME") I KEY D
25 .S SUFF=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
26 .F T=1,2 S ^TMP("EZDATA",$J,KEY,MULTIPLE,T)=""
27 I (LAST="")!(FIRST="") Q NAME
28 S NAME=LAST_","_FIRST
29 I $L(NAME)+$L(MDL)>45 S MDL=$E(MDL,1)
30 I MDL'="" S NAME=NAME_" "_MDL
31 I SUFF'="" S NAME=NAME_" "_SUFF
32 S NAME=$$UC^EASEZT1($E(NAME,1,45))
33 Q NAME
34 ;
35SSNOUT(EASSSN) ;format ssn for output to display or print
36 ; input EASSSN = 9 digit OR 9-digit+P ssn
37 ; output SSN = nnn-nn-nnnn OR nnn-nn-nnnnP
38 N SSN,P,X1,X2,X3
39 I EASSSN="--" Q ""
40 I $L(EASSSN)'=9 Q EASSSN
41 S X1=$E(EASSSN,1,3),X2=$E(EASSSN,4,5),X3=$E(EASSSN,6,9),P=$E(EASSSN,10)
42 S SSN=X1_"-"_X2_"-"_X3 I P="P" S SSN=SSN_P
43 Q SSN
44 ;
45UC(STRING) ;convert to uppercase
46 ;input STRING = alpha character string; mixed-case
47 ;output X = alpha character string; uppercase
48 ;
49 N %,X
50 S X=STRING
51 F %=1:1:$L(X) S:$E(X,%)?1L X=$E(X,0,%-1)_$C($A(X,%)-32)_$E(X,%+1,999)
52 Q X
53 ;
54XDATE(XDATE) ;check date
55 ;input XDATE = external date mm/dd/yyyy where
56 ; mm, dd, and /or yyyy may be null
57 ;output XD = FM external date or null
58 ;
59 N X,XD,X1,X2,X3,Y,%DT
60 I XDATE="//" Q ""
61 S X1=$P(XDATE,"/",1),X2=$P(XDATE,"/",2),X3=$P(XDATE,"/",3)
62 ;remove invalid portions
63 I $L(X3)'=4 S X3=""
64 I X1="" S X2=""
65 I X3="" S X1="",X2=""
66 ;if no month, day, year, then null
67 I X1="",X2="",X3="" Q ""
68 S X="" S:X1 X=X_X1_" " S:X2 X=X_X2_" " S X=X_X3
69 ;convert to FM external format
70 S %DT="P" D ^%DT
71 D DD^%DT
72 S XD=Y
73 I XD=1699 S XD=""
74 Q XD
75 ;
76YN(XDATA) ;
77 N X
78 I $L(XDATA)>1 Q XDATA
79 S X=$S(XDATA="Y":"YES",XDATA="N":"NO",1:"")
80 Q X
81 ;
82SEX(XDATA) ;
83 N X
84 I $L(XDATA)>1 Q XDATA
85 S X=$S(XDATA="M":"MALE",XDATA="F":"FEMALE",1:"UNKNOWN")
86 Q X
87 ;
88STATE(XDATA) ;
89 N X,XI
90 I $L(XDATA)'=2 Q XDATA
91 I XDATA="AS" Q "AMERICAN SAMOA"
92 I XDATA="DC" Q "DISTRICT OF COLUMBIA"
93 I XDATA="FM" Q "FEDERATED STATES OF MICRONESIA"
94 I XDATA="GU" Q "GUAM"
95 I XDATA="MH" Q "MARSHALL ISLANDS"
96 I XDATA="MP" Q "NORTHERN MARIANA ISLANDS"
97 I XDATA="PW" Q "PALAU (TRUST TERRITORY)"
98 I XDATA="PR" Q "PUERTO RICO"
99 I XDATA="VI" Q "VIRGIN ISLANDS"
100 I XDATA="FG" Q "FOREIGN COUNTRY"
101 S XI=$O(^DIC(5,"C",XDATA,0)) I 'XI Q XDATA
102 S X=$P($G(^DIC(5,XI,0)),U,1)
103 Q X
104 ;
105COUNTY(EASAPP,XDATA) ;include county code
106 ;this transform can only be used for APPLICANT COUNTY
107 N X,ABBR,STATE,SIEN,CIEN,CCODE
108 I XDATA="" Q XDATA
109 S KEY=+$$KEY711^EASEZU1("APPLICANT STATE")
110 I 'KEY Q XDATA
111 S ABBR="",STATE="",SIEN="",CIEN="",CCODE=""
112 I KEY D
113 .S ABBR=$P($$DATA712^EASEZU1(EASAPP,KEY,1),U,1)
114 .I ABBR'="" S STATE=$$STATE^EASEZT1(ABBR)
115 .I STATE'="" S SIEN=$O(^DIC(5,"B",STATE,0))
116 .I SIEN'="" S CIEN=$O(^DIC(5,SIEN,1,"B",XDATA,0))
117 .I CIEN'="" S CCODE=$P($G(^DIC(5,SIEN,1,CIEN,0)),U,3)
118 I CCODE'="" S XDATA=XDATA_" ("_CCODE_")"
119 Q XDATA
120 ;
121ETHNIC(XDATA) ;
122 N X
123 I ($L(XDATA)>1)!(XDATA="") Q XDATA
124 S X=$S(XDATA="Y":"YES",XDATA="N":"NO",XDATA="U":"UNKNOWN",1:"")
125 I X'="" S X=X_" (S)"
126 Q X
127 ;
128RACE(XDATA) ;
129 N X
130 I $L(XDATA)>1 Q XDATA
131 S X=$S(XDATA="Y":"YES (S)",1:"")
132 Q X
133 ;
134LAST(XDATA) ; return LAST NAME, first middle
135 Q $$UC($P($G(XDATA),","))
136 ;
Note: See TracBrowser for help on using the repository browser.