EASEZU6 ;ALB/jap - Utilities for 1010EZ Processing ;10/31/00 13:08
;;1.0;ENROLLMENT APPLICATION SYSTEM;**53**;Mar 15, 2001
;
ANAME(EASLN,LN,DATANM) ;special update logic for Names
;output UPDATE = new data entered by user thru input transform
;
N SUBIEN,MULTIPLE,KEYIEN,DKEY,SECT,QUES,ORIGINAL,TYPE,XPART,KEY,SUB,NAME,UNAME,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
S DKEY=$P($G(^TMP("EZDATA",$J,KEYIEN)),U,4),SECT=$P(DKEY,";",1),QUES=$P(DKEY,";",2)
S X=$G(^TMP("EZTEMP",$J,SECT,MULTIPLE,QUES))
Q:$P(X,U,1)'=KEYIEN
S ORIGINAL=$P(X,U,2) K X
;user may update each name part
S TYPE=$P(DATANM," ",1)_" "
F XPART="LAST","FIRST","MIDDLE","SUFFIX" D Q:($D(DTOUT)!$D(DUOUT))
.;have keyien & subien (above) for last name, but need to get for each part
.S KEY=+$$KEY711^EASEZU1(TYPE_XPART_" NAME")
.Q:KEY<1
.;get name part & make sure it's all uppercase
.S X=$$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE)
.S NAME(XPART)=$$UC^EASEZT1($P(X,U,1)),SUB(XPART)=$P(X,U,2) K X
.S DIR("A")=TYPE_XPART_" NAME"
.I XPART="LAST" S DIR("??")="No punctuation is allowed other than ""-"" in a hyphenated name."
.E S DIR("??")="No punctuation or numerics are allowed."
.S X=$G(^EAS(711,KEY,3)) I X'="" X X
.;1st piece of DIR contains 'O', input is optional
.S:$G(DIR(0))="" DIR(0)="FO^1:30^K:X'?.A X"
.D ^DIR
.;don't continue if user exited w/o input
.Q:($D(DTOUT)!$D(DUOUT))
.;pickup the DIR output
.S UPDATE=$$UC^EASEZT1($G(Y)),UNAME(XPART)=UPDATE
.I UNAME(XPART)="" S UNAME(XPART)=$G(NAME(XPART))
Q:($D(DTOUT)!$D(DUOUT))
K DIR,DTOUT,DUOUT,DIRUT
;file data element; a manually updated element is always 'accepted'
F XPART="LAST","FIRST","MIDDLE","SUFFIX" D
.Q:$G(UNAME(XPART))=$G(NAME(XPART)) Q:$G(UNAME(XPART))=""
.S DIE="^EAS(712,EASAPP,10,",DA=SUB(XPART),DA(1)=EASAPP,DR(1)="10;"
.S DR="1///^S X=UNAME(XPART);1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
.D ^DIE
;put together updated full name
S X=UNAME("LAST")_","_UNAME("FIRST")
I $G(UNAME("MIDDLE"))'="" D
.I $L(X)+$L(UNAME("MIDDLE"))>45 S MDL=$E(UNAME("MIDDLE"),1),X=X_" "_MDL
.E S X=X_" "_UNAME("MIDDLE")
I $G(UNAME("SUFFIX"))'="" S X=X_" "_UNAME("SUFFIX")
S UPDATE=X
S VALMBCK="R"
;update screen list
Q:UPDATE=ORIGINAL
D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
D WRITE^VALM10(EASLN)
Q
;
APHONE(EASLN,LN,DATANM) ;special update logic for Phone Numbers
;
N SUBIEN,MULTIPLE,KEYIEN,DKEY,SECT,QUES,ORIGINAL,TYPE,XPART,KEY,SUB,PHONE,UPHONE,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
S DKEY=$P($G(^TMP("EZDATA",$J,KEYIEN)),U,4),SECT=$P(DKEY,";",1),QUES=$P(DKEY,";",2)
S X=$G(^TMP("EZTEMP",$J,SECT,MULTIPLE,QUES))
Q:$P(X,U,1)'=KEYIEN
S ORIGINAL=$P(X,U,2) K X
;user may update each phone number part
S TYPE=$P(DATANM," ",1,3)_" "
F XPART="AREA CODE","NUMBER","EXTENSION" D Q:($D(DTOUT)!$D(DUOUT))
.;have keyien & subien (above) for area code, but need to get for each part
.S KEY=+$$KEY711^EASEZU1(TYPE_XPART)
.Q:KEY<1
.;get phone number part
.S X=$$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE)
.S PHONE(XPART)=$P(X,U,1),SUB(XPART)=$P(X,U,2) K X
.S DIR("A")=TYPE_XPART
.I XPART="NUMBER" S DIR("?")="Use format nnn-nnnn. Example: 222-1234"
.I XPART="EXTENSION" S DIR("?")="Use up to 5 digits; no other characters. Example: 12345"
.S X=$G(^EAS(711,KEY,3)) I X'="" X X
.;1st piece of DIR contains 'O', input is optional
.S:$G(DIR(0))="" DIR(0)="FO^1:8"
.D ^DIR
.;don't continue if user exited w/o input
.Q:($D(DTOUT)!$D(DUOUT))
.;pickup the DIR output
.S UPDATE=$G(Y),UPHONE(XPART)=UPDATE
.I UPHONE(XPART)="" S UPHONE(XPART)=$G(PHONE(XPART))
Q:($D(DTOUT)!$D(DUOUT))
K DIR,DTOUT,DUOUT,DIRUT
;file data element; a manually updated element is always 'accepted'
F XPART="AREA CODE","NUMBER","EXTENSION" D
.Q:$G(UPHONE(XPART))=$G(PHONE(XPART)) Q:$G(UPHONE(XPART))=""
.S DIE="^EAS(712,EASAPP,10,",DA=SUB(XPART),DA(1)=EASAPP,DR(1)="10;"
.S DR="1///^S X=UPHONE(XPART);1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
.D ^DIE
;put together updated full phone number
S X=$G(UPHONE("NUMBER"))
I $G(UPHONE("AREA CODE")) S X="("_UPHONE("AREA CODE")_")"_X
I $G(UPHONE("EXTENSION"))'="" S X=X_" X"_UPHONE("EXTENSION")
S UPDATE=X
S VALMBCK="R"
;update screen list
Q:UPDATE=ORIGINAL
D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
D WRITE^VALM10(EASLN)
Q
;
ASTATE(EASLN,LN,DATANM) ;special update logic for any STATE
;
N I,SUBIEN,MULTIPLE,KEYIEN,ORIGINAL,IEN,ABBR,AB,ZX,OUT,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
S ORIGINAL=$P($G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),U,1)
S DIR("A")=DATANM
S DIR(0)="P^5:EMZ"
D ^DIR
;don't continue if user exited w/o input
Q:($D(DTOUT)!$D(DUOUT))
K DIR,DTOUT,DUOUT,DIRUT
;pickup the DIR output
S UPDATE=$P($G(Y(0)),U,1)
;don't continue if no data
Q:UPDATE=""
;don't continue if no change to data
Q:UPDATE=ORIGINAL
S IEN=$P(Y,U,1)
S ABBR=$P($G(^DIC(5,IEN,0)),U,2)
;make sure abbrev. matches web-based app
S OUT=0 F I=1:1 S X=$P($T(STDAT+I),";;",2) Q:X="QUIT" Q:OUT D
.S AB=$P(X,";",1),ZX=$P(X,";",2)
.I (ZX[UPDATE)!(UPDATE[ZX) S ABBR=AB,OUT=1
;file data element; a manually updated element is always 'accepted'
S DIE="^EAS(712,EASAPP,10,",DA=SUBIEN,DA(1)=EASAPP,DR(1)="10;"
S DR="1///^S X=ABBR;1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
D ^DIE
S VALMBCK="R"
;update screen list
D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
D WRITE^VALM10(EASLN)
Q
;
STDAT ;
;;AS;AMERICAN SAMOA
;;DC;DISTRICT OF COLUMBIA
;;FM;FEDERATED STATES OF MICRONESIA
;;GU;GUAM
;;MH;MARSHALL ISLANDS
;;MP;NORTHERN MARIANA ISLANDS
;;PW;PALAU (TRUST TERRITORY)
;;PR;PUERTO RICO
;;VI;VIRGIN ISLANDS
;;QUIT
;
ACOUNTY(EASLN,LN,DATANM) ;special update logic for COUNTY
;
N SUBIEN,MULTIPLE,KEYIEN,ORIGINAL,KEY,ABBR,STATE,SIEN,CIEN,CCODE,ROOT,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
S LN=^TMP("EASEXP",$J,"IDX",EASLN),SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
S ORIGINAL=$P($G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),U,1)
S KEY=+$$KEY711^EASEZU1("APPLICANT STATE")
Q:'KEY
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))
Q:'SIEN
S ROOT="DIC(5,"_SIEN_",1,"
S DIR("A")=DATANM
S DIR(0)="P"_U_ROOT_":QEMZ"
D ^DIR
;don't continue if user exited w/o input
Q:($D(DTOUT)!$D(DUOUT))
K DIR,DTOUT,DUOUT,DIRUT
;pickup the DIR output
S UPDATE=$P($G(Y(0)),U,1)
;don't continue if no data
Q:UPDATE=""
S CIEN=$P(Y,U,1) I CIEN'="" S CCODE=$P($G(^DIC(5,SIEN,1,CIEN,0)),U,3)
S COUNTY=UPDATE I CCODE'="" S UPDATE=UPDATE_" ("_CCODE_")"
;don't continue if no change to data
Q:UPDATE=ORIGINAL
;file data element; a manually updated element is always 'accepted'
S DIE="^EAS(712,EASAPP,10,",DA=SUBIEN,DA(1)=EASAPP,DR(1)="10;"
S DR="1///^S X=COUNTY;1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
D ^DIE
S VALMBCK="R"
;update screen list
D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
D WRITE^VALM10(EASLN)
Q
;
ASSN(EASLN,LN,DATANM,ACCEPT) ;special update logic for Spouse/Dependent SSN
N OUT,DIR,DIRUT,DTOUT,DUOUT,UPDATE,LINK13,OTHER,RESULT
;only used if DATANM["SOCIAL SECURITY NUMBER" and FILE'=2
S OUT=0,UPDATE="" F D Q:OUT
.S DIR("A")=DATANM
.S DIR(0)="F^11:11^K:X'?3N1""-""2N1""-""4N X",DIR("?")="Use format nnn-nnn-nnn. Example: 222-33-4444"
.D ^DIR
.I $D(DIRUT) S OUT=1 Q
.I ($D(DTOUT)!$D(DUOUT)) S OUT=1 Q
.;pickup the DIR output
.S UPDATE=$P($G(Y(0)),U,1) S:UPDATE="" UPDATE=$P($G(Y),U,1)
.;don't continue if no data
.I UPDATE="" S OUT=1 Q
.S UPDATE=$TR(UPDATE,"-","")
.S LINK13=$P($G(^EAS(712,EASAPP,10,SUBIEN,2)),U,2)
.S RESULT="",OTHER=0
.F S OTHER=$O(^DGPR(408.13,"SSN",UPDATE,OTHER)) Q:OTHER="" Q:RESULT="^" I OTHER,LINK13,OTHER'=LINK13 D
..S RESULT="^"
..W !,?3,"Sorry... that SSN is already used by another person"
..W !,?3,"in the INCOME PERSON File (#408.13). Try again."
.I RESULT="^" S UPDATE=""
.I UPDATE'="" S OUT=1
;file the update, if any
Q:UPDATE=""
I 'ACCEPT S ACCEPT=1
S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
S $P(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1),U,1,2)=UPDATE_U_ACCEPT
;file data element; any manually updated element is 'accepted'
S DIE="^EAS(712,EASAPP,10,",DA=SUBIEN,DA(1)=EASAPP,DR(1)="10;"
S DR="1.5///^S X=UPDATE;1.1///^S X=ACCEPT;1.2///^S X=DT;1.3////^S X=DUZ"
D ^DIE
S VALMBCK="R"
;update screen list
D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
D WRITE^VALM10(EASLN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZU6 8954 printed Oct 16, 2024@17:56:05 Page 2
EASEZU6 ;ALB/jap - Utilities for 1010EZ Processing ;10/31/00 13:08
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**53**;Mar 15, 2001
+2 ;
ANAME(EASLN,LN,DATANM) ;special update logic for Names
+1 ;output UPDATE = new data entered by user thru input transform
+2 ;
+3 NEW SUBIEN,MULTIPLE,KEYIEN,DKEY,SECT,QUES,ORIGINAL,TYPE,XPART,KEY,SUB,NAME,UNAME,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
+4 SET SUBIEN=$PIECE(LN,U,1)
SET MULTIPLE=$PIECE(LN,U,2)
SET KEYIEN=$PIECE(LN,U,3)
+5 SET DKEY=$PIECE($GET(^TMP("EZDATA",$JOB,KEYIEN)),U,4)
SET SECT=$PIECE(DKEY,";",1)
SET QUES=$PIECE(DKEY,";",2)
+6 SET X=$GET(^TMP("EZTEMP",$JOB,SECT,MULTIPLE,QUES))
+7 if $PIECE(X,U,1)'=KEYIEN
QUIT
+8 SET ORIGINAL=$PIECE(X,U,2)
KILL X
+9 ;user may update each name part
+10 SET TYPE=$PIECE(DATANM," ",1)_" "
+11 FOR XPART="LAST","FIRST","MIDDLE","SUFFIX"
Begin DoDot:1
+12 ;have keyien & subien (above) for last name, but need to get for each part
+13 SET KEY=+$$KEY711^EASEZU1(TYPE_XPART_" NAME")
+14 if KEY<1
QUIT
+15 ;get name part & make sure it's all uppercase
+16 SET X=$$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE)
+17 SET NAME(XPART)=$$UC^EASEZT1($PIECE(X,U,1))
SET SUB(XPART)=$PIECE(X,U,2)
KILL X
+18 SET DIR("A")=TYPE_XPART_" NAME"
+19 IF XPART="LAST"
SET DIR("??")="No punctuation is allowed other than ""-"" in a hyphenated name."
+20 IF '$TEST
SET DIR("??")="No punctuation or numerics are allowed."
+21 SET X=$GET(^EAS(711,KEY,3))
IF X'=""
XECUTE X
+22 ;1st piece of DIR contains 'O', input is optional
+23 if $GET(DIR(0))=""
SET DIR(0)="FO^1:30^K:X'?.A X"
+24 DO ^DIR
+25 ;don't continue if user exited w/o input
+26 if ($DATA(DTOUT)!$DATA(DUOUT))
QUIT
+27 ;pickup the DIR output
+28 SET UPDATE=$$UC^EASEZT1($GET(Y))
SET UNAME(XPART)=UPDATE
+29 IF UNAME(XPART)=""
SET UNAME(XPART)=$GET(NAME(XPART))
End DoDot:1
if ($DATA(DTOUT)!$DATA(DUOUT))
QUIT
+30 if ($DATA(DTOUT)!$DATA(DUOUT))
QUIT
+31 KILL DIR,DTOUT,DUOUT,DIRUT
+32 ;file data element; a manually updated element is always 'accepted'
+33 FOR XPART="LAST","FIRST","MIDDLE","SUFFIX"
Begin DoDot:1
+34 if $GET(UNAME(XPART))=$GET(NAME(XPART))
QUIT
if $GET(UNAME(XPART))=""
QUIT
+35 SET DIE="^EAS(712,EASAPP,10,"
SET DA=SUB(XPART)
SET DA(1)=EASAPP
SET DR(1)="10;"
+36 SET DR="1///^S X=UNAME(XPART);1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
+37 DO ^DIE
End DoDot:1
+38 ;put together updated full name
+39 SET X=UNAME("LAST")_","_UNAME("FIRST")
+40 IF $GET(UNAME("MIDDLE"))'=""
Begin DoDot:1
+41 IF $LENGTH(X)+$LENGTH(UNAME("MIDDLE"))>45
SET MDL=$EXTRACT(UNAME("MIDDLE"),1)
SET X=X_" "_MDL
+42 IF '$TEST
SET X=X_" "_UNAME("MIDDLE")
End DoDot:1
+43 IF $GET(UNAME("SUFFIX"))'=""
SET X=X_" "_UNAME("SUFFIX")
+44 SET UPDATE=X
+45 SET VALMBCK="R"
+46 ;update screen list
+47 if UPDATE=ORIGINAL
QUIT
+48 DO FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
+49 DO FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
+50 DO WRITE^VALM10(EASLN)
+51 QUIT
+52 ;
APHONE(EASLN,LN,DATANM) ;special update logic for Phone Numbers
+1 ;
+2 NEW SUBIEN,MULTIPLE,KEYIEN,DKEY,SECT,QUES,ORIGINAL,TYPE,XPART,KEY,SUB,PHONE,UPHONE,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 SET SUBIEN=$PIECE(LN,U,1)
SET MULTIPLE=$PIECE(LN,U,2)
SET KEYIEN=$PIECE(LN,U,3)
+4 SET DKEY=$PIECE($GET(^TMP("EZDATA",$JOB,KEYIEN)),U,4)
SET SECT=$PIECE(DKEY,";",1)
SET QUES=$PIECE(DKEY,";",2)
+5 SET X=$GET(^TMP("EZTEMP",$JOB,SECT,MULTIPLE,QUES))
+6 if $PIECE(X,U,1)'=KEYIEN
QUIT
+7 SET ORIGINAL=$PIECE(X,U,2)
KILL X
+8 ;user may update each phone number part
+9 SET TYPE=$PIECE(DATANM," ",1,3)_" "
+10 FOR XPART="AREA CODE","NUMBER","EXTENSION"
Begin DoDot:1
+11 ;have keyien & subien (above) for area code, but need to get for each part
+12 SET KEY=+$$KEY711^EASEZU1(TYPE_XPART)
+13 if KEY<1
QUIT
+14 ;get phone number part
+15 SET X=$$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE)
+16 SET PHONE(XPART)=$PIECE(X,U,1)
SET SUB(XPART)=$PIECE(X,U,2)
KILL X
+17 SET DIR("A")=TYPE_XPART
+18 IF XPART="NUMBER"
SET DIR("?")="Use format nnn-nnnn. Example: 222-1234"
+19 IF XPART="EXTENSION"
SET DIR("?")="Use up to 5 digits; no other characters. Example: 12345"
+20 SET X=$GET(^EAS(711,KEY,3))
IF X'=""
XECUTE X
+21 ;1st piece of DIR contains 'O', input is optional
+22 if $GET(DIR(0))=""
SET DIR(0)="FO^1:8"
+23 DO ^DIR
+24 ;don't continue if user exited w/o input
+25 if ($DATA(DTOUT)!$DATA(DUOUT))
QUIT
+26 ;pickup the DIR output
+27 SET UPDATE=$GET(Y)
SET UPHONE(XPART)=UPDATE
+28 IF UPHONE(XPART)=""
SET UPHONE(XPART)=$GET(PHONE(XPART))
End DoDot:1
if ($DATA(DTOUT)!$DATA(DUOUT))
QUIT
+29 if ($DATA(DTOUT)!$DATA(DUOUT))
QUIT
+30 KILL DIR,DTOUT,DUOUT,DIRUT
+31 ;file data element; a manually updated element is always 'accepted'
+32 FOR XPART="AREA CODE","NUMBER","EXTENSION"
Begin DoDot:1
+33 if $GET(UPHONE(XPART))=$GET(PHONE(XPART))
QUIT
if $GET(UPHONE(XPART))=""
QUIT
+34 SET DIE="^EAS(712,EASAPP,10,"
SET DA=SUB(XPART)
SET DA(1)=EASAPP
SET DR(1)="10;"
+35 SET DR="1///^S X=UPHONE(XPART);1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
+36 DO ^DIE
End DoDot:1
+37 ;put together updated full phone number
+38 SET X=$GET(UPHONE("NUMBER"))
+39 IF $GET(UPHONE("AREA CODE"))
SET X="("_UPHONE("AREA CODE")_")"_X
+40 IF $GET(UPHONE("EXTENSION"))'=""
SET X=X_" X"_UPHONE("EXTENSION")
+41 SET UPDATE=X
+42 SET VALMBCK="R"
+43 ;update screen list
+44 if UPDATE=ORIGINAL
QUIT
+45 DO FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
+46 DO FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
+47 DO WRITE^VALM10(EASLN)
+48 QUIT
+49 ;
ASTATE(EASLN,LN,DATANM) ;special update logic for any STATE
+1 ;
+2 NEW I,SUBIEN,MULTIPLE,KEYIEN,ORIGINAL,IEN,ABBR,AB,ZX,OUT,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 SET SUBIEN=$PIECE(LN,U,1)
SET MULTIPLE=$PIECE(LN,U,2)
SET KEYIEN=$PIECE(LN,U,3)
+4 SET ORIGINAL=$PIECE($GET(^TMP("EZDATA",$JOB,KEYIEN,MULTIPLE,1)),U,1)
+5 SET DIR("A")=DATANM
+6 SET DIR(0)="P^5:EMZ"
+7 DO ^DIR
+8 ;don't continue if user exited w/o input
+9 if ($DATA(DTOUT)!$DATA(DUOUT))
QUIT
+10 KILL DIR,DTOUT,DUOUT,DIRUT
+11 ;pickup the DIR output
+12 SET UPDATE=$PIECE($GET(Y(0)),U,1)
+13 ;don't continue if no data
+14 if UPDATE=""
QUIT
+15 ;don't continue if no change to data
+16 if UPDATE=ORIGINAL
QUIT
+17 SET IEN=$PIECE(Y,U,1)
+18 SET ABBR=$PIECE($GET(^DIC(5,IEN,0)),U,2)
+19 ;make sure abbrev. matches web-based app
+20 SET OUT=0
FOR I=1:1
SET X=$PIECE($TEXT(STDAT+I),";;",2)
if X="QUIT"
QUIT
if OUT
QUIT
Begin DoDot:1
+21 SET AB=$PIECE(X,";",1)
SET ZX=$PIECE(X,";",2)
+22 IF (ZX[UPDATE)!(UPDATE[ZX)
SET ABBR=AB
SET OUT=1
End DoDot:1
+23 ;file data element; a manually updated element is always 'accepted'
+24 SET DIE="^EAS(712,EASAPP,10,"
SET DA=SUBIEN
SET DA(1)=EASAPP
SET DR(1)="10;"
+25 SET DR="1///^S X=ABBR;1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
+26 DO ^DIE
+27 SET VALMBCK="R"
+28 ;update screen list
+29 DO FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
+30 DO FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
+31 DO WRITE^VALM10(EASLN)
+32 QUIT
+33 ;
STDAT ;
+1 ;;AS;AMERICAN SAMOA
+2 ;;DC;DISTRICT OF COLUMBIA
+3 ;;FM;FEDERATED STATES OF MICRONESIA
+4 ;;GU;GUAM
+5 ;;MH;MARSHALL ISLANDS
+6 ;;MP;NORTHERN MARIANA ISLANDS
+7 ;;PW;PALAU (TRUST TERRITORY)
+8 ;;PR;PUERTO RICO
+9 ;;VI;VIRGIN ISLANDS
+10 ;;QUIT
+11 ;
ACOUNTY(EASLN,LN,DATANM) ;special update logic for COUNTY
+1 ;
+2 NEW SUBIEN,MULTIPLE,KEYIEN,ORIGINAL,KEY,ABBR,STATE,SIEN,CIEN,CCODE,ROOT,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 SET LN=^TMP("EASEXP",$JOB,"IDX",EASLN)
SET SUBIEN=$PIECE(LN,U,1)
SET MULTIPLE=$PIECE(LN,U,2)
SET KEYIEN=$PIECE(LN,U,3)
+4 SET ORIGINAL=$PIECE($GET(^TMP("EZDATA",$JOB,KEYIEN,MULTIPLE,1)),U,1)
+5 SET KEY=+$$KEY711^EASEZU1("APPLICANT STATE")
+6 if 'KEY
QUIT
+7 SET ABBR=""
SET STATE=""
SET SIEN=""
SET CIEN=""
SET CCODE=""
+8 IF KEY
Begin DoDot:1
+9 SET ABBR=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,1),U,1)
+10 IF ABBR'=""
SET STATE=$$STATE^EASEZT1(ABBR)
+11 IF STATE'=""
SET SIEN=$ORDER(^DIC(5,"B",STATE,0))
End DoDot:1
+12 if 'SIEN
QUIT
+13 SET ROOT="DIC(5,"_SIEN_",1,"
+14 SET DIR("A")=DATANM
+15 SET DIR(0)="P"_U_ROOT_":QEMZ"
+16 DO ^DIR
+17 ;don't continue if user exited w/o input
+18 if ($DATA(DTOUT)!$DATA(DUOUT))
QUIT
+19 KILL DIR,DTOUT,DUOUT,DIRUT
+20 ;pickup the DIR output
+21 SET UPDATE=$PIECE($GET(Y(0)),U,1)
+22 ;don't continue if no data
+23 if UPDATE=""
QUIT
+24 SET CIEN=$PIECE(Y,U,1)
IF CIEN'=""
SET CCODE=$PIECE($GET(^DIC(5,SIEN,1,CIEN,0)),U,3)
+25 SET COUNTY=UPDATE
IF CCODE'=""
SET UPDATE=UPDATE_" ("_CCODE_")"
+26 ;don't continue if no change to data
+27 if UPDATE=ORIGINAL
QUIT
+28 ;file data element; a manually updated element is always 'accepted'
+29 SET DIE="^EAS(712,EASAPP,10,"
SET DA=SUBIEN
SET DA(1)=EASAPP
SET DR(1)="10;"
+30 SET DR="1///^S X=COUNTY;1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
+31 DO ^DIE
+32 SET VALMBCK="R"
+33 ;update screen list
+34 DO FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
+35 DO FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
+36 DO WRITE^VALM10(EASLN)
+37 QUIT
+38 ;
ASSN(EASLN,LN,DATANM,ACCEPT) ;special update logic for Spouse/Dependent SSN
+1 NEW OUT,DIR,DIRUT,DTOUT,DUOUT,UPDATE,LINK13,OTHER,RESULT
+2 ;only used if DATANM["SOCIAL SECURITY NUMBER" and FILE'=2
+3 SET OUT=0
SET UPDATE=""
FOR
Begin DoDot:1
+4 SET DIR("A")=DATANM
+5 SET DIR(0)="F^11:11^K:X'?3N1""-""2N1""-""4N X"
SET DIR("?")="Use format nnn-nnn-nnn. Example: 222-33-4444"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
SET OUT=1
QUIT
+8 IF ($DATA(DTOUT)!$DATA(DUOUT))
SET OUT=1
QUIT
+9 ;pickup the DIR output
+10 SET UPDATE=$PIECE($GET(Y(0)),U,1)
if UPDATE=""
SET UPDATE=$PIECE($GET(Y),U,1)
+11 ;don't continue if no data
+12 IF UPDATE=""
SET OUT=1
QUIT
+13 SET UPDATE=$TRANSLATE(UPDATE,"-","")
+14 SET LINK13=$PIECE($GET(^EAS(712,EASAPP,10,SUBIEN,2)),U,2)
+15 SET RESULT=""
SET OTHER=0
+16 FOR
SET OTHER=$ORDER(^DGPR(408.13,"SSN",UPDATE,OTHER))
if OTHER=""
QUIT
if RESULT="^"
QUIT
IF OTHER
IF LINK13
IF OTHER'=LINK13
Begin DoDot:2
+17 SET RESULT="^"
+18 WRITE !,?3,"Sorry... that SSN is already used by another person"
+19 WRITE !,?3,"in the INCOME PERSON File (#408.13). Try again."
End DoDot:2
+20 IF RESULT="^"
SET UPDATE=""
+21 IF UPDATE'=""
SET OUT=1
End DoDot:1
if OUT
QUIT
+22 ;file the update, if any
+23 if UPDATE=""
QUIT
+24 IF 'ACCEPT
SET ACCEPT=1
+25 SET SUBIEN=$PIECE(LN,U,1)
SET MULTIPLE=$PIECE(LN,U,2)
SET KEYIEN=$PIECE(LN,U,3)
+26 SET $PIECE(^TMP("EZDATA",$JOB,KEYIEN,MULTIPLE,1),U,1,2)=UPDATE_U_ACCEPT
+27 ;file data element; any manually updated element is 'accepted'
+28 SET DIE="^EAS(712,EASAPP,10,"
SET DA=SUBIEN
SET DA(1)=EASAPP
SET DR(1)="10;"
+29 SET DR="1.5///^S X=UPDATE;1.1///^S X=ACCEPT;1.2///^S X=DT;1.3////^S X=DUZ"
+30 DO ^DIE
+31 SET VALMBCK="R"
+32 ;update screen list
+33 DO FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
+34 DO FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
+35 DO WRITE^VALM10(EASLN)
+36 QUIT
