EAS1070P ;ALB/AMA - Patch EAS*1.0*70 Post-Install Utility Routine ; 2/6/09 1:37pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**70**;Mar 15, 2001;Build 26
Q
EN ;
;Check to see how much of this routine has already executed
N START,EASIEN,EASPP S START=0
S EASIEN=$O(^EAS(711,"AB","CHILD1 FARM OR BUSINESS INCOME","")) Q:'EASIEN
I $G(^EAS(711,EASIEN,1))="0^0^0" S START=1
S EASIEN=+$$KEY711^EASEZU1("APPLICANT COUNTRY")
I EASIEN'=.1 S START=2
S EASAPP=$P(^EAS(712,0),U,3)
I (EASIEN'=.1),$D(^EAS(712,+EASAPP,10,"B",EASIEN)) Q
;
I START<1 D UPDATE
I START<2 D ADDFLDS
I START<3 D ADDCTRY
Q
UPDATE ;Update the 1010 Mapping File (#711) with numerous changes
N LINE,CHGS,OLDNM,NEWNM,FSF,DISPNM,NEWHLP,FOUND,DIC,X,TEMP,Y,DIE,DR
W !!,"Updating the 1010 Mapping (#711) File..."
F LINE=1:1 S CHGS=$T(CHANGES+LINE) Q:($P(CHGS,";",3)="END") D
. ;FORMAT= OLD NAME;NEW NAME;NEW FILE^SUBFILE^FIELD;NEW DISPLAY LABEL;NEW HELP ROUTINE;
. S OLDNM=$P(CHGS,";",3),NEWNM=$P(CHGS,";",4),FSF=$P(CHGS,";",5)
. S DISPNM=$P(CHGS,";",6),NEWHLP=$P(CHGS,";",7),FOUND=0
. ;
. S DIC="^EAS(711,",DIC(0)="M",X=OLDNM D ^DIC
. I +Y=-1 D
. . S TEMP=$E(OLDNM,1,30),(DA,FOUND)=0
. . F S DA=$O(^EAS(711,"B",TEMP,DA)) Q:'DA!FOUND D
. . . I $P(^EAS(711,DA,0),"^")=OLDNM S FOUND=DA
. I (+Y=-1),'FOUND Q
. I FOUND S Y=FOUND
. ;
. S DA=+Y,DIE=DIC
. ;
. I NEWNM]"" S DR=".01///"_NEWNM D ^DIE
. I FSF]"" F X=2,3,4 S DR=X_"///"_$P(FSF,"^",(X-1)) D ^DIE
. I DISPNM]"" S DR="5///"_DISPNM D ^DIE
. I NEWHLP]"" S DR="6///"_NEWHLP D ^DIE
;
W " DONE!"
Q
ADDFLDS ;Add new 1010 Mapping File (711) fields APPLICANT
;PROVINCE, APPPLICANT COUNTRY, AND APPLICANT POSTAL CODE
N X,EASIEN,DINUM,DIC,DIE,DLAYGO,ACTIVE,VERSION,FILE,SUB,EASKEY,FIELD,DISPLAY,TRNSFRM
W !!,"Adding APPLICANT PROVINCE, APPLICANT POSTAL CODE, and"
W !,"APPLICANT COUNTRY fields to the 1010 Mapping (#711) File..."
F X="APPLICANT PROVINCE","APPLICANT POSTAL CODE","APPLICANT COUNTRY" D
. S EASIEN=+$$KEY711^EASEZU1(X)
. I EASIEN'=.1 Q
. S (EASIEN,DINUM)=$O(^EAS(711,99999999),-1)+1
. S (DIC,DIE)="^EAS(711,",DIC(0)="L",DLAYGO=""
. K DD,DO D FILE^DICN
. S ACTIVE="A",VERSION="3.0",(FILE,SUB)=2
. I X="APPLICANT PROVINCE" D
. . S EASKEY="I;9F.",FIELD=.1171,DISPLAY="Province"
. I X="APPLICANT POSTAL CODE" D
. . S EASKEY="I;9G.",FIELD=.1172,DISPLAY="Postal Code"
. I X="APPLICANT COUNTRY" D
. . S EASKEY="I;9H.",FIELD=.1173,DISPLAY="Country",TRNSFRM="S EASRTR=$$COUNTRY^EASEZT1(EZDATA)"
. S DA=EASIEN,DR=".1///^S X=EASKEY;1///^S X=ACTIVE;1.2///^S X=VERSION;2///^S X=FILE;3///^S X=SUB;4///^S X=FIELD;5///^S X=DISPLAY;"
. I $G(TRNSFRM)]"" S DR=DR_"10///^S X=TRNSFRM;"
. D ^DIE
W " DONE!"
Q
ADDCTRY ;Loop through all existing Holding File (712) applications
;and add the APPLICANT COUNTRY field entry
N KEYIEN,EASAPP,X,EASKEY,EASDATA,EASIEN
N DINUM,DIC,DIE,DLAYGO,DA,DR,MULTIPLE,ACCEPT
W !!,"Populating APPLICANT COUNTRY fields with 'USA' in all existing applications..."
S KEYIEN=+$$KEY711^EASEZU1("APPLICANT COUNTRY")
S EASAPP=0 F S EASAPP=$O(^EAS(712,EASAPP)) Q:'EASAPP D
. I '$D(^EAS(712,EASAPP,10,"B",KEYIEN)) D
. . S X=KEYIEN,EASKEY="I;9H.",EASDATA="USA"
. . S (EASIEN,DINUM)=$O(^EAS(712,EASAPP,10,"B"),-1)+1
. . S (DIC,DIE)="^EAS(712,EASAPP,10,",DIC(0)="L",DLAYGO=""
. . S DA(1)=EASAPP,DIC("P")=$P(^DD(712,10,0),U,2)
. . K DD,DO D FILE^DICN
. . S DA=EASIEN,DR(1)="10;",MULTIPLE=1,ACCEPT=1
. . S DR=".1///^S X=MULTIPLE;1///^S X=EASDATA;1.1///^S X=ACCEPT;"
. . D ^DIE
W " DONE!",!!
Q
CHANGES ;FORMAT = OLD NAME;NEW NAME;NEW FILE^SUBFILE^FIELD;NEW DISPLAY LABEL;NEW HELP ROUTINE;
;;CHILD1 GROSS ANNUAL INCOME;CHILD1 EMPLOYMENT INCOME;0^0^0;Employment Inc.(Ch+);;
;;APPLICANT OTHER INCOME;APPLICANT OTHER INCOME AMOUNTS;;;D H08^EASEZDD2;
;;SPOUSE OTHER INCOME;SPOUSE OTHER INCOME AMOUNTS;;;D H08^EASEZDD2;
;;CHILD1 OTHER INCOME;CHILD1 OTHER INCOME AMOUNTS;0^0^0;;;
;;APPLICANT MEDICAL EXPENSES;APPLICANT TOTAL NON-REIMBURSED MEDICAL EXPENSES;;NonReimb. Med. Exp.;;
;;APPLICANT FUNERAL EXPENSES;;;;D H102^EASEZDD2;
;;APPLICANT CASH IN BANK;;;;D H201^EASEZDD2;
;;SPOUSE CASH IN BANK;;;;D H201^EASEZDD2;
;;APPLICANT REAL PROPERTY LESS MORTGAGES;APPLICANT LAND/BLDGS. LESS MORTGAGES;;Land/Bldgs.;D H203^EASEZDD2;
;;SPOUSE REAL PROPERTY LESS MORTGAGES;SPOUSE LAND/BLDGS. LESS MORTGAGES;;Land/Bldgs. (Sp.);D HD203^EASEZDD2;
;;APPLICANT STOCKS BONDS ASSETS LESS DEBTS;APPLICANT OTHER PROPERTY, ASSETS LESS AMT. OWED;;;D H204^EASEZDD2;
;;SPOUSE STOCKS BONDS ASSETS LESS DEBTS;SPOUSE OTHER PROPERTY, ASSETS LESS AMT. OWED;;;D H204^EASEZDD2;
;;APPLICANT FARM OR BUSINESS INCOME;;;;D H17^EASEZDD2;
;;SPOUSE FARM OR BUSINESS INCOME;;;;D H17^EASEZDD2;
;;CHILD(N) GROSS ANNUAL INCOME;CHILD(N) EMPLOYMENT INCOME;; Employment Income;D H14^EASEZDD2;
;;CHILD(N) FARM/BUS INCOME;;;;D H17^EASEZDD2;
;;CHILD(N) OTHER INCOME;CHILD(N) OTHER INCOME AMOUNTS;;;D H08^EASEZDD2;
;;ASSET(N) CHILD CASH;ASSET(N) CASH IN BANK;408.21^408.21^2.01;;D H201^EASEZDD2;
;;ASSET(N) CHILD REAL PROPERTY;ASSET(N) LAND/BLDGS. LESS MORTGAGES;408.21^408.21^2.03; Land/Bldgs.;D HD203^EASEZDD2;
;;ASSET(N) CHILD OTHER PROPERTY;ASSET(N) OTHER PROPERTY, ASSETS LESS AMT. OWED;408.21^408.21^2.04;;D H204^EASEZDD2;
;;CHILD1 REAL PROPERTY LESS MORTGAGES;CHILD1 LAND/BLDGS. LESS MORTGAGES;;Land/Bldgs. (Ch+);;
;;CHILD1 STOCKS BONDS ASSETS LESS DEBTS;CHILD1 OTHER PROPERTY, ASSETS LESS AMT. OWED;;;;
;;APPLICANT GROSS ANNUAL INCOME2;APPLICANT EMPLOYMENT INCOME;;Employment Income;D H14^EASEZDD2;
;;SPOUSE GROSS ANNUAL INCOME2;SPOUSE EMPLOYMENT INCOME;;Employment Inc. (Sp);D H14^EASEZDD2;
;;CHILD1 GROSS ANNUAL INCOME2;;0^0^0;Employment Inc.(Ch+);;
;;CHILD1 FARM OR BUSINESS INCOME;;0^0^0;;;
;;END;END;;;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS1070P 5779 printed Apr 09, 2024@21:00:48 Page 2
EAS1070P ;ALB/AMA - Patch EAS*1.0*70 Post-Install Utility Routine ; 2/6/09 1:37pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**70**;Mar 15, 2001;Build 26
+2 QUIT
EN ;
+1 ;Check to see how much of this routine has already executed
+2 NEW START,EASIEN,EASPP
SET START=0
+3 SET EASIEN=$ORDER(^EAS(711,"AB","CHILD1 FARM OR BUSINESS INCOME",""))
if 'EASIEN
QUIT
+4 IF $GET(^EAS(711,EASIEN,1))="0^0^0"
SET START=1
+5 SET EASIEN=+$$KEY711^EASEZU1("APPLICANT COUNTRY")
+6 IF EASIEN'=.1
SET START=2
+7 SET EASAPP=$PIECE(^EAS(712,0),U,3)
+8 IF (EASIEN'=.1)
IF $DATA(^EAS(712,+EASAPP,10,"B",EASIEN))
QUIT
+9 ;
+10 IF START<1
DO UPDATE
+11 IF START<2
DO ADDFLDS
+12 IF START<3
DO ADDCTRY
+13 QUIT
UPDATE ;Update the 1010 Mapping File (#711) with numerous changes
+1 NEW LINE,CHGS,OLDNM,NEWNM,FSF,DISPNM,NEWHLP,FOUND,DIC,X,TEMP,Y,DIE,DR
+2 WRITE !!,"Updating the 1010 Mapping (#711) File..."
+3 FOR LINE=1:1
SET CHGS=$TEXT(CHANGES+LINE)
if ($PIECE(CHGS,";",3)="END")
QUIT
Begin DoDot:1
+4 ;FORMAT= OLD NAME;NEW NAME;NEW FILE^SUBFILE^FIELD;NEW DISPLAY LABEL;NEW HELP ROUTINE;
+5 SET OLDNM=$PIECE(CHGS,";",3)
SET NEWNM=$PIECE(CHGS,";",4)
SET FSF=$PIECE(CHGS,";",5)
+6 SET DISPNM=$PIECE(CHGS,";",6)
SET NEWHLP=$PIECE(CHGS,";",7)
SET FOUND=0
+7 ;
+8 SET DIC="^EAS(711,"
SET DIC(0)="M"
SET X=OLDNM
DO ^DIC
+9 IF +Y=-1
Begin DoDot:2
+10 SET TEMP=$EXTRACT(OLDNM,1,30)
SET (DA,FOUND)=0
+11 FOR
SET DA=$ORDER(^EAS(711,"B",TEMP,DA))
if 'DA!FOUND
QUIT
Begin DoDot:3
+12 IF $PIECE(^EAS(711,DA,0),"^")=OLDNM
SET FOUND=DA
End DoDot:3
End DoDot:2
+13 IF (+Y=-1)
IF 'FOUND
QUIT
+14 IF FOUND
SET Y=FOUND
+15 ;
+16 SET DA=+Y
SET DIE=DIC
+17 ;
+18 IF NEWNM]""
SET DR=".01///"_NEWNM
DO ^DIE
+19 IF FSF]""
FOR X=2,3,4
SET DR=X_"///"_$PIECE(FSF,"^",(X-1))
DO ^DIE
+20 IF DISPNM]""
SET DR="5///"_DISPNM
DO ^DIE
+21 IF NEWHLP]""
SET DR="6///"_NEWHLP
DO ^DIE
End DoDot:1
+22 ;
+23 WRITE " DONE!"
+24 QUIT
ADDFLDS ;Add new 1010 Mapping File (711) fields APPLICANT
+1 ;PROVINCE, APPPLICANT COUNTRY, AND APPLICANT POSTAL CODE
+2 NEW X,EASIEN,DINUM,DIC,DIE,DLAYGO,ACTIVE,VERSION,FILE,SUB,EASKEY,FIELD,DISPLAY,TRNSFRM
+3 WRITE !!,"Adding APPLICANT PROVINCE, APPLICANT POSTAL CODE, and"
+4 WRITE !,"APPLICANT COUNTRY fields to the 1010 Mapping (#711) File..."
+5 FOR X="APPLICANT PROVINCE","APPLICANT POSTAL CODE","APPLICANT COUNTRY"
Begin DoDot:1
+6 SET EASIEN=+$$KEY711^EASEZU1(X)
+7 IF EASIEN'=.1
QUIT
+8 SET (EASIEN,DINUM)=$ORDER(^EAS(711,99999999),-1)+1
+9 SET (DIC,DIE)="^EAS(711,"
SET DIC(0)="L"
SET DLAYGO=""
+10 KILL DD,DO
DO FILE^DICN
+11 SET ACTIVE="A"
SET VERSION="3.0"
SET (FILE,SUB)=2
+12 IF X="APPLICANT PROVINCE"
Begin DoDot:2
+13 SET EASKEY="I;9F."
SET FIELD=.1171
SET DISPLAY="Province"
End DoDot:2
+14 IF X="APPLICANT POSTAL CODE"
Begin DoDot:2
+15 SET EASKEY="I;9G."
SET FIELD=.1172
SET DISPLAY="Postal Code"
End DoDot:2
+16 IF X="APPLICANT COUNTRY"
Begin DoDot:2
+17 SET EASKEY="I;9H."
SET FIELD=.1173
SET DISPLAY="Country"
SET TRNSFRM="S EASRTR=$$COUNTRY^EASEZT1(EZDATA)"
End DoDot:2
+18 SET DA=EASIEN
SET DR=".1///^S X=EASKEY;1///^S X=ACTIVE;1.2///^S X=VERSION;2///^S X=FILE;3///^S X=SUB;4///^S X=FIELD;5///^S X=DISPLAY;"
+19 IF $GET(TRNSFRM)]""
SET DR=DR_"10///^S X=TRNSFRM;"
+20 DO ^DIE
End DoDot:1
+21 WRITE " DONE!"
+22 QUIT
ADDCTRY ;Loop through all existing Holding File (712) applications
+1 ;and add the APPLICANT COUNTRY field entry
+2 NEW KEYIEN,EASAPP,X,EASKEY,EASDATA,EASIEN
+3 NEW DINUM,DIC,DIE,DLAYGO,DA,DR,MULTIPLE,ACCEPT
+4 WRITE !!,"Populating APPLICANT COUNTRY fields with 'USA' in all existing applications..."
+5 SET KEYIEN=+$$KEY711^EASEZU1("APPLICANT COUNTRY")
+6 SET EASAPP=0
FOR
SET EASAPP=$ORDER(^EAS(712,EASAPP))
if 'EASAPP
QUIT
Begin DoDot:1
+7 IF '$DATA(^EAS(712,EASAPP,10,"B",KEYIEN))
Begin DoDot:2
+8 SET X=KEYIEN
SET EASKEY="I;9H."
SET EASDATA="USA"
+9 SET (EASIEN,DINUM)=$ORDER(^EAS(712,EASAPP,10,"B"),-1)+1
+10 SET (DIC,DIE)="^EAS(712,EASAPP,10,"
SET DIC(0)="L"
SET DLAYGO=""
+11 SET DA(1)=EASAPP
SET DIC("P")=$PIECE(^DD(712,10,0),U,2)
+12 KILL DD,DO
DO FILE^DICN
+13 SET DA=EASIEN
SET DR(1)="10;"
SET MULTIPLE=1
SET ACCEPT=1
+14 SET DR=".1///^S X=MULTIPLE;1///^S X=EASDATA;1.1///^S X=ACCEPT;"
+15 DO ^DIE
End DoDot:2
End DoDot:1
+16 WRITE " DONE!",!!
+17 QUIT
CHANGES ;FORMAT = OLD NAME;NEW NAME;NEW FILE^SUBFILE^FIELD;NEW DISPLAY LABEL;NEW HELP ROUTINE;
+1 ;;CHILD1 GROSS ANNUAL INCOME;CHILD1 EMPLOYMENT INCOME;0^0^0;Employment Inc.(Ch+);;
+2 ;;APPLICANT OTHER INCOME;APPLICANT OTHER INCOME AMOUNTS;;;D H08^EASEZDD2;
+3 ;;SPOUSE OTHER INCOME;SPOUSE OTHER INCOME AMOUNTS;;;D H08^EASEZDD2;
+4 ;;CHILD1 OTHER INCOME;CHILD1 OTHER INCOME AMOUNTS;0^0^0;;;
+5 ;;APPLICANT MEDICAL EXPENSES;APPLICANT TOTAL NON-REIMBURSED MEDICAL EXPENSES;;NonReimb. Med. Exp.;;
+6 ;;APPLICANT FUNERAL EXPENSES;;;;D H102^EASEZDD2;
+7 ;;APPLICANT CASH IN BANK;;;;D H201^EASEZDD2;
+8 ;;SPOUSE CASH IN BANK;;;;D H201^EASEZDD2;
+9 ;;APPLICANT REAL PROPERTY LESS MORTGAGES;APPLICANT LAND/BLDGS. LESS MORTGAGES;;Land/Bldgs.;D H203^EASEZDD2;
+10 ;;SPOUSE REAL PROPERTY LESS MORTGAGES;SPOUSE LAND/BLDGS. LESS MORTGAGES;;Land/Bldgs. (Sp.);D HD203^EASEZDD2;
+11 ;;APPLICANT STOCKS BONDS ASSETS LESS DEBTS;APPLICANT OTHER PROPERTY, ASSETS LESS AMT. OWED;;;D H204^EASEZDD2;
+12 ;;SPOUSE STOCKS BONDS ASSETS LESS DEBTS;SPOUSE OTHER PROPERTY, ASSETS LESS AMT. OWED;;;D H204^EASEZDD2;
+13 ;;APPLICANT FARM OR BUSINESS INCOME;;;;D H17^EASEZDD2;
+14 ;;SPOUSE FARM OR BUSINESS INCOME;;;;D H17^EASEZDD2;
+15 ;;CHILD(N) GROSS ANNUAL INCOME;CHILD(N) EMPLOYMENT INCOME;; Employment Income;D H14^EASEZDD2;
+16 ;;CHILD(N) FARM/BUS INCOME;;;;D H17^EASEZDD2;
+17 ;;CHILD(N) OTHER INCOME;CHILD(N) OTHER INCOME AMOUNTS;;;D H08^EASEZDD2;
+18 ;;ASSET(N) CHILD CASH;ASSET(N) CASH IN BANK;408.21^408.21^2.01;;D H201^EASEZDD2;
+19 ;;ASSET(N) CHILD REAL PROPERTY;ASSET(N) LAND/BLDGS. LESS MORTGAGES;408.21^408.21^2.03; Land/Bldgs.;D HD203^EASEZDD2;
+20 ;;ASSET(N) CHILD OTHER PROPERTY;ASSET(N) OTHER PROPERTY, ASSETS LESS AMT. OWED;408.21^408.21^2.04;;D H204^EASEZDD2;
+21 ;;CHILD1 REAL PROPERTY LESS MORTGAGES;CHILD1 LAND/BLDGS. LESS MORTGAGES;;Land/Bldgs. (Ch+);;
+22 ;;CHILD1 STOCKS BONDS ASSETS LESS DEBTS;CHILD1 OTHER PROPERTY, ASSETS LESS AMT. OWED;;;;
+23 ;;APPLICANT GROSS ANNUAL INCOME2;APPLICANT EMPLOYMENT INCOME;;Employment Income;D H14^EASEZDD2;
+24 ;;SPOUSE GROSS ANNUAL INCOME2;SPOUSE EMPLOYMENT INCOME;;Employment Inc. (Sp);D H14^EASEZDD2;
+25 ;;CHILD1 GROSS ANNUAL INCOME2;;0^0^0;Employment Inc.(Ch+);;
+26 ;;CHILD1 FARM OR BUSINESS INCOME;;0^0^0;;;
+27 ;;END;END;;;;
