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