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

EASEZU5.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. PRTCOMP ;print comparison of 10-10EZ data with VistA data
  1. N ACTION
  1. S ACTION="'Print Data'"
  1. ;no action if closed
  1. I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
  1. ;proceed with print of data comparison
  1. W !,"Data Print queued to background...",!
  1. S VALMBCK="R"
  1. D PAUSE^VALM1
  1. Q
  1. ;
  1. UPDATE ;update/overwrite a 10-10EZ data element
  1. N ACTION,SIGDATE,EASSEL,EASERR,EASLN,LN,SUBIEN,MULTIPLE,KEYIEN,UPDATE,UPDATE2,FILE,SUBFILE,FLD,FFF
  1. N ORIGINAL,DATANM,UPDATE,CODE,FILE,SUBFILE,FLD,FDEF,FTYPE,ROOT,SETCODES,MIN,MAX,X,Y,DA,DR,DIC,DIE,DIR,X1,X2,X3
  1. ;variable ORIGINAL holds original 1010EZ data
  1. S ACTION="'Update Field'"
  1. ;no action if closed
  1. I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
  1. ;invalid for the following process status
  1. I EASPSTAT="NEW" D NOACT^EASEZLM("New",ACTION) Q
  1. I EASPSTAT="PRT" D NOACT^EASEZLM("Unsigned",ACTION) Q
  1. I EASPSTAT="FIL" D NOACT^EASEZLM("Filed",ACTION) Q
  1. ;select data item to update
  1. S VALMBCK="R"
  1. D SEL^EASEZLM
  1. Q:$G(EASERR)
  1. Q:'$G(EASSEL)
  1. S EASLN=EASSEL
  1. ;
  1. ;use DIR reader to get input from user which overwrites 1010EZ data
  1. D FULL^VALM1
  1. S DIR(0)="",(FDEF,FTYPE)=""
  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 X=$G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),ORIGINAL=$P(X,U,1),ACCEPT=$P(X,U,2)
  1. S DATANM=$P($G(^EAS(711,KEYIEN,0)),U,1)
  1. S:DATANM="ASSET(N) CASH IN BANK" DATANM="CHILD(N) CASH IN BANK"
  1. S:DATANM="ASSET(N) LAND/BLDGS. LESS MORTGAGES" DATANM="CHILD(N) LAND/BLDGS. LESS MORTGAGES"
  1. S:DATANM="ASSET(N) OTHER PROPERTY, ASSETS LESS AMT. OWED" DATANM="CHILD(N) LAND/BLDGS. LESS MORTGAGES"
  1. S DIR("A")=DATANM
  1. ;if #3 of file #711 is defined then use to set DIR(0);
  1. S X=$G(^EAS(711,KEYIEN,3)) I X'="" X X
  1. S FFF=$G(^EAS(711,KEYIEN,1)),FILE=$P(FFF,U,1),SUBFILE=$P(FFF,U,2),FLD=$P(FFF,U,3)
  1. ;don't allow updates to data which cannot be filed
  1. I ((FILE=0)!(ACCEPT=-1)) D Q
  1. . W !!,?5,"Sorry...the selected data element cannot be 'Updated'."
  1. . D ADDMSG ;alb/cmf/51
  1. . W !!,?5,"After filing this Application to VistA, use Register a Patient "
  1. . W !,?5,"or Patient Enrollment to enter/update data as needed.",!
  1. . K DIR D PAUSE^VALM1 S VALMBCK="R"
  1. ;exceptions for data input; too complex for simple DIR call;
  1. I DATANM["NAME",DATANM'["OTHER" D ANAME^EASEZU6(EASLN,LN,DATANM) Q
  1. I DATANM["PHONE" D APHONE^EASEZU6(EASLN,LN,DATANM) Q
  1. I DATANM["COUNTY" D ACOUNTY^EASEZU6(EASLN,LN,DATANM) Q
  1. I DATANM["STATE" D ASTATE^EASEZU6(EASLN,LN,DATANM) Q
  1. I DATANM["SOCIAL SECURITY NUMBER",FILE'=2 D ASSN^EASEZU6(EASLN,LN,DATANM,ACCEPT) Q
  1. ;setup DIR(0) for remaining mapped-to data elements
  1. I DIR(0)="",FLD'=0 D
  1. . ;use DIR read based on mapped-to file/field for all other data elements
  1. . I (SUBFILE=FILE)!(SUBFILE="") S FDEF=FILE
  1. . E S FDEF=SUBFILE
  1. . S FTYPE=$$GET1^DID(FDEF,FLD,"","TYPE")
  1. . ;can't use DD type read, some fields will error because DA is not defined for the input transform;
  1. . ;so set DIR(0) according to field type of VistA target location instead;
  1. . I FTYPE["POINTER" D
  1. . . ;mapped to pointer field
  1. . . S ROOT=$$GET1^DID(FDEF,FLD,"","POINTER")
  1. . . I ROOT'="" S DIR(0)="P"_U_ROOT_":EMZ"
  1. . I FTYPE="SET" D
  1. . . ;mapped to set of codes field
  1. . . S X=^DD(FDEF,FLD,0)
  1. . . S SETCODES=$P(X,U,3) K X
  1. . . S DIR(0)="S"_U_SETCODES
  1. . I FTYPE="DATE/TIME" D
  1. . . ;mapped to date/time field
  1. . . S DIR(0)="D^::AEP"
  1. . I FTYPE="FREE TEXT" D
  1. . . ;mapped to free text field
  1. . . S MAX=$$GET1^DID(FDEF,FLD,"","FIELD LENGTH")
  1. . . I MAX S DIR(0)="F^1:"_MAX
  1. . . E S DIR(0)="F^1:80"
  1. . I FTYPE="NUMERIC" D
  1. . . ;mapped to numeric field
  1. . . S FINP=$$GET1^DID(FDEF,FLD,"","INPUT TRANSFORM")
  1. . . S MIN=+$P(FINP,"X<",2),MAX=+$P(FINP,"X>",2)
  1. . . ;ALB/70/AMA -- allow 2 decimal places
  1. . . I MAX S DIR(0)="N"_U_MIN_":"_MAX_":2"
  1. . . E S DIR(0)="N^0:9999999:2"
  1. . . ;Only non-decimal-place field is Rated Percentage, 2/.302
  1. . . I (FDEF=2),(FLD=.302) S DIR(0)=$P(DIR(0),":",1,2)_":0"
  1. I FLD=0 D
  1. . ;unmapped data element
  1. . I DIR(0)="" S DIR(0)="F^1:80"
  1. ;make the DIR call for user input only if DIR(0) has been set
  1. Q:DIR(0)=""
  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) S:UPDATE="" UPDATE=$P($G(Y),U,1)
  1. ;don't continue if no data
  1. Q:UPDATE=""
  1. ;convert dates to mm/dd/yyyy
  1. I FTYPE="DATE/TIME" D
  1. . ;Y holds date from DIR call in internal format
  1. . S %F=5,UPDATE2=$$FMTE^XLFDT(Y,%F) I $L(UPDATE2)<10 D
  1. . . S X1=$P(UPDATE2,"/",1),X2=$P(UPDATE2,"/",2),X3=$P(UPDATE2,"/",3)
  1. . . S:$L(X1)=1 X1="0"_X1 S:$L(X2)=1 X2="0"_X2
  1. . . S UPDATE2=X1_"/"_X2_"/"_X3
  1. . . S UPDATE=UPDATE2
  1. ;special handling for field #.362
  1. I FILE=2,FLD=.362,EASVRSN>5.99 D
  1. . I UPDATE["IN LIEU OF VA COMP" S UPDATE="YES"
  1. . I UPDATE="YES, RECEIVING MILITARY RETIREMENT" S UPDATE="NO"
  1. ;don't continue if no change to data
  1. Q:(UPDATE=ORIGINAL)
  1. Q:(UPDATE="")
  1. ;
  1. I 'ACCEPT S ACCEPT=1
  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
  1. ;
  1. REMSIG ;remove signature verification from selected Application
  1. N APP,STATUS,DA,DIC,DR,DIR,DIRUT,DUOUT,DTOUT,S,X,Y
  1. W @IOF
  1. W !!,"Lookup and selection for Signature Verification Removal"
  1. W !,"is by Application # only."
  1. W !!,"Only Applications with a Signature Verification Date, but no"
  1. W !,"Filing Date may be selected.",!!
  1. S DIC="^EAS(712,",DIC(0)="AENQXZ",DIC("S")="I +$P($G(^(1)),U,2)>0,+$P($G(^(2)),U,5)=0"
  1. D ^DIC
  1. S APP=+Y
  1. I APP>0 D
  1. . S DIR(0)="YA",DIR("A")="Are you sure Signature Verification should be removed? (Y/N): " D ^DIR
  1. . Q:$D(DIRUT)
  1. . Q:'Y
  1. . W !!,"One moment please...",!
  1. . ;remove signature verification data; update audit fields for sig. removal
  1. . S DA=APP K X,Y
  1. . 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"
  1. . D ^DIE
  1. . D APPINDEX^EASEZU2(APP)
  1. . S S=$$CURRSTAT^EASEZU2(APP),STATUS=$S(S="PRT":"Printed, Pending Signature",1:"In Review")
  1. . W !!,"Signature Verification removed..."
  1. . W !!,"Application #"_APP_" STATUS -- ",STATUS
  1. W !!
  1. Q
  1. ;
  1. ADDMSG ;alb/cmf/51 - special update messages by field
  1. N SECT,S1,S2
  1. Q:EASVRSN<6
  1. S SECT=$P($P(^EAS(711,KEYIEN,0),U,2),";")
  1. Q:SECT'["II"
  1. ;
  1. I SECT="IIC" D Q
  1. . I DATANM="CHILD1 GROSS ANNUAL INCOME2" D Q
  1. . . D INCTOT("Employment","employment")
  1. . I DATANM="CHILD1 OTHER INCOME AMOUNTS" D Q
  1. . . D INCTOT("Other","other")
  1. . I DATANM="CHILD1 FARM OR BUSINESS INCOME" D Q
  1. . . D INCTOT("Farm/Business","farm/business")
  1. ;
  1. I SECT="IIE" D Q
  1. . I DATANM="CHILD1 CASH IN BANK" D Q
  1. . . D ASSTOT("Cash in Bank","cash in bank")
  1. . I DATANM="CHILD1 LAND/BLDGS. LESS MORTGAGES" D Q
  1. . . D ASSTOT("Land/Bldgs.","land/bldgs.")
  1. . I DATANM="CHILD1 OTHER PROPERTY, ASSETS LESS AMT. OWED" D Q
  1. . . D ASSTOT("Other Property","other property")
  1. ;
  1. I SECT="IIG" D Q
  1. . I DATANM="ASSET(N) CHILD CASH" D CHLDASS("Cash in Bank") Q
  1. . I DATANM="ASSET(N) CHILD REAL PROPERTY" D CHLDASS("Real Property") Q
  1. . I DATANM="ASSET(N) CHILD OTHER PROPERTY" D CHLDASS("Other Property") Q
  1. Q
  1. ;
  1. INCTOT(S1,S2) ; income total messages
  1. W !!,?5,"The "_S1_" Income Child Total is the sum of the"
  1. W !,?5,"individual child "_S2_" income values. The Child Total"
  1. W !,?5,"may only be updated by adjusting the individual child"
  1. W !,?5,S2_" income values. - or..."
  1. Q
  1. ;
  1. ASSTOT(S1,S2) ; asset total messages
  1. W !!,?5,"The "_S1_" Child Total is the sum of the individual child"
  1. W !,?5,S2_" values. The Child Total may only be adjusted by"
  1. W !,?5,"updating the individual child "_S2_" values. - or..."
  1. Q
  1. ;
  1. CHLDASS(S1) ; child asset messages
  1. W !!,?5,"The "_S1_" child amount has been added to the "_S1
  1. W !,?5,"Veteran amount. The "_S1_" child amount may only"
  1. W !,?5,"be adjusted by updating the "_S1_" Veteran amount."
  1. W !,?5," - or..."
  1. Q
  1. ;