EASEZT1 ;ALB/jap - Data Transformation Logic for 1010EZ Processing ;10/12/00 13:08
;;1.0;ENROLLMENT APPLICATION SYSTEM;**51,70**;Mar 15, 2001;Build 26
;
;
NAME(EASAPP,TYPE,MULTIPLE) ;get full name for person of interest
;input EASAPP = application ien in file #712
; TYPE = "APPLICANT", "SPOUSE", "CHILD1", "CHILD(N)", "NEXT-OF-KIN", "E-CONTACT"
; MULTIPLE = default to 1, unless TYPE="CHILD(N)"
;output NAME = LAST,FIRST MIDDLE SUFFIX
;
;sets entire name in Vista format;
;places result in the first data element associated with name;
;nulls unneeded ^TMP("EZDATA" nodes to avoid use in SORT^EASEZC3
N RTR,KEY,NAME,LAST,FIRST,MDL,SUFF,T
S NAME=""
S KEY=+$$KEY711^EASEZU1(TYPE_" LAST NAME") I KEY D
.S LAST=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
S KEY=+$$KEY711^EASEZU1(TYPE_" FIRST NAME") I KEY D
.S FIRST=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
.F T=1,2 S ^TMP("EZDATA",$J,KEY,MULTIPLE,T)=""
S KEY=+$$KEY711^EASEZU1(TYPE_" MIDDLE NAME") I KEY D
.S MDL=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
.F T=1,2 S ^TMP("EZDATA",$J,KEY,MULTIPLE,T)=""
S KEY=+$$KEY711^EASEZU1(TYPE_" SUFFIX NAME") I KEY D
.S SUFF=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
.F T=1,2 S ^TMP("EZDATA",$J,KEY,MULTIPLE,T)=""
I (LAST="")!(FIRST="") Q NAME
S NAME=LAST_","_FIRST
I $L(NAME)+$L(MDL)>45 S MDL=$E(MDL,1)
I MDL'="" S NAME=NAME_" "_MDL
I SUFF'="" S NAME=NAME_" "_SUFF
S NAME=$$UC^EASEZT1($E(NAME,1,45))
Q NAME
;
SSNOUT(EASSSN) ;format ssn for output to display or print
; input EASSSN = 9 digit OR 9-digit+P ssn
; output SSN = nnn-nn-nnnn OR nnn-nn-nnnnP
N SSN,P,X1,X2,X3
I EASSSN="--" Q ""
I $L(EASSSN)'=9 Q EASSSN
S X1=$E(EASSSN,1,3),X2=$E(EASSSN,4,5),X3=$E(EASSSN,6,9),P=$E(EASSSN,10)
S SSN=X1_"-"_X2_"-"_X3 I P="P" S SSN=SSN_P
Q SSN
;
UC(STRING) ;convert to uppercase
;input STRING = alpha character string; mixed-case
;output X = alpha character string; uppercase
;
N %,X
S X=STRING
F %=1:1:$L(X) S:$E(X,%)?1L X=$E(X,0,%-1)_$C($A(X,%)-32)_$E(X,%+1,999)
Q X
;
XDATE(XDATE) ;check date
;input XDATE = external date mm/dd/yyyy where
; mm, dd, and /or yyyy may be null
;output XD = FM external date or null
;
N X,XD,X1,X2,X3,Y,%DT
I XDATE="//" Q ""
S X1=$P(XDATE,"/",1),X2=$P(XDATE,"/",2),X3=$P(XDATE,"/",3)
;remove invalid portions
I $L(X3)'=4 S X3=""
I X1="" S X2=""
I X3="" S X1="",X2=""
;if no month, day, year, then null
I X1="",X2="",X3="" Q ""
S X="" S:X1 X=X_X1_" " S:X2 X=X_X2_" " S X=X_X3
;convert to FM external format
S %DT="P" D ^%DT
D DD^%DT
S XD=Y
I XD=1699 S XD=""
Q XD
;
YN(XDATA) ;
N X
I $L(XDATA)>1 Q XDATA
S X=$S(XDATA="Y":"YES",XDATA="N":"NO",1:"")
Q X
;
SEX(XDATA) ;
N X
I $L(XDATA)>1 Q XDATA
S X=$S(XDATA="M":"MALE",XDATA="F":"FEMALE",1:"UNKNOWN")
Q X
;
STATE(XDATA) ;
N X,XI
I $L(XDATA)'=2 Q XDATA
I XDATA="AS" Q "AMERICAN SAMOA"
I XDATA="DC" Q "DISTRICT OF COLUMBIA"
I XDATA="FM" Q "FEDERATED STATES OF MICRONESIA"
I XDATA="GU" Q "GUAM"
I XDATA="MH" Q "MARSHALL ISLANDS"
I XDATA="MP" Q "NORTHERN MARIANA ISLANDS"
I XDATA="PW" Q "PALAU (TRUST TERRITORY)"
I XDATA="PR" Q "PUERTO RICO"
I XDATA="VI" Q "VIRGIN ISLANDS"
I XDATA="FG" Q "FOREIGN COUNTRY"
S XI=$O(^DIC(5,"C",XDATA,0)) I 'XI Q XDATA
S X=$P($G(^DIC(5,XI,0)),U,1)
Q X
;
COUNTY(EASAPP,XDATA) ;include county code
;this transform can only be used for APPLICANT COUNTY
N X,ABBR,STATE,SIEN,CIEN,CCODE
I XDATA="" Q XDATA
S KEY=+$$KEY711^EASEZU1("APPLICANT STATE")
I 'KEY Q XDATA
S ABBR="",STATE="",SIEN="",CIEN="",CCODE=""
I KEY D
.S ABBR=$P($$DATA712^EASEZU1(EASAPP,KEY,1),U,1)
.I ABBR'="" S STATE=$$STATE^EASEZT1(ABBR)
.I STATE'="" S SIEN=$O(^DIC(5,"B",STATE,0))
.I SIEN'="" S CIEN=$O(^DIC(5,SIEN,1,"B",XDATA,0))
.I CIEN'="" S CCODE=$P($G(^DIC(5,SIEN,1,CIEN,0)),U,3)
I CCODE'="" S XDATA=XDATA_" ("_CCODE_")"
Q XDATA
;
ETHNIC(XDATA) ;
N X
I ($L(XDATA)>1)!(XDATA="") Q XDATA
S X=$S(XDATA="Y":"YES",XDATA="N":"NO",XDATA="U":"UNKNOWN",1:"")
I X'="" S X=X_" (S)"
Q X
;
RACE(XDATA) ;
N X
I $L(XDATA)>1 Q XDATA
S X=$S(XDATA="Y":"YES (S)",1:"")
Q X
;
LAST(XDATA) ; return LAST NAME, first middle
Q $$UC($P($G(XDATA),","))
;
COUNTRY(XDATA) ;
; Input: 3 character COUNTRY CODE (from file # 779.004)
; Output: POSTAL NAME, if it exists
; DESCRIPTION, if POSTAL NAME="<NULL>"
; -1, if invalid
N RSLT
S RSLT=$$COUNTRY^DGADDUTL(XDATA)
Q $S(RSLT=-1:"",1:RSLT)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZT1 4577 printed Apr 09, 2024@20:59:35 Page 2
EASEZT1 ;ALB/jap - Data Transformation Logic for 1010EZ Processing ;10/12/00 13:08
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**51,70**;Mar 15, 2001;Build 26
+2 ;
+3 ;
NAME(EASAPP,TYPE,MULTIPLE) ;get full name for person of interest
+1 ;input EASAPP = application ien in file #712
+2 ; TYPE = "APPLICANT", "SPOUSE", "CHILD1", "CHILD(N)", "NEXT-OF-KIN", "E-CONTACT"
+3 ; MULTIPLE = default to 1, unless TYPE="CHILD(N)"
+4 ;output NAME = LAST,FIRST MIDDLE SUFFIX
+5 ;
+6 ;sets entire name in Vista format;
+7 ;places result in the first data element associated with name;
+8 ;nulls unneeded ^TMP("EZDATA" nodes to avoid use in SORT^EASEZC3
+9 NEW RTR,KEY,NAME,LAST,FIRST,MDL,SUFF,T
+10 SET NAME=""
+11 SET KEY=+$$KEY711^EASEZU1(TYPE_" LAST NAME")
IF KEY
Begin DoDot:1
+12 SET LAST=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
End DoDot:1
+13 SET KEY=+$$KEY711^EASEZU1(TYPE_" FIRST NAME")
IF KEY
Begin DoDot:1
+14 SET FIRST=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
+15 FOR T=1,2
SET ^TMP("EZDATA",$JOB,KEY,MULTIPLE,T)=""
End DoDot:1
+16 SET KEY=+$$KEY711^EASEZU1(TYPE_" MIDDLE NAME")
IF KEY
Begin DoDot:1
+17 SET MDL=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
+18 FOR T=1,2
SET ^TMP("EZDATA",$JOB,KEY,MULTIPLE,T)=""
End DoDot:1
+19 SET KEY=+$$KEY711^EASEZU1(TYPE_" SUFFIX NAME")
IF KEY
Begin DoDot:1
+20 SET SUFF=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
+21 FOR T=1,2
SET ^TMP("EZDATA",$JOB,KEY,MULTIPLE,T)=""
End DoDot:1
+22 IF (LAST="")!(FIRST="")
QUIT NAME
+23 SET NAME=LAST_","_FIRST
+24 IF $LENGTH(NAME)+$LENGTH(MDL)>45
SET MDL=$EXTRACT(MDL,1)
+25 IF MDL'=""
SET NAME=NAME_" "_MDL
+26 IF SUFF'=""
SET NAME=NAME_" "_SUFF
+27 SET NAME=$$UC^EASEZT1($EXTRACT(NAME,1,45))
+28 QUIT NAME
+29 ;
SSNOUT(EASSSN) ;format ssn for output to display or print
+1 ; input EASSSN = 9 digit OR 9-digit+P ssn
+2 ; output SSN = nnn-nn-nnnn OR nnn-nn-nnnnP
+3 NEW SSN,P,X1,X2,X3
+4 IF EASSSN="--"
QUIT ""
+5 IF $LENGTH(EASSSN)'=9
QUIT EASSSN
+6 SET X1=$EXTRACT(EASSSN,1,3)
SET X2=$EXTRACT(EASSSN,4,5)
SET X3=$EXTRACT(EASSSN,6,9)
SET P=$EXTRACT(EASSSN,10)
+7 SET SSN=X1_"-"_X2_"-"_X3
IF P="P"
SET SSN=SSN_P
+8 QUIT SSN
+9 ;
UC(STRING) ;convert to uppercase
+1 ;input STRING = alpha character string; mixed-case
+2 ;output X = alpha character string; uppercase
+3 ;
+4 NEW %,X
+5 SET X=STRING
+6 FOR %=1:1:$LENGTH(X)
if $EXTRACT(X,%)?1L
SET X=$EXTRACT(X,0,%-1)_$CHAR($ASCII(X,%)-32)_$EXTRACT(X,%+1,999)
+7 QUIT X
+8 ;
XDATE(XDATE) ;check date
+1 ;input XDATE = external date mm/dd/yyyy where
+2 ; mm, dd, and /or yyyy may be null
+3 ;output XD = FM external date or null
+4 ;
+5 NEW X,XD,X1,X2,X3,Y,%DT
+6 IF XDATE="//"
QUIT ""
+7 SET X1=$PIECE(XDATE,"/",1)
SET X2=$PIECE(XDATE,"/",2)
SET X3=$PIECE(XDATE,"/",3)
+8 ;remove invalid portions
+9 IF $LENGTH(X3)'=4
SET X3=""
+10 IF X1=""
SET X2=""
+11 IF X3=""
SET X1=""
SET X2=""
+12 ;if no month, day, year, then null
+13 IF X1=""
IF X2=""
IF X3=""
QUIT ""
+14 SET X=""
if X1
SET X=X_X1_" "
if X2
SET X=X_X2_" "
SET X=X_X3
+15 ;convert to FM external format
+16 SET %DT="P"
DO ^%DT
+17 DO DD^%DT
+18 SET XD=Y
+19 IF XD=1699
SET XD=""
+20 QUIT XD
+21 ;
YN(XDATA) ;
+1 NEW X
+2 IF $LENGTH(XDATA)>1
QUIT XDATA
+3 SET X=$SELECT(XDATA="Y":"YES",XDATA="N":"NO",1:"")
+4 QUIT X
+5 ;
SEX(XDATA) ;
+1 NEW X
+2 IF $LENGTH(XDATA)>1
QUIT XDATA
+3 SET X=$SELECT(XDATA="M":"MALE",XDATA="F":"FEMALE",1:"UNKNOWN")
+4 QUIT X
+5 ;
STATE(XDATA) ;
+1 NEW X,XI
+2 IF $LENGTH(XDATA)'=2
QUIT XDATA
+3 IF XDATA="AS"
QUIT "AMERICAN SAMOA"
+4 IF XDATA="DC"
QUIT "DISTRICT OF COLUMBIA"
+5 IF XDATA="FM"
QUIT "FEDERATED STATES OF MICRONESIA"
+6 IF XDATA="GU"
QUIT "GUAM"
+7 IF XDATA="MH"
QUIT "MARSHALL ISLANDS"
+8 IF XDATA="MP"
QUIT "NORTHERN MARIANA ISLANDS"
+9 IF XDATA="PW"
QUIT "PALAU (TRUST TERRITORY)"
+10 IF XDATA="PR"
QUIT "PUERTO RICO"
+11 IF XDATA="VI"
QUIT "VIRGIN ISLANDS"
+12 IF XDATA="FG"
QUIT "FOREIGN COUNTRY"
+13 SET XI=$ORDER(^DIC(5,"C",XDATA,0))
IF 'XI
QUIT XDATA
+14 SET X=$PIECE($GET(^DIC(5,XI,0)),U,1)
+15 QUIT X
+16 ;
COUNTY(EASAPP,XDATA) ;include county code
+1 ;this transform can only be used for APPLICANT COUNTY
+2 NEW X,ABBR,STATE,SIEN,CIEN,CCODE
+3 IF XDATA=""
QUIT XDATA
+4 SET KEY=+$$KEY711^EASEZU1("APPLICANT STATE")
+5 IF 'KEY
QUIT XDATA
+6 SET ABBR=""
SET STATE=""
SET SIEN=""
SET CIEN=""
SET CCODE=""
+7 IF KEY
Begin DoDot:1
+8 SET ABBR=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,1),U,1)
+9 IF ABBR'=""
SET STATE=$$STATE^EASEZT1(ABBR)
+10 IF STATE'=""
SET SIEN=$ORDER(^DIC(5,"B",STATE,0))
+11 IF SIEN'=""
SET CIEN=$ORDER(^DIC(5,SIEN,1,"B",XDATA,0))
+12 IF CIEN'=""
SET CCODE=$PIECE($GET(^DIC(5,SIEN,1,CIEN,0)),U,3)
End DoDot:1
+13 IF CCODE'=""
SET XDATA=XDATA_" ("_CCODE_")"
+14 QUIT XDATA
+15 ;
ETHNIC(XDATA) ;
+1 NEW X
+2 IF ($LENGTH(XDATA)>1)!(XDATA="")
QUIT XDATA
+3 SET X=$SELECT(XDATA="Y":"YES",XDATA="N":"NO",XDATA="U":"UNKNOWN",1:"")
+4 IF X'=""
SET X=X_" (S)"
+5 QUIT X
+6 ;
RACE(XDATA) ;
+1 NEW X
+2 IF $LENGTH(XDATA)>1
QUIT XDATA
+3 SET X=$SELECT(XDATA="Y":"YES (S)",1:"")
+4 QUIT X
+5 ;
LAST(XDATA) ; return LAST NAME, first middle
+1 QUIT $$UC($PIECE($GET(XDATA),","))
+2 ;
COUNTRY(XDATA) ;
+1 ; Input: 3 character COUNTRY CODE (from file # 779.004)
+2 ; Output: POSTAL NAME, if it exists
+3 ; DESCRIPTION, if POSTAL NAME="<NULL>"
+4 ; -1, if invalid
+5 NEW RSLT
+6 SET RSLT=$$COUNTRY^DGADDUTL(XDATA)
+7 QUIT $SELECT(RSLT=-1:"",1:RSLT)
+8 ;
