229 lines
8.5 KiB
Mathematica
229 lines
8.5 KiB
Mathematica
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
|