Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EASEZU6

EASEZU6.m

Go to the documentation of this file.
  1. EASEZU6 ;ALB/jap - Utilities for 1010EZ Processing ;10/31/00 13:08
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**53**;Mar 15, 2001
  1. ;
  1. ANAME(EASLN,LN,DATANM) ;special update logic for Names
  1. ;output UPDATE = new data entered by user thru input transform
  1. ;
  1. N SUBIEN,MULTIPLE,KEYIEN,DKEY,SECT,QUES,ORIGINAL,TYPE,XPART,KEY,SUB,NAME,UNAME,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
  1. S DKEY=$P($G(^TMP("EZDATA",$J,KEYIEN)),U,4),SECT=$P(DKEY,";",1),QUES=$P(DKEY,";",2)
  1. S X=$G(^TMP("EZTEMP",$J,SECT,MULTIPLE,QUES))
  1. Q:$P(X,U,1)'=KEYIEN
  1. S ORIGINAL=$P(X,U,2) K X
  1. ;user may update each name part
  1. S TYPE=$P(DATANM," ",1)_" "
  1. F XPART="LAST","FIRST","MIDDLE","SUFFIX" D Q:($D(DTOUT)!$D(DUOUT))
  1. .;have keyien & subien (above) for last name, but need to get for each part
  1. .S KEY=+$$KEY711^EASEZU1(TYPE_XPART_" NAME")
  1. .Q:KEY<1
  1. .;get name part & make sure it's all uppercase
  1. .S X=$$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE)
  1. .S NAME(XPART)=$$UC^EASEZT1($P(X,U,1)),SUB(XPART)=$P(X,U,2) K X
  1. .S DIR("A")=TYPE_XPART_" NAME"
  1. .I XPART="LAST" S DIR("??")="No punctuation is allowed other than ""-"" in a hyphenated name."
  1. .E S DIR("??")="No punctuation or numerics are allowed."
  1. .S X=$G(^EAS(711,KEY,3)) I X'="" X X
  1. .;1st piece of DIR contains 'O', input is optional
  1. .S:$G(DIR(0))="" DIR(0)="FO^1:30^K:X'?.A X"
  1. .D ^DIR
  1. .;don't continue if user exited w/o input
  1. .Q:($D(DTOUT)!$D(DUOUT))
  1. .;pickup the DIR output
  1. .S UPDATE=$$UC^EASEZT1($G(Y)),UNAME(XPART)=UPDATE
  1. .I UNAME(XPART)="" S UNAME(XPART)=$G(NAME(XPART))
  1. Q:($D(DTOUT)!$D(DUOUT))
  1. K DIR,DTOUT,DUOUT,DIRUT
  1. ;file data element; a manually updated element is always 'accepted'
  1. F XPART="LAST","FIRST","MIDDLE","SUFFIX" D
  1. .Q:$G(UNAME(XPART))=$G(NAME(XPART)) Q:$G(UNAME(XPART))=""
  1. .S DIE="^EAS(712,EASAPP,10,",DA=SUB(XPART),DA(1)=EASAPP,DR(1)="10;"
  1. .S DR="1///^S X=UNAME(XPART);1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
  1. .D ^DIE
  1. ;put together updated full name
  1. S X=UNAME("LAST")_","_UNAME("FIRST")
  1. I $G(UNAME("MIDDLE"))'="" D
  1. .I $L(X)+$L(UNAME("MIDDLE"))>45 S MDL=$E(UNAME("MIDDLE"),1),X=X_" "_MDL
  1. .E S X=X_" "_UNAME("MIDDLE")
  1. I $G(UNAME("SUFFIX"))'="" S X=X_" "_UNAME("SUFFIX")
  1. S UPDATE=X
  1. S VALMBCK="R"
  1. ;update screen list
  1. Q:UPDATE=ORIGINAL
  1. D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
  1. D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
  1. D WRITE^VALM10(EASLN)
  1. Q
  1. ;
  1. APHONE(EASLN,LN,DATANM) ;special update logic for Phone Numbers
  1. ;
  1. N SUBIEN,MULTIPLE,KEYIEN,DKEY,SECT,QUES,ORIGINAL,TYPE,XPART,KEY,SUB,PHONE,UPHONE,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
  1. S DKEY=$P($G(^TMP("EZDATA",$J,KEYIEN)),U,4),SECT=$P(DKEY,";",1),QUES=$P(DKEY,";",2)
  1. S X=$G(^TMP("EZTEMP",$J,SECT,MULTIPLE,QUES))
  1. Q:$P(X,U,1)'=KEYIEN
  1. S ORIGINAL=$P(X,U,2) K X
  1. ;user may update each phone number part
  1. S TYPE=$P(DATANM," ",1,3)_" "
  1. F XPART="AREA CODE","NUMBER","EXTENSION" D Q:($D(DTOUT)!$D(DUOUT))
  1. .;have keyien & subien (above) for area code, but need to get for each part
  1. .S KEY=+$$KEY711^EASEZU1(TYPE_XPART)
  1. .Q:KEY<1
  1. .;get phone number part
  1. .S X=$$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE)
  1. .S PHONE(XPART)=$P(X,U,1),SUB(XPART)=$P(X,U,2) K X
  1. .S DIR("A")=TYPE_XPART
  1. .I XPART="NUMBER" S DIR("?")="Use format nnn-nnnn. Example: 222-1234"
  1. .I XPART="EXTENSION" S DIR("?")="Use up to 5 digits; no other characters. Example: 12345"
  1. .S X=$G(^EAS(711,KEY,3)) I X'="" X X
  1. .;1st piece of DIR contains 'O', input is optional
  1. .S:$G(DIR(0))="" DIR(0)="FO^1:8"
  1. .D ^DIR
  1. .;don't continue if user exited w/o input
  1. .Q:($D(DTOUT)!$D(DUOUT))
  1. .;pickup the DIR output
  1. .S UPDATE=$G(Y),UPHONE(XPART)=UPDATE
  1. .I UPHONE(XPART)="" S UPHONE(XPART)=$G(PHONE(XPART))
  1. Q:($D(DTOUT)!$D(DUOUT))
  1. K DIR,DTOUT,DUOUT,DIRUT
  1. ;file data element; a manually updated element is always 'accepted'
  1. F XPART="AREA CODE","NUMBER","EXTENSION" D
  1. .Q:$G(UPHONE(XPART))=$G(PHONE(XPART)) Q:$G(UPHONE(XPART))=""
  1. .S DIE="^EAS(712,EASAPP,10,",DA=SUB(XPART),DA(1)=EASAPP,DR(1)="10;"
  1. .S DR="1///^S X=UPHONE(XPART);1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
  1. .D ^DIE
  1. ;put together updated full phone number
  1. S X=$G(UPHONE("NUMBER"))
  1. I $G(UPHONE("AREA CODE")) S X="("_UPHONE("AREA CODE")_")"_X
  1. I $G(UPHONE("EXTENSION"))'="" S X=X_" X"_UPHONE("EXTENSION")
  1. S UPDATE=X
  1. S VALMBCK="R"
  1. ;update screen list
  1. Q:UPDATE=ORIGINAL
  1. D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
  1. D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
  1. D WRITE^VALM10(EASLN)
  1. Q
  1. ;
  1. ASTATE(EASLN,LN,DATANM) ;special update logic for any STATE
  1. ;
  1. N I,SUBIEN,MULTIPLE,KEYIEN,ORIGINAL,IEN,ABBR,AB,ZX,OUT,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
  1. S ORIGINAL=$P($G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),U,1)
  1. S DIR("A")=DATANM
  1. S DIR(0)="P^5:EMZ"
  1. D ^DIR
  1. ;don't continue if user exited w/o input
  1. Q:($D(DTOUT)!$D(DUOUT))
  1. K DIR,DTOUT,DUOUT,DIRUT
  1. ;pickup the DIR output
  1. S UPDATE=$P($G(Y(0)),U,1)
  1. ;don't continue if no data
  1. Q:UPDATE=""
  1. ;don't continue if no change to data
  1. Q:UPDATE=ORIGINAL
  1. S IEN=$P(Y,U,1)
  1. S ABBR=$P($G(^DIC(5,IEN,0)),U,2)
  1. ;make sure abbrev. matches web-based app
  1. S OUT=0 F I=1:1 S X=$P($T(STDAT+I),";;",2) Q:X="QUIT" Q:OUT D
  1. .S AB=$P(X,";",1),ZX=$P(X,";",2)
  1. .I (ZX[UPDATE)!(UPDATE[ZX) S ABBR=AB,OUT=1
  1. ;file data element; a manually updated element is always 'accepted'
  1. S DIE="^EAS(712,EASAPP,10,",DA=SUBIEN,DA(1)=EASAPP,DR(1)="10;"
  1. S DR="1///^S X=ABBR;1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
  1. D ^DIE
  1. S VALMBCK="R"
  1. ;update screen list
  1. D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
  1. D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
  1. D WRITE^VALM10(EASLN)
  1. Q
  1. ;
  1. STDAT ;
  1. ;;AS;AMERICAN SAMOA
  1. ;;DC;DISTRICT OF COLUMBIA
  1. ;;FM;FEDERATED STATES OF MICRONESIA
  1. ;;GU;GUAM
  1. ;;MH;MARSHALL ISLANDS
  1. ;;MP;NORTHERN MARIANA ISLANDS
  1. ;;PW;PALAU (TRUST TERRITORY)
  1. ;;PR;PUERTO RICO
  1. ;;VI;VIRGIN ISLANDS
  1. ;;QUIT
  1. ;
  1. ACOUNTY(EASLN,LN,DATANM) ;special update logic for COUNTY
  1. ;
  1. N SUBIEN,MULTIPLE,KEYIEN,ORIGINAL,KEY,ABBR,STATE,SIEN,CIEN,CCODE,ROOT,UPDATE,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. S LN=^TMP("EASEXP",$J,"IDX",EASLN),SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
  1. S ORIGINAL=$P($G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),U,1)
  1. S KEY=+$$KEY711^EASEZU1("APPLICANT STATE")
  1. Q:'KEY
  1. S ABBR="",STATE="",SIEN="",CIEN="",CCODE=""
  1. I KEY D
  1. .S ABBR=$P($$DATA712^EASEZU1(EASAPP,KEY,1),U,1)
  1. .I ABBR'="" S STATE=$$STATE^EASEZT1(ABBR)
  1. .I STATE'="" S SIEN=$O(^DIC(5,"B",STATE,0))
  1. Q:'SIEN
  1. S ROOT="DIC(5,"_SIEN_",1,"
  1. S DIR("A")=DATANM
  1. S DIR(0)="P"_U_ROOT_":QEMZ"
  1. D ^DIR
  1. ;don't continue if user exited w/o input
  1. Q:($D(DTOUT)!$D(DUOUT))
  1. K DIR,DTOUT,DUOUT,DIRUT
  1. ;pickup the DIR output
  1. S UPDATE=$P($G(Y(0)),U,1)
  1. ;don't continue if no data
  1. Q:UPDATE=""
  1. S CIEN=$P(Y,U,1) I CIEN'="" S CCODE=$P($G(^DIC(5,SIEN,1,CIEN,0)),U,3)
  1. S COUNTY=UPDATE I CCODE'="" S UPDATE=UPDATE_" ("_CCODE_")"
  1. ;don't continue if no change to data
  1. Q:UPDATE=ORIGINAL
  1. ;file data element; a manually updated element is always 'accepted'
  1. S DIE="^EAS(712,EASAPP,10,",DA=SUBIEN,DA(1)=EASAPP,DR(1)="10;"
  1. S DR="1///^S X=COUNTY;1.1///^S X=1;1.2///^S X=DT;1.3////^S X=DUZ"
  1. D ^DIE
  1. S VALMBCK="R"
  1. ;update screen list
  1. D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
  1. D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
  1. D WRITE^VALM10(EASLN)
  1. Q
  1. ;
  1. ASSN(EASLN,LN,DATANM,ACCEPT) ;special update logic for Spouse/Dependent SSN
  1. N OUT,DIR,DIRUT,DTOUT,DUOUT,UPDATE,LINK13,OTHER,RESULT
  1. ;only used if DATANM["SOCIAL SECURITY NUMBER" and FILE'=2
  1. S OUT=0,UPDATE="" F D Q:OUT
  1. .S DIR("A")=DATANM
  1. .S DIR(0)="F^11:11^K:X'?3N1""-""2N1""-""4N X",DIR("?")="Use format nnn-nnn-nnn. Example: 222-33-4444"
  1. .D ^DIR
  1. .I $D(DIRUT) S OUT=1 Q
  1. .I ($D(DTOUT)!$D(DUOUT)) S OUT=1 Q
  1. .;pickup the DIR output
  1. .S UPDATE=$P($G(Y(0)),U,1) S:UPDATE="" UPDATE=$P($G(Y),U,1)
  1. .;don't continue if no data
  1. .I UPDATE="" S OUT=1 Q
  1. .S UPDATE=$TR(UPDATE,"-","")
  1. .S LINK13=$P($G(^EAS(712,EASAPP,10,SUBIEN,2)),U,2)
  1. .S RESULT="",OTHER=0
  1. .F S OTHER=$O(^DGPR(408.13,"SSN",UPDATE,OTHER)) Q:OTHER="" Q:RESULT="^" I OTHER,LINK13,OTHER'=LINK13 D
  1. ..S RESULT="^"
  1. ..W !,?3,"Sorry... that SSN is already used by another person"
  1. ..W !,?3,"in the INCOME PERSON File (#408.13). Try again."
  1. .I RESULT="^" S UPDATE=""
  1. .I UPDATE'="" S OUT=1
  1. ;file the update, if any
  1. Q:UPDATE=""
  1. I 'ACCEPT S ACCEPT=1
  1. S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
  1. S $P(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1),U,1,2)=UPDATE_U_ACCEPT
  1. ;file data element; any manually updated element is 'accepted'
  1. S DIE="^EAS(712,EASAPP,10,",DA=SUBIEN,DA(1)=EASAPP,DR(1)="10;"
  1. S DR="1.5///^S X=UPDATE;1.1///^S X=ACCEPT;1.2///^S X=DT;1.3////^S X=DUZ"
  1. D ^DIE
  1. S VALMBCK="R"
  1. ;update screen list
  1. D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
  1. D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
  1. D WRITE^VALM10(EASLN)
  1. Q