- 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 Jan 18, 2025@02:56:25 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 ;