- DGRPEIS3 ;ALB/CAW,EG,ERC,BAJ,TDM - INCOME SCREENING DATA (CON'T) ; 5/26/10 2:03pm
- ;;5.3;Registration;**45,624,659,653,688,754**;Aug 13, 1993;Build 46
- ;
- HELP ; Display information when veteran's DOB is past the income year
- ;
- W !!,"Please return to screen 8 and check the veteran's effective date."
- W !,"The effective date was created based on the veteran's date of birth."
- W !,"You might also want to check the date of birth for this veteran."
- W ! S DIR(0)="E" D ^DIR K DIR W !
- Q
- ;
- WRT ; Write age statement
- Q:'$G(DGMTI)
- W !!,"This dependent is 18 years or older. To list this person as a dependent"
- W !,"they have to be:"
- W !," 1. An UNMARRIED child who is under the age of 18."
- W !," 2. Between the ages of 18 and 23 and attending school."
- W !," 3. An unmarried child over the age of 17 who became permanently"
- W !," incapable of self support before the age of 18."
- Q
- ;
- EDIT ;CALLED FROM ROUTINE DGRPEIS
- N DGEXIT,SSNV,SSNVL,SSNUM
- S DGEDDEP=1
- S DGFL=$G(DGFL)
- S DATE=$S($G(DATE):DATE,1:$$LYR^DGMTSCU1(DT))
- S X=$P(DGPREF,"^",2)
- S DGTYPE=$G(DGTYPE),DGTYPE=$S(DGTYPE']"":"S",DGTYPE="C":"C",DGTYPE="D":"D",1:"S")
- S DIE="^"_$P(X,";",2),DA=+X
- ;
- ; DG*5.3*653 ERC Pseudo SSN Reason changes
- ; DG*5.3*688 BAJ SSN Verification changes
- ;
- ; Retrieve SSN VERIFIED statusrequired
- S SSNVL=DIE_DA_",0)"
- S SSNUM=$P(@SSNVL,"^",9),SSNV=$P(@SSNVL,"^",11)
- ;
- ; Lock SSN if SSN is VERIFIED
- S DR=$S(SSNV=4:".01;.02;.03;S UPARROW=1",1:".01;.02;.03;.09;S UPARROW=1")
- S DGEXIT=0
- K DG,DQ D ^DIE I $D(DTOUT)!$D(DUOUT)!'$D(UPARROW) S DGFL=$S($D(DTOUT):-2,1:-1) S DGEXIT=1 D EDITQ Q
- I SSNV="V" W !,"SOCIAL SECURITY NUMBER "_SSNUM_" has been verified by SSA -- NO EDITING"
- ;
- ; changes to make Pseudo SSN Reason required - DG*5.3*653, ERC
- S DGEXIT=0 I $P($G(@(DIE_DA_",0)")),U,9)["P" D SSNREA(.DGEXIT) I DGEXIT=1 Q
- I DGTYPE="S" D
- . S DR="1.1;S UPARROW=1"
- . K DG,DQ D ^DIE I $D(DTOUT)!$D(DUOUT)!'$D(UPARROW) S DGFL=$S($D(DTOUT):-2,1:-1) S DGEXIT=1
- I DGEXIT=1 Q
- ;
- ; ; end SSN Verification & Pseudo SSN Reason changes
- ;
- S DOB=$P($G(@(DIE_DA_",0)")),U,3)
- ;
- N DGVADD,DGSADD,DGIPIEN,DGUQTLP,SPOUSE,DGFL,DGRPI
- S (DGVADD,DGSADD,DGIPIEN,DGUQTLP)=0
- S SPOUSE=$S(DGTYPE="S":1,1:0),DGFL=$G(DGFL)
- ;
- ; if veteran address is not USA, skip this ^DIR call
- I $$FORIEN^DGADDUTL($P($G(^DPT(DFN,.11)),U,10)) G FOREIGN
- ; Is spouse/dependent address same as patient address?
- K DIR
- S DIR(0)="YAO^^"
- S DIR("A")="STREET ADDRESS SAME AS PATIENT'S: "
- S DIR("B")="YES"
- S DIR("?")="Enter 'Y' if the "_$S(SPOUSE:"spouse",1:"child")_" has the same address as the patient, otherwise enter 'N'."
- D ^DIR
- S DGVADD=+Y
- K Y,DIR
- FOREIGN ;tag added for rejoining if country not USA
- S DGIPIEN=$$SPSCHK^DGRPEIS(DFN)
- I 'DGVADD,(DGTYPE'="S"),DGIPIEN D
- . K DIR,Y
- . S DIR(0)="YAO^^"
- . S DIR("A")="STREET ADDRESS SAME AS SPOUSE'S: "
- . S DIR("B")="YES"
- . S DIR("?")="Enter 'Y' if the child has the same address as the spouse, otherwise enter 'N'."
- . D ^DIR
- . S DGSADD=+Y
- . K Y,DIR
- ;
- ; If spouse/dependent address is same as patient's, set spouse/dep address
- I DGVADD!DGSADD D
- . I DGVADD D PATASET^DGRPEIS(DFN) ;*Set to Patient address
- . I DGSADD D SPSASET^DGRPEIS(DGIPIEN) ;*Set to Spouse address
- . N FLD,FDA S FLD=0 F S FLD=$O(ANS(FLD)) Q:'FLD D
- . . S FDA(408.13,DA_",",FLD)=ANS(FLD) K ANS(FLD)
- . D FILE^DIE("","FDA","")
- ;
- ;Spouse/dep address not same as patient/spouse address; prompt for it
- I 'DGVADD,'DGSADD D
- . S DR="1.2;S:X']"""" Y=1.5;1.3;S:X']"""" Y=1.5;1.4;1.5;1.6;1.7;1.8;S UPARROW=1"
- . K DG,DQ D ^DIE
- I $D(DTOUT)!$D(DUOUT)!'$D(UPARROW) S DGFL=$S($D(DTOUT):-2,1:-1) D EDITQ Q
- ;
- I DGTYPE'="S" K UPARROW S DIE="^DGPR(408.12,",DA=+DGPREF,DR=".02;S UPARROW=1" K DG,DQ D ^DIE I $D(DTOUT)!$D(DUOUT)!'$D(UPARROW) S DGFL=$S($D(DTOUT):-2,1:-1)
- S RELATION=$P($G(^DGPR(408.12,+DGPREF,0)),"^",2)
- S DGX=$O(^DGPR(408.12,+DGPREF,"E","AID","")),DGMIEN=$O(^(+DGX,0))
- EDACTDT I $G(^DGPR(408.12,+DGPREF,"E",+DGMIEN,0)) D G:$G(DGFL)<0 EDITQ
- . S (DGACT,Y)=+^(0) X ^DD("DD")
- . S DIR("B")=Y
- . D READ^DGRPEIS2
- . I -DGACT'=DGX W !,"Use 'Expand Dependent' option to change effective date." H 2 S DGFL=-1 Q
- . Q:$G(DGFL)<0
- . S DIE="^DGPR(408.12,"_+DGPREF_",""E"",",DA(1)=+DGPREF,DA=DGMIEN,DR=".01///"_DGACT
- . D ^DIE
- I DGTYPE="S" S X=+DGPREF D SETUP^DGRPEIS1
- K DGACT,DGMIEN,RELATION,DA,DIE,DR,UPARROW,DTOUT,DUOUT,DIRUT
- EDITQ K DA,DIE,DIRUT,DR,DTOUT,DUOUT
- Q
- ;
- SSNREA(DGEXIT) ;if SSN is pseudo Pseudo SSN Reason is required - DG*5.3*653
- N I,EXIT
- S EXIT=0
- F D Q:EXIT
- . S DR=$S(DIE["DGPR":.1,1:.0906)_";S UPARROW=1"
- . K DG,DQ D ^DIE I $D(DTOUT)!$D(DUOUT)!'$D(UPARROW) S DGFL=$S($D(DTOUT):-2,1:-1) S (EXIT,DGEXIT)=1 Q
- . I $P($G(@(DIE_DA_",0)")),U,10)']"" S EXIT=0 Q
- . S EXIT=1
- Q
- HELP1(DGISDT) ; Displays the help for the active/inactive prompt
- ;
- D CLEAR^VALM1
- W !,"Enter the date this person first became a dependent of the veteran."
- W !,"In the case of a spouse, this would be the date of marriage. For"
- W !,"a child, this would be the date of birth or date of adoption. For a"
- W !,"stepchild, this would be the date of marriage to the child's parent."
- W !!,"Date must be before DEC 31, "_DGISDT_" as dependents are collected for the"
- W !,"prior calendar year only."
- S VALMBCK="R"
- Q
- ;
- HELPDOB ; * Displays help for Date of Birth
- N DGRDVAR
- I X="?" D Q
- . W !?5,"Enter the date this dependent was born. The date must not be during the"
- . W !?5,"current calendar year. Only persons that were dependents before the"
- . W !?5,"current year may be entered.",!
- . I $G(DA) W !,"Enter RETURN to continue:" R DGRDVAR:DTIME W !
- ;
- W !?8,"Enter the date on which this relative was born. This information is"
- W !?8,"necessary for use in the income screening and means test portions of"
- W !?8,"MAS."
- W !!?8,"The date entered must not be during the current calendar year. That"
- W !?8,"is, it must be on or before December 31 or the prior calendar year."
- I $G(DA) W ! S DIR(0)="E" D ^DIR Q:+Y<1
- W !!?8,"The reason for this is that this data is used for collecting income"
- W !?8,"information for the purposes of comparing this data with the Internal"
- W !?8,"Revenue Service (IRS). Children born during the calendar year cannot"
- W !?8,"be entered until next year."
- I $G(DA) W !!,"Enter RETURN to continue:" R DGRDVAR:DTIME W !
- Q
- ;
- HELPMN ; * Displays help for Spouse Maiden Name
- W !?8,"Enter the spouse's maiden name in 'LAST,FIRST MIDDLE SUFFIX' format."
- W !?8,"Entry of the LAST name only is permitted and the comma may be omitted."
- W !?8,"If the response contains no comma, one will be appended to the value."
- W !?8,"Including the comma, the value must be at least 3 characters in length.",!
- Q
- ;
- HELPSA1 ; * Displays help for Street Address 1
- N DGRELTP
- S DGRELTP=$$RELTYPE^DGRPEIS2($G(DA),1)
- W !,"If a "_DGRELTP_"'s name has been specified, enter the first line of"
- W !,"that person's street address [3-30 characters]; otherwise this field"
- W !,"may be left blank. This field cannot be deleted as long as a "_DGRELTP_"'s"
- W !,"name is on file."
- I $G(DA),(X="?") W !
- Q
- ;
- HELPSA2 ; * Displays help for Street Address 2
- N DGRELTP
- S DGRELTP=$$RELTYPE^DGRPEIS2($G(DA),1)
- W !,"If a "_DGRELTP_"'s name has been specified, enter the second line of"
- W !,"that person's street address [3-30 characters]; otherwise this field"
- W !,"may be left blank. This field cannot be deleted as long as a "_DGRELTP_"'s"
- W !,"name is on file."
- I $G(DA),(X="?") W !
- Q
- ;
- HELPSA3 ; * Displays help for Street Address 3
- N DGRELTP
- S DGRELTP=$$RELTYPE^DGRPEIS2($G(DA),1)
- W !,"If a "_DGRELTP_"'s name has been specified, enter the third line of"
- W !,"that person's street address [3-30 characters]; otherwise this field"
- W !,"may be left blank. This field cannot be deleted as long as a "_DGRELTP_"'s"
- W !,"name is on file."
- I $G(DA),(X="?") W !
- Q
- ;
- HELPCITY ; * Displays help for City
- N DGRELTP
- S DGRELTP=$$RELTYPE^DGRPEIS2($G(DA),1)
- W !,"If a "_DGRELTP_"'s name has been specified, enter the city in which"
- W !,"that person resides [3-30 characters]; otherwise this field may be"
- W !,"left blank. This field cannot be deleted as long as a "_DGRELTP_"'s"
- W !,"name is on file."
- I $G(DA),(X="?") W !
- Q
- ;
- HELPSTAT ; * Displays help for the state
- N DGRELTP,DIRA,DGRDVAR,DDIOLARY
- S DGRELTP=$$RELTYPE^DGRPEIS2($G(DA),1)
- S DDIOLARY(1)="If a "_DGRELTP_"'s name has been specified, select the state in which"
- S DDIOLARY(1,"F")="!"
- S DDIOLARY(2)="that person resides; otherwise this field may be left blank. This"
- S DDIOLARY(2,"F")="!"
- S DDIOLARY(3)="field cannot be deleted as long as a "_DGRELTP_"'s name is on file."
- S DDIOLARY(3,"F")="!"
- S DDIOLARY(4)=""
- S DDIOLARY(4,"F")="!"
- D EN^DDIOL(.DDIOLARY)
- ;
- Q:X="?"
- D EN^DDIOL("Enter RETURN to continue:","","!")
- R DGRDVAR:DTIME
- Q
- ;
- HELPZIP ; * Displays help for the Zip code
- N DGRELTP
- S DGRELTP=$$RELTYPE^DGRPEIS2($G(DA),1)
- W !,"Answer with the 5 digit format (e.g. 12345) or the nine digit"
- W !,"format (e.g. 12345-6789 or 123456789). This is related to the"
- W !,DGRELTP_"'s address."
- I $G(DA),(X="?") W !
- Q
- HELPPHON ; * Displays help for the Phone number
- N DGRELTP
- S DGRELTP=$$RELTYPE^DGRPEIS2($G(DA),1)
- W !,"If a "_DGRELTP_"'s name has been specified, enter the "_DGRELTP_"'s"
- W !,"phone number [4-20 characters], otherwise this field may be left"
- W !,"blank. This field cannot be deleted as long as a "_DGRELTP_"'s"
- W !,"name is on file."
- I $G(DA),(X="?") W !
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPEIS3 9648 printed Feb 19, 2025@00:22:26 Page 2
- DGRPEIS3 ;ALB/CAW,EG,ERC,BAJ,TDM - INCOME SCREENING DATA (CON'T) ; 5/26/10 2:03pm
- +1 ;;5.3;Registration;**45,624,659,653,688,754**;Aug 13, 1993;Build 46
- +2 ;
- HELP ; Display information when veteran's DOB is past the income year
- +1 ;
- +2 WRITE !!,"Please return to screen 8 and check the veteran's effective date."
- +3 WRITE !,"The effective date was created based on the veteran's date of birth."
- +4 WRITE !,"You might also want to check the date of birth for this veteran."
- +5 WRITE !
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- WRITE !
- +6 QUIT
- +7 ;
- WRT ; Write age statement
- +1 if '$GET(DGMTI)
- QUIT
- +2 WRITE !!,"This dependent is 18 years or older. To list this person as a dependent"
- +3 WRITE !,"they have to be:"
- +4 WRITE !," 1. An UNMARRIED child who is under the age of 18."
- +5 WRITE !," 2. Between the ages of 18 and 23 and attending school."
- +6 WRITE !," 3. An unmarried child over the age of 17 who became permanently"
- +7 WRITE !," incapable of self support before the age of 18."
- +8 QUIT
- +9 ;
- EDIT ;CALLED FROM ROUTINE DGRPEIS
- +1 NEW DGEXIT,SSNV,SSNVL,SSNUM
- +2 SET DGEDDEP=1
- +3 SET DGFL=$GET(DGFL)
- +4 SET DATE=$SELECT($GET(DATE):DATE,1:$$LYR^DGMTSCU1(DT))
- +5 SET X=$PIECE(DGPREF,"^",2)
- +6 SET DGTYPE=$GET(DGTYPE)
- SET DGTYPE=$SELECT(DGTYPE']"":"S",DGTYPE="C":"C",DGTYPE="D":"D",1:"S")
- +7 SET DIE="^"_$PIECE(X,";",2)
- SET DA=+X
- +8 ;
- +9 ; DG*5.3*653 ERC Pseudo SSN Reason changes
- +10 ; DG*5.3*688 BAJ SSN Verification changes
- +11 ;
- +12 ; Retrieve SSN VERIFIED statusrequired
- +13 SET SSNVL=DIE_DA_",0)"
- +14 SET SSNUM=$PIECE(@SSNVL,"^",9)
- SET SSNV=$PIECE(@SSNVL,"^",11)
- +15 ;
- +16 ; Lock SSN if SSN is VERIFIED
- +17 SET DR=$SELECT(SSNV=4:".01;.02;.03;S UPARROW=1",1:".01;.02;.03;.09;S UPARROW=1")
- +18 SET DGEXIT=0
- +19 KILL DG,DQ
- DO ^DIE
- IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(UPARROW)
- SET DGFL=$SELECT($DATA(DTOUT):-2,1:-1)
- SET DGEXIT=1
- DO EDITQ
- QUIT
- +20 IF SSNV="V"
- WRITE !,"SOCIAL SECURITY NUMBER "_SSNUM_" has been verified by SSA -- NO EDITING"
- +21 ;
- +22 ; changes to make Pseudo SSN Reason required - DG*5.3*653, ERC
- +23 SET DGEXIT=0
- IF $PIECE($GET(@(DIE_DA_",0)")),U,9)["P"
- DO SSNREA(.DGEXIT)
- IF DGEXIT=1
- QUIT
- +24 IF DGTYPE="S"
- Begin DoDot:1
- +25 SET DR="1.1;S UPARROW=1"
- +26 KILL DG,DQ
- DO ^DIE
- IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(UPARROW)
- SET DGFL=$SELECT($DATA(DTOUT):-2,1:-1)
- SET DGEXIT=1
- End DoDot:1
- +27 IF DGEXIT=1
- QUIT
- +28 ;
- +29 ; ; end SSN Verification & Pseudo SSN Reason changes
- +30 ;
- +31 SET DOB=$PIECE($GET(@(DIE_DA_",0)")),U,3)
- +32 ;
- +33 NEW DGVADD,DGSADD,DGIPIEN,DGUQTLP,SPOUSE,DGFL,DGRPI
- +34 SET (DGVADD,DGSADD,DGIPIEN,DGUQTLP)=0
- +35 SET SPOUSE=$SELECT(DGTYPE="S":1,1:0)
- SET DGFL=$GET(DGFL)
- +36 ;
- +37 ; if veteran address is not USA, skip this ^DIR call
- +38 IF $$FORIEN^DGADDUTL($PIECE($GET(^DPT(DFN,.11)),U,10))
- GOTO FOREIGN
- +39 ; Is spouse/dependent address same as patient address?
- +40 KILL DIR
- +41 SET DIR(0)="YAO^^"
- +42 SET DIR("A")="STREET ADDRESS SAME AS PATIENT'S: "
- +43 SET DIR("B")="YES"
- +44 SET DIR("?")="Enter 'Y' if the "_$SELECT(SPOUSE:"spouse",1:"child")_" has the same address as the patient, otherwise enter 'N'."
- +45 DO ^DIR
- +46 SET DGVADD=+Y
- +47 KILL Y,DIR
- FOREIGN ;tag added for rejoining if country not USA
- +1 SET DGIPIEN=$$SPSCHK^DGRPEIS(DFN)
- +2 IF 'DGVADD
- IF (DGTYPE'="S")
- IF DGIPIEN
- Begin DoDot:1
- +3 KILL DIR,Y
- +4 SET DIR(0)="YAO^^"
- +5 SET DIR("A")="STREET ADDRESS SAME AS SPOUSE'S: "
- +6 SET DIR("B")="YES"
- +7 SET DIR("?")="Enter 'Y' if the child has the same address as the spouse, otherwise enter 'N'."
- +8 DO ^DIR
- +9 SET DGSADD=+Y
- +10 KILL Y,DIR
- End DoDot:1
- +11 ;
- +12 ; If spouse/dependent address is same as patient's, set spouse/dep address
- +13 IF DGVADD!DGSADD
- Begin DoDot:1
- +14 ;*Set to Patient address
- IF DGVADD
- DO PATASET^DGRPEIS(DFN)
- +15 ;*Set to Spouse address
- IF DGSADD
- DO SPSASET^DGRPEIS(DGIPIEN)
- +16 NEW FLD,FDA
- SET FLD=0
- FOR
- SET FLD=$ORDER(ANS(FLD))
- if 'FLD
- QUIT
- Begin DoDot:2
- +17 SET FDA(408.13,DA_",",FLD)=ANS(FLD)
- KILL ANS(FLD)
- End DoDot:2
- +18 DO FILE^DIE("","FDA","")
- End DoDot:1
- +19 ;
- +20 ;Spouse/dep address not same as patient/spouse address; prompt for it
- +21 IF 'DGVADD
- IF 'DGSADD
- Begin DoDot:1
- +22 SET DR="1.2;S:X']"""" Y=1.5;1.3;S:X']"""" Y=1.5;1.4;1.5;1.6;1.7;1.8;S UPARROW=1"
- +23 KILL DG,DQ
- DO ^DIE
- End DoDot:1
- +24 IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(UPARROW)
- SET DGFL=$SELECT($DATA(DTOUT):-2,1:-1)
- DO EDITQ
- QUIT
- +25 ;
- +26 IF DGTYPE'="S"
- KILL UPARROW
- SET DIE="^DGPR(408.12,"
- SET DA=+DGPREF
- SET DR=".02;S UPARROW=1"
- KILL DG,DQ
- DO ^DIE
- IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(UPARROW)
- SET DGFL=$SELECT($DATA(DTOUT):-2,1:-1)
- +27 SET RELATION=$PIECE($GET(^DGPR(408.12,+DGPREF,0)),"^",2)
- +28 SET DGX=$ORDER(^DGPR(408.12,+DGPREF,"E","AID",""))
- SET DGMIEN=$ORDER(^(+DGX,0))
- EDACTDT IF $GET(^DGPR(408.12,+DGPREF,"E",+DGMIEN,0))
- Begin DoDot:1
- +1 SET (DGACT,Y)=+^(0)
- XECUTE ^DD("DD")
- +2 SET DIR("B")=Y
- +3 DO READ^DGRPEIS2
- +4 IF -DGACT'=DGX
- WRITE !,"Use 'Expand Dependent' option to change effective date."
- HANG 2
- SET DGFL=-1
- QUIT
- +5 if $GET(DGFL)<0
- QUIT
- +6 SET DIE="^DGPR(408.12,"_+DGPREF_",""E"","
- SET DA(1)=+DGPREF
- SET DA=DGMIEN
- SET DR=".01///"_DGACT
- +7 DO ^DIE
- End DoDot:1
- if $GET(DGFL)<0
- GOTO EDITQ
- +8 IF DGTYPE="S"
- SET X=+DGPREF
- DO SETUP^DGRPEIS1
- +9 KILL DGACT,DGMIEN,RELATION,DA,DIE,DR,UPARROW,DTOUT,DUOUT,DIRUT
- EDITQ KILL DA,DIE,DIRUT,DR,DTOUT,DUOUT
- +1 QUIT
- +2 ;
- SSNREA(DGEXIT) ;if SSN is pseudo Pseudo SSN Reason is required - DG*5.3*653
- +1 NEW I,EXIT
- +2 SET EXIT=0
- +3 FOR
- Begin DoDot:1
- +4 SET DR=$SELECT(DIE["DGPR":.1,1:.0906)_";S UPARROW=1"
- +5 KILL DG,DQ
- DO ^DIE
- IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(UPARROW)
- SET DGFL=$SELECT($DATA(DTOUT):-2,1:-1)
- SET (EXIT,DGEXIT)=1
- QUIT
- +6 IF $PIECE($GET(@(DIE_DA_",0)")),U,10)']""
- SET EXIT=0
- QUIT
- +7 SET EXIT=1
- End DoDot:1
- if EXIT
- QUIT
- +8 QUIT
- HELP1(DGISDT) ; Displays the help for the active/inactive prompt
- +1 ;
- +2 DO CLEAR^VALM1
- +3 WRITE !,"Enter the date this person first became a dependent of the veteran."
- +4 WRITE !,"In the case of a spouse, this would be the date of marriage. For"
- +5 WRITE !,"a child, this would be the date of birth or date of adoption. For a"
- +6 WRITE !,"stepchild, this would be the date of marriage to the child's parent."
- +7 WRITE !!,"Date must be before DEC 31, "_DGISDT_" as dependents are collected for the"
- +8 WRITE !,"prior calendar year only."
- +9 SET VALMBCK="R"
- +10 QUIT
- +11 ;
- HELPDOB ; * Displays help for Date of Birth
- +1 NEW DGRDVAR
- +2 IF X="?"
- Begin DoDot:1
- +3 WRITE !?5,"Enter the date this dependent was born. The date must not be during the"
- +4 WRITE !?5,"current calendar year. Only persons that were dependents before the"
- +5 WRITE !?5,"current year may be entered.",!
- +6 IF $GET(DA)
- WRITE !,"Enter RETURN to continue:"
- READ DGRDVAR:DTIME
- WRITE !
- End DoDot:1
- QUIT
- +7 ;
- +8 WRITE !?8,"Enter the date on which this relative was born. This information is"
- +9 WRITE !?8,"necessary for use in the income screening and means test portions of"
- +10 WRITE !?8,"MAS."
- +11 WRITE !!?8,"The date entered must not be during the current calendar year. That"
- +12 WRITE !?8,"is, it must be on or before December 31 or the prior calendar year."
- +13 IF $GET(DA)
- WRITE !
- SET DIR(0)="E"
- DO ^DIR
- if +Y<1
- QUIT
- +14 WRITE !!?8,"The reason for this is that this data is used for collecting income"
- +15 WRITE !?8,"information for the purposes of comparing this data with the Internal"
- +16 WRITE !?8,"Revenue Service (IRS). Children born during the calendar year cannot"
- +17 WRITE !?8,"be entered until next year."
- +18 IF $GET(DA)
- WRITE !!,"Enter RETURN to continue:"
- READ DGRDVAR:DTIME
- WRITE !
- +19 QUIT
- +20 ;
- HELPMN ; * Displays help for Spouse Maiden Name
- +1 WRITE !?8,"Enter the spouse's maiden name in 'LAST,FIRST MIDDLE SUFFIX' format."
- +2 WRITE !?8,"Entry of the LAST name only is permitted and the comma may be omitted."
- +3 WRITE !?8,"If the response contains no comma, one will be appended to the value."
- +4 WRITE !?8,"Including the comma, the value must be at least 3 characters in length.",!
- +5 QUIT
- +6 ;
- HELPSA1 ; * Displays help for Street Address 1
- +1 NEW DGRELTP
- +2 SET DGRELTP=$$RELTYPE^DGRPEIS2($GET(DA),1)
- +3 WRITE !,"If a "_DGRELTP_"'s name has been specified, enter the first line of"
- +4 WRITE !,"that person's street address [3-30 characters]; otherwise this field"
- +5 WRITE !,"may be left blank. This field cannot be deleted as long as a "_DGRELTP_"'s"
- +6 WRITE !,"name is on file."
- +7 IF $GET(DA)
- IF (X="?")
- WRITE !
- +8 QUIT
- +9 ;
- HELPSA2 ; * Displays help for Street Address 2
- +1 NEW DGRELTP
- +2 SET DGRELTP=$$RELTYPE^DGRPEIS2($GET(DA),1)
- +3 WRITE !,"If a "_DGRELTP_"'s name has been specified, enter the second line of"
- +4 WRITE !,"that person's street address [3-30 characters]; otherwise this field"
- +5 WRITE !,"may be left blank. This field cannot be deleted as long as a "_DGRELTP_"'s"
- +6 WRITE !,"name is on file."
- +7 IF $GET(DA)
- IF (X="?")
- WRITE !
- +8 QUIT
- +9 ;
- HELPSA3 ; * Displays help for Street Address 3
- +1 NEW DGRELTP
- +2 SET DGRELTP=$$RELTYPE^DGRPEIS2($GET(DA),1)
- +3 WRITE !,"If a "_DGRELTP_"'s name has been specified, enter the third line of"
- +4 WRITE !,"that person's street address [3-30 characters]; otherwise this field"
- +5 WRITE !,"may be left blank. This field cannot be deleted as long as a "_DGRELTP_"'s"
- +6 WRITE !,"name is on file."
- +7 IF $GET(DA)
- IF (X="?")
- WRITE !
- +8 QUIT
- +9 ;
- HELPCITY ; * Displays help for City
- +1 NEW DGRELTP
- +2 SET DGRELTP=$$RELTYPE^DGRPEIS2($GET(DA),1)
- +3 WRITE !,"If a "_DGRELTP_"'s name has been specified, enter the city in which"
- +4 WRITE !,"that person resides [3-30 characters]; otherwise this field may be"
- +5 WRITE !,"left blank. This field cannot be deleted as long as a "_DGRELTP_"'s"
- +6 WRITE !,"name is on file."
- +7 IF $GET(DA)
- IF (X="?")
- WRITE !
- +8 QUIT
- +9 ;
- HELPSTAT ; * Displays help for the state
- +1 NEW DGRELTP,DIRA,DGRDVAR,DDIOLARY
- +2 SET DGRELTP=$$RELTYPE^DGRPEIS2($GET(DA),1)
- +3 SET DDIOLARY(1)="If a "_DGRELTP_"'s name has been specified, select the state in which"
- +4 SET DDIOLARY(1,"F")="!"
- +5 SET DDIOLARY(2)="that person resides; otherwise this field may be left blank. This"
- +6 SET DDIOLARY(2,"F")="!"
- +7 SET DDIOLARY(3)="field cannot be deleted as long as a "_DGRELTP_"'s name is on file."
- +8 SET DDIOLARY(3,"F")="!"
- +9 SET DDIOLARY(4)=""
- +10 SET DDIOLARY(4,"F")="!"
- +11 DO EN^DDIOL(.DDIOLARY)
- +12 ;
- +13 if X="?"
- QUIT
- +14 DO EN^DDIOL("Enter RETURN to continue:","","!")
- +15 READ DGRDVAR:DTIME
- +16 QUIT
- +17 ;
- HELPZIP ; * Displays help for the Zip code
- +1 NEW DGRELTP
- +2 SET DGRELTP=$$RELTYPE^DGRPEIS2($GET(DA),1)
- +3 WRITE !,"Answer with the 5 digit format (e.g. 12345) or the nine digit"
- +4 WRITE !,"format (e.g. 12345-6789 or 123456789). This is related to the"
- +5 WRITE !,DGRELTP_"'s address."
- +6 IF $GET(DA)
- IF (X="?")
- WRITE !
- +7 QUIT
- HELPPHON ; * Displays help for the Phone number
- +1 NEW DGRELTP
- +2 SET DGRELTP=$$RELTYPE^DGRPEIS2($GET(DA),1)
- +3 WRITE !,"If a "_DGRELTP_"'s name has been specified, enter the "_DGRELTP_"'s"
- +4 WRITE !,"phone number [4-20 characters], otherwise this field may be left"
- +5 WRITE !,"blank. This field cannot be deleted as long as a "_DGRELTP_"'s"
- +6 WRITE !,"name is on file."
- +7 IF $GET(DA)
- IF (X="?")
- WRITE !
- +8 QUIT