EASEZU5 ;ALB/jap - Utilities for 1010EZ Processing ; 5/27/08 12:23pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,51,70**;Mar 15, 2001;Build 26
;
PRTCOMP ;print comparison of 10-10EZ data with VistA data
N ACTION
S ACTION="'Print Data'"
;no action if closed
I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
;proceed with print of data comparison
W !,"Data Print queued to background...",!
S VALMBCK="R"
D PAUSE^VALM1
Q
;
UPDATE ;update/overwrite a 10-10EZ data element
N ACTION,SIGDATE,EASSEL,EASERR,EASLN,LN,SUBIEN,MULTIPLE,KEYIEN,UPDATE,UPDATE2,FILE,SUBFILE,FLD,FFF
N ORIGINAL,DATANM,UPDATE,CODE,FILE,SUBFILE,FLD,FDEF,FTYPE,ROOT,SETCODES,MIN,MAX,X,Y,DA,DR,DIC,DIE,DIR,X1,X2,X3
;variable ORIGINAL holds original 1010EZ data
S ACTION="'Update Field'"
;no action if closed
I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
;invalid for the following process status
I EASPSTAT="NEW" D NOACT^EASEZLM("New",ACTION) Q
I EASPSTAT="PRT" D NOACT^EASEZLM("Unsigned",ACTION) Q
I EASPSTAT="FIL" D NOACT^EASEZLM("Filed",ACTION) Q
;select data item to update
S VALMBCK="R"
D SEL^EASEZLM
Q:$G(EASERR)
Q:'$G(EASSEL)
S EASLN=EASSEL
;
;use DIR reader to get input from user which overwrites 1010EZ data
D FULL^VALM1
S DIR(0)="",(FDEF,FTYPE)=""
S LN=^TMP("EASEXP",$J,"IDX",EASLN),SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
S X=$G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),ORIGINAL=$P(X,U,1),ACCEPT=$P(X,U,2)
S DATANM=$P($G(^EAS(711,KEYIEN,0)),U,1)
S:DATANM="ASSET(N) CASH IN BANK" DATANM="CHILD(N) CASH IN BANK"
S:DATANM="ASSET(N) LAND/BLDGS. LESS MORTGAGES" DATANM="CHILD(N) LAND/BLDGS. LESS MORTGAGES"
S:DATANM="ASSET(N) OTHER PROPERTY, ASSETS LESS AMT. OWED" DATANM="CHILD(N) LAND/BLDGS. LESS MORTGAGES"
S DIR("A")=DATANM
;if #3 of file #711 is defined then use to set DIR(0);
S X=$G(^EAS(711,KEYIEN,3)) I X'="" X X
S FFF=$G(^EAS(711,KEYIEN,1)),FILE=$P(FFF,U,1),SUBFILE=$P(FFF,U,2),FLD=$P(FFF,U,3)
;don't allow updates to data which cannot be filed
I ((FILE=0)!(ACCEPT=-1)) D Q
. W !!,?5,"Sorry...the selected data element cannot be 'Updated'."
. D ADDMSG ;alb/cmf/51
. W !!,?5,"After filing this Application to VistA, use Register a Patient "
. W !,?5,"or Patient Enrollment to enter/update data as needed.",!
. K DIR D PAUSE^VALM1 S VALMBCK="R"
;exceptions for data input; too complex for simple DIR call;
I DATANM["NAME",DATANM'["OTHER" D ANAME^EASEZU6(EASLN,LN,DATANM) Q
I DATANM["PHONE" D APHONE^EASEZU6(EASLN,LN,DATANM) Q
I DATANM["COUNTY" D ACOUNTY^EASEZU6(EASLN,LN,DATANM) Q
I DATANM["STATE" D ASTATE^EASEZU6(EASLN,LN,DATANM) Q
I DATANM["SOCIAL SECURITY NUMBER",FILE'=2 D ASSN^EASEZU6(EASLN,LN,DATANM,ACCEPT) Q
;setup DIR(0) for remaining mapped-to data elements
I DIR(0)="",FLD'=0 D
. ;use DIR read based on mapped-to file/field for all other data elements
. I (SUBFILE=FILE)!(SUBFILE="") S FDEF=FILE
. E S FDEF=SUBFILE
. S FTYPE=$$GET1^DID(FDEF,FLD,"","TYPE")
. ;can't use DD type read, some fields will error because DA is not defined for the input transform;
. ;so set DIR(0) according to field type of VistA target location instead;
. I FTYPE["POINTER" D
. . ;mapped to pointer field
. . S ROOT=$$GET1^DID(FDEF,FLD,"","POINTER")
. . I ROOT'="" S DIR(0)="P"_U_ROOT_":EMZ"
. I FTYPE="SET" D
. . ;mapped to set of codes field
. . S X=^DD(FDEF,FLD,0)
. . S SETCODES=$P(X,U,3) K X
. . S DIR(0)="S"_U_SETCODES
. I FTYPE="DATE/TIME" D
. . ;mapped to date/time field
. . S DIR(0)="D^::AEP"
. I FTYPE="FREE TEXT" D
. . ;mapped to free text field
. . S MAX=$$GET1^DID(FDEF,FLD,"","FIELD LENGTH")
. . I MAX S DIR(0)="F^1:"_MAX
. . E S DIR(0)="F^1:80"
. I FTYPE="NUMERIC" D
. . ;mapped to numeric field
. . S FINP=$$GET1^DID(FDEF,FLD,"","INPUT TRANSFORM")
. . S MIN=+$P(FINP,"X<",2),MAX=+$P(FINP,"X>",2)
. . ;ALB/70/AMA -- allow 2 decimal places
. . I MAX S DIR(0)="N"_U_MIN_":"_MAX_":2"
. . E S DIR(0)="N^0:9999999:2"
. . ;Only non-decimal-place field is Rated Percentage, 2/.302
. . I (FDEF=2),(FLD=.302) S DIR(0)=$P(DIR(0),":",1,2)_":0"
I FLD=0 D
. ;unmapped data element
. I DIR(0)="" S DIR(0)="F^1:80"
;make the DIR call for user input only if DIR(0) has been set
Q:DIR(0)=""
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) S:UPDATE="" UPDATE=$P($G(Y),U,1)
;don't continue if no data
Q:UPDATE=""
;convert dates to mm/dd/yyyy
I FTYPE="DATE/TIME" D
. ;Y holds date from DIR call in internal format
. S %F=5,UPDATE2=$$FMTE^XLFDT(Y,%F) I $L(UPDATE2)<10 D
. . S X1=$P(UPDATE2,"/",1),X2=$P(UPDATE2,"/",2),X3=$P(UPDATE2,"/",3)
. . S:$L(X1)=1 X1="0"_X1 S:$L(X2)=1 X2="0"_X2
. . S UPDATE2=X1_"/"_X2_"/"_X3
. . S UPDATE=UPDATE2
;special handling for field #.362
I FILE=2,FLD=.362,EASVRSN>5.99 D
. I UPDATE["IN LIEU OF VA COMP" S UPDATE="YES"
. I UPDATE="YES, RECEIVING MILITARY RETIREMENT" S UPDATE="NO"
;don't continue if no change to data
Q:(UPDATE=ORIGINAL)
Q:(UPDATE="")
;
I 'ACCEPT S ACCEPT=1
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
;
REMSIG ;remove signature verification from selected Application
N APP,STATUS,DA,DIC,DR,DIR,DIRUT,DUOUT,DTOUT,S,X,Y
W @IOF
W !!,"Lookup and selection for Signature Verification Removal"
W !,"is by Application # only."
W !!,"Only Applications with a Signature Verification Date, but no"
W !,"Filing Date may be selected.",!!
S DIC="^EAS(712,",DIC(0)="AENQXZ",DIC("S")="I +$P($G(^(1)),U,2)>0,+$P($G(^(2)),U,5)=0"
D ^DIC
S APP=+Y
I APP>0 D
. S DIR(0)="YA",DIR("A")="Are you sure Signature Verification should be removed? (Y/N): " D ^DIR
. Q:$D(DIRUT)
. Q:'Y
. W !!,"One moment please...",!
. ;remove signature verification data; update audit fields for sig. removal
. S DA=APP K X,Y
. S DIE=DIC,DR="4///^S X=""@"";4.1///^S X=""@"";4.2///^S X=""@"";4.6///^S X=DT;4.7////^S X=DUZ"
. D ^DIE
. D APPINDEX^EASEZU2(APP)
. S S=$$CURRSTAT^EASEZU2(APP),STATUS=$S(S="PRT":"Printed, Pending Signature",1:"In Review")
. W !!,"Signature Verification removed..."
. W !!,"Application #"_APP_" STATUS -- ",STATUS
W !!
Q
;
ADDMSG ;alb/cmf/51 - special update messages by field
N SECT,S1,S2
Q:EASVRSN<6
S SECT=$P($P(^EAS(711,KEYIEN,0),U,2),";")
Q:SECT'["II"
;
I SECT="IIC" D Q
. I DATANM="CHILD1 GROSS ANNUAL INCOME2" D Q
. . D INCTOT("Employment","employment")
. I DATANM="CHILD1 OTHER INCOME AMOUNTS" D Q
. . D INCTOT("Other","other")
. I DATANM="CHILD1 FARM OR BUSINESS INCOME" D Q
. . D INCTOT("Farm/Business","farm/business")
;
I SECT="IIE" D Q
. I DATANM="CHILD1 CASH IN BANK" D Q
. . D ASSTOT("Cash in Bank","cash in bank")
. I DATANM="CHILD1 LAND/BLDGS. LESS MORTGAGES" D Q
. . D ASSTOT("Land/Bldgs.","land/bldgs.")
. I DATANM="CHILD1 OTHER PROPERTY, ASSETS LESS AMT. OWED" D Q
. . D ASSTOT("Other Property","other property")
;
I SECT="IIG" D Q
. I DATANM="ASSET(N) CHILD CASH" D CHLDASS("Cash in Bank") Q
. I DATANM="ASSET(N) CHILD REAL PROPERTY" D CHLDASS("Real Property") Q
. I DATANM="ASSET(N) CHILD OTHER PROPERTY" D CHLDASS("Other Property") Q
Q
;
INCTOT(S1,S2) ; income total messages
W !!,?5,"The "_S1_" Income Child Total is the sum of the"
W !,?5,"individual child "_S2_" income values. The Child Total"
W !,?5,"may only be updated by adjusting the individual child"
W !,?5,S2_" income values. - or..."
Q
;
ASSTOT(S1,S2) ; asset total messages
W !!,?5,"The "_S1_" Child Total is the sum of the individual child"
W !,?5,S2_" values. The Child Total may only be adjusted by"
W !,?5,"updating the individual child "_S2_" values. - or..."
Q
;
CHLDASS(S1) ; child asset messages
W !!,?5,"The "_S1_" child amount has been added to the "_S1
W !,?5,"Veteran amount. The "_S1_" child amount may only"
W !,?5,"be adjusted by updating the "_S1_" Veteran amount."
W !,?5," - or..."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZU5 8410 printed Sep 23, 2025@19:31:21 Page 2
EASEZU5 ;ALB/jap - Utilities for 1010EZ Processing ; 5/27/08 12:23pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,51,70**;Mar 15, 2001;Build 26
+2 ;
PRTCOMP ;print comparison of 10-10EZ data with VistA data
+1 NEW ACTION
+2 SET ACTION="'Print Data'"
+3 ;no action if closed
+4 IF EASPSTAT="CLS"
DO NOACT^EASEZLM("Inactivated",ACTION)
QUIT
+5 ;proceed with print of data comparison
+6 WRITE !,"Data Print queued to background...",!
+7 SET VALMBCK="R"
+8 DO PAUSE^VALM1
+9 QUIT
+10 ;
UPDATE ;update/overwrite a 10-10EZ data element
+1 NEW ACTION,SIGDATE,EASSEL,EASERR,EASLN,LN,SUBIEN,MULTIPLE,KEYIEN,UPDATE,UPDATE2,FILE,SUBFILE,FLD,FFF
+2 NEW ORIGINAL,DATANM,UPDATE,CODE,FILE,SUBFILE,FLD,FDEF,FTYPE,ROOT,SETCODES,MIN,MAX,X,Y,DA,DR,DIC,DIE,DIR,X1,X2,X3
+3 ;variable ORIGINAL holds original 1010EZ data
+4 SET ACTION="'Update Field'"
+5 ;no action if closed
+6 IF EASPSTAT="CLS"
DO NOACT^EASEZLM("Inactivated",ACTION)
QUIT
+7 ;invalid for the following process status
+8 IF EASPSTAT="NEW"
DO NOACT^EASEZLM("New",ACTION)
QUIT
+9 IF EASPSTAT="PRT"
DO NOACT^EASEZLM("Unsigned",ACTION)
QUIT
+10 IF EASPSTAT="FIL"
DO NOACT^EASEZLM("Filed",ACTION)
QUIT
+11 ;select data item to update
+12 SET VALMBCK="R"
+13 DO SEL^EASEZLM
+14 if $GET(EASERR)
QUIT
+15 if '$GET(EASSEL)
QUIT
+16 SET EASLN=EASSEL
+17 ;
+18 ;use DIR reader to get input from user which overwrites 1010EZ data
+19 DO FULL^VALM1
+20 SET DIR(0)=""
SET (FDEF,FTYPE)=""
+21 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)
+22 SET X=$GET(^TMP("EZDATA",$JOB,KEYIEN,MULTIPLE,1))
SET ORIGINAL=$PIECE(X,U,1)
SET ACCEPT=$PIECE(X,U,2)
+23 SET DATANM=$PIECE($GET(^EAS(711,KEYIEN,0)),U,1)
+24 if DATANM="ASSET(N) CASH IN BANK"
SET DATANM="CHILD(N) CASH IN BANK"
+25 if DATANM="ASSET(N) LAND/BLDGS. LESS MORTGAGES"
SET DATANM="CHILD(N) LAND/BLDGS. LESS MORTGAGES"
+26 if DATANM="ASSET(N) OTHER PROPERTY, ASSETS LESS AMT. OWED"
SET DATANM="CHILD(N) LAND/BLDGS. LESS MORTGAGES"
+27 SET DIR("A")=DATANM
+28 ;if #3 of file #711 is defined then use to set DIR(0);
+29 SET X=$GET(^EAS(711,KEYIEN,3))
IF X'=""
XECUTE X
+30 SET FFF=$GET(^EAS(711,KEYIEN,1))
SET FILE=$PIECE(FFF,U,1)
SET SUBFILE=$PIECE(FFF,U,2)
SET FLD=$PIECE(FFF,U,3)
+31 ;don't allow updates to data which cannot be filed
+32 IF ((FILE=0)!(ACCEPT=-1))
Begin DoDot:1
+33 WRITE !!,?5,"Sorry...the selected data element cannot be 'Updated'."
+34 ;alb/cmf/51
DO ADDMSG
+35 WRITE !!,?5,"After filing this Application to VistA, use Register a Patient "
+36 WRITE !,?5,"or Patient Enrollment to enter/update data as needed.",!
+37 KILL DIR
DO PAUSE^VALM1
SET VALMBCK="R"
End DoDot:1
QUIT
+38 ;exceptions for data input; too complex for simple DIR call;
+39 IF DATANM["NAME"
IF DATANM'["OTHER"
DO ANAME^EASEZU6(EASLN,LN,DATANM)
QUIT
+40 IF DATANM["PHONE"
DO APHONE^EASEZU6(EASLN,LN,DATANM)
QUIT
+41 IF DATANM["COUNTY"
DO ACOUNTY^EASEZU6(EASLN,LN,DATANM)
QUIT
+42 IF DATANM["STATE"
DO ASTATE^EASEZU6(EASLN,LN,DATANM)
QUIT
+43 IF DATANM["SOCIAL SECURITY NUMBER"
IF FILE'=2
DO ASSN^EASEZU6(EASLN,LN,DATANM,ACCEPT)
QUIT
+44 ;setup DIR(0) for remaining mapped-to data elements
+45 IF DIR(0)=""
IF FLD'=0
Begin DoDot:1
+46 ;use DIR read based on mapped-to file/field for all other data elements
+47 IF (SUBFILE=FILE)!(SUBFILE="")
SET FDEF=FILE
+48 IF '$TEST
SET FDEF=SUBFILE
+49 SET FTYPE=$$GET1^DID(FDEF,FLD,"","TYPE")
+50 ;can't use DD type read, some fields will error because DA is not defined for the input transform;
+51 ;so set DIR(0) according to field type of VistA target location instead;
+52 IF FTYPE["POINTER"
Begin DoDot:2
+53 ;mapped to pointer field
+54 SET ROOT=$$GET1^DID(FDEF,FLD,"","POINTER")
+55 IF ROOT'=""
SET DIR(0)="P"_U_ROOT_":EMZ"
End DoDot:2
+56 IF FTYPE="SET"
Begin DoDot:2
+57 ;mapped to set of codes field
+58 SET X=^DD(FDEF,FLD,0)
+59 SET SETCODES=$PIECE(X,U,3)
KILL X
+60 SET DIR(0)="S"_U_SETCODES
End DoDot:2
+61 IF FTYPE="DATE/TIME"
Begin DoDot:2
+62 ;mapped to date/time field
+63 SET DIR(0)="D^::AEP"
End DoDot:2
+64 IF FTYPE="FREE TEXT"
Begin DoDot:2
+65 ;mapped to free text field
+66 SET MAX=$$GET1^DID(FDEF,FLD,"","FIELD LENGTH")
+67 IF MAX
SET DIR(0)="F^1:"_MAX
+68 IF '$TEST
SET DIR(0)="F^1:80"
End DoDot:2
+69 IF FTYPE="NUMERIC"
Begin DoDot:2
+70 ;mapped to numeric field
+71 SET FINP=$$GET1^DID(FDEF,FLD,"","INPUT TRANSFORM")
+72 SET MIN=+$PIECE(FINP,"X<",2)
SET MAX=+$PIECE(FINP,"X>",2)
+73 ;ALB/70/AMA -- allow 2 decimal places
+74 IF MAX
SET DIR(0)="N"_U_MIN_":"_MAX_":2"
+75 IF '$TEST
SET DIR(0)="N^0:9999999:2"
+76 ;Only non-decimal-place field is Rated Percentage, 2/.302
+77 IF (FDEF=2)
IF (FLD=.302)
SET DIR(0)=$PIECE(DIR(0),":",1,2)_":0"
End DoDot:2
End DoDot:1
+78 IF FLD=0
Begin DoDot:1
+79 ;unmapped data element
+80 IF DIR(0)=""
SET DIR(0)="F^1:80"
End DoDot:1
+81 ;make the DIR call for user input only if DIR(0) has been set
+82 if DIR(0)=""
QUIT
+83 DO ^DIR
+84 ;don't continue if user exited w/o input
+85 if ($DATA(DTOUT)!$DATA(DUOUT))
QUIT
+86 KILL DIR,DTOUT,DUOUT,DIRUT
+87 ;pickup the DIR output
+88 SET UPDATE=$PIECE($GET(Y(0)),U,1)
if UPDATE=""
SET UPDATE=$PIECE($GET(Y),U,1)
+89 ;don't continue if no data
+90 if UPDATE=""
QUIT
+91 ;convert dates to mm/dd/yyyy
+92 IF FTYPE="DATE/TIME"
Begin DoDot:1
+93 ;Y holds date from DIR call in internal format
+94 SET %F=5
SET UPDATE2=$$FMTE^XLFDT(Y,%F)
IF $LENGTH(UPDATE2)<10
Begin DoDot:2
+95 SET X1=$PIECE(UPDATE2,"/",1)
SET X2=$PIECE(UPDATE2,"/",2)
SET X3=$PIECE(UPDATE2,"/",3)
+96 if $LENGTH(X1)=1
SET X1="0"_X1
if $LENGTH(X2)=1
SET X2="0"_X2
+97 SET UPDATE2=X1_"/"_X2_"/"_X3
+98 SET UPDATE=UPDATE2
End DoDot:2
End DoDot:1
+99 ;special handling for field #.362
+100 IF FILE=2
IF FLD=.362
IF EASVRSN>5.99
Begin DoDot:1
+101 IF UPDATE["IN LIEU OF VA COMP"
SET UPDATE="YES"
+102 IF UPDATE="YES, RECEIVING MILITARY RETIREMENT"
SET UPDATE="NO"
End DoDot:1
+103 ;don't continue if no change to data
+104 if (UPDATE=ORIGINAL)
QUIT
+105 if (UPDATE="")
QUIT
+106 ;
+107 IF 'ACCEPT
SET ACCEPT=1
+108 SET $PIECE(^TMP("EZDATA",$JOB,KEYIEN,MULTIPLE,1),U,1,2)=UPDATE_U_ACCEPT
+109 ;file data element; any manually updated element is 'accepted'
+110 SET DIE="^EAS(712,EASAPP,10,"
SET DA=SUBIEN
SET DA(1)=EASAPP
SET DR(1)="10;"
+111 SET DR="1.5///^S X=UPDATE;1.1///^S X=ACCEPT;1.2///^S X=DT;1.3////^S X=DUZ"
+112 DO ^DIE
+113 SET VALMBCK="R"
+114 ;update screen list
+115 DO FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
+116 DO FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
+117 DO WRITE^VALM10(EASLN)
+118 QUIT
+119 ;
REMSIG ;remove signature verification from selected Application
+1 NEW APP,STATUS,DA,DIC,DR,DIR,DIRUT,DUOUT,DTOUT,S,X,Y
+2 WRITE @IOF
+3 WRITE !!,"Lookup and selection for Signature Verification Removal"
+4 WRITE !,"is by Application # only."
+5 WRITE !!,"Only Applications with a Signature Verification Date, but no"
+6 WRITE !,"Filing Date may be selected.",!!
+7 SET DIC="^EAS(712,"
SET DIC(0)="AENQXZ"
SET DIC("S")="I +$P($G(^(1)),U,2)>0,+$P($G(^(2)),U,5)=0"
+8 DO ^DIC
+9 SET APP=+Y
+10 IF APP>0
Begin DoDot:1
+11 SET DIR(0)="YA"
SET DIR("A")="Are you sure Signature Verification should be removed? (Y/N): "
DO ^DIR
+12 if $DATA(DIRUT)
QUIT
+13 if 'Y
QUIT
+14 WRITE !!,"One moment please...",!
+15 ;remove signature verification data; update audit fields for sig. removal
+16 SET DA=APP
KILL X,Y
+17 SET DIE=DIC
SET DR="4///^S X=""@"";4.1///^S X=""@"";4.2///^S X=""@"";4.6///^S X=DT;4.7////^S X=DUZ"
+18 DO ^DIE
+19 DO APPINDEX^EASEZU2(APP)
+20 SET S=$$CURRSTAT^EASEZU2(APP)
SET STATUS=$SELECT(S="PRT":"Printed, Pending Signature",1:"In Review")
+21 WRITE !!,"Signature Verification removed..."
+22 WRITE !!,"Application #"_APP_" STATUS -- ",STATUS
End DoDot:1
+23 WRITE !!
+24 QUIT
+25 ;
ADDMSG ;alb/cmf/51 - special update messages by field
+1 NEW SECT,S1,S2
+2 if EASVRSN<6
QUIT
+3 SET SECT=$PIECE($PIECE(^EAS(711,KEYIEN,0),U,2),";")
+4 if SECT'["II"
QUIT
+5 ;
+6 IF SECT="IIC"
Begin DoDot:1
+7 IF DATANM="CHILD1 GROSS ANNUAL INCOME2"
Begin DoDot:2
+8 DO INCTOT("Employment","employment")
End DoDot:2
QUIT
+9 IF DATANM="CHILD1 OTHER INCOME AMOUNTS"
Begin DoDot:2
+10 DO INCTOT("Other","other")
End DoDot:2
QUIT
+11 IF DATANM="CHILD1 FARM OR BUSINESS INCOME"
Begin DoDot:2
+12 DO INCTOT("Farm/Business","farm/business")
End DoDot:2
QUIT
End DoDot:1
QUIT
+13 ;
+14 IF SECT="IIE"
Begin DoDot:1
+15 IF DATANM="CHILD1 CASH IN BANK"
Begin DoDot:2
+16 DO ASSTOT("Cash in Bank","cash in bank")
End DoDot:2
QUIT
+17 IF DATANM="CHILD1 LAND/BLDGS. LESS MORTGAGES"
Begin DoDot:2
+18 DO ASSTOT("Land/Bldgs.","land/bldgs.")
End DoDot:2
QUIT
+19 IF DATANM="CHILD1 OTHER PROPERTY, ASSETS LESS AMT. OWED"
Begin DoDot:2
+20 DO ASSTOT("Other Property","other property")
End DoDot:2
QUIT
End DoDot:1
QUIT
+21 ;
+22 IF SECT="IIG"
Begin DoDot:1
+23 IF DATANM="ASSET(N) CHILD CASH"
DO CHLDASS("Cash in Bank")
QUIT
+24 IF DATANM="ASSET(N) CHILD REAL PROPERTY"
DO CHLDASS("Real Property")
QUIT
+25 IF DATANM="ASSET(N) CHILD OTHER PROPERTY"
DO CHLDASS("Other Property")
QUIT
End DoDot:1
QUIT
+26 QUIT
+27 ;
INCTOT(S1,S2) ; income total messages
+1 WRITE !!,?5,"The "_S1_" Income Child Total is the sum of the"
+2 WRITE !,?5,"individual child "_S2_" income values. The Child Total"
+3 WRITE !,?5,"may only be updated by adjusting the individual child"
+4 WRITE !,?5,S2_" income values. - or..."
+5 QUIT
+6 ;
ASSTOT(S1,S2) ; asset total messages
+1 WRITE !!,?5,"The "_S1_" Child Total is the sum of the individual child"
+2 WRITE !,?5,S2_" values. The Child Total may only be adjusted by"
+3 WRITE !,?5,"updating the individual child "_S2_" values. - or..."
+4 QUIT
+5 ;
CHLDASS(S1) ; child asset messages
+1 WRITE !!,?5,"The "_S1_" child amount has been added to the "_S1
+2 WRITE !,?5,"Veteran amount. The "_S1_" child amount may only"
+3 WRITE !,?5,"be adjusted by updating the "_S1_" Veteran amount."
+4 WRITE !,?5," - or..."
+5 QUIT
+6 ;
