- EASECED2 ;ALB/LBD - EDIT INCOME SCREENING DATA ;20 AUG 2001
- ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5**;Mar 15, 2001
- ;NOTE: This routine was modified from DGRPEIS2 for LTC Co-pay
- ;
- ;
- SPOUSE ; make sure marital status, spouse is up-to-date
- ; input -- DFN
- ; DGREL("V") as returned from GETREL for veteran
- ; used -- DGSPFL as VETS marital status
- N DGMS
- D GETIENS^EASECU2(DFN,+DGREL("V"),DT)
- S DGMS=$P($G(^DIC(11,+$P($G(^DPT(DFN,0)),"^",5),0)),"^",3),DGMS=$S("^M^S^"[("^"_DGMS_"^"):"YES",DGMS']"":"",1:"NO")
- D GETREL^DGMTU11(DFN,"S",DT,$G(DGMTI)) I $D(DGREL("S")) S DGMS="YES"
- ;
- SPOUSE1 S DIE="^DGMT(408.22,",DA=DGIRI,DR=".05"_$S($G(DGMTI):"///",1:"//")_"^S X=DGMS" D ^DIE K DIE,DA,DR
- S DGSPFL=$P($G(^DGMT(408.22,DGIRI,0)),"^",5)
- Q
- ;
- ACT ; ask date active as of (use dob if KIDS)
- ; In: DOB
- ; DGRP0ND as 0 node of PATIENT RELATION file (relation=piece 2)
- ;Out: DGACT as date patient should be activated as of
- ; DGFL as -1 if '^' or -2 if time-out
- N RELATION,X,Y
- S DGFL=$G(DGFL),RELATION=$P(DGRP0ND,"^",2)
- I RELATION=1 S DGACT=DOB Q ;use DOB is self
- I "^3^4^"[("^"_RELATION_"^") S Y=DOB X ^DD("DD") S DIR("B")=Y ;if son or daughter, use DOB as default
- ;
- READ ; get active as of date
- ; DIR("B") set before entry
- ; DOB passed in as input
- N DGDT,DGISDT,DGDTSPEC
- I '$D(DGTSTDT) N DGTSTDT S DGTSTDT=$S($D(DGMTDT):DGMTDT,1:DT)
- S DGDT=$E(DGTSTDT,1,3)_"1231",DGISDT=$E(DGDT,1,3)+1700,DGACT=DOB
- S DGDTSPEC=$S($G(DGEDDEP):":EPX",1:":EP")
- S DIR(0)="D^"_DOB_":"_DGDT_DGDTSPEC,DIR("A")="EFFECTIVE DATE"
- S DIR("?")="^D HELP1^EASECED3(DGISDT)"
- D ^DIR K DIR I Y'>0 S DGFL=$S($D(DTOUT):-2,$D(DUOUT)!$D(DIRUT):-1,1:0) G ACTQ:DGFL,READ
- S DGACT=Y
- ACTQ K DIRUT,DTOUT,DUOUT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECED2 1745 printed Feb 18, 2025@23:20:26 Page 2
- EASECED2 ;ALB/LBD - EDIT INCOME SCREENING DATA ;20 AUG 2001
- +1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5**;Mar 15, 2001
- +2 ;NOTE: This routine was modified from DGRPEIS2 for LTC Co-pay
- +3 ;
- +4 ;
- SPOUSE ; make sure marital status, spouse is up-to-date
- +1 ; input -- DFN
- +2 ; DGREL("V") as returned from GETREL for veteran
- +3 ; used -- DGSPFL as VETS marital status
- +4 NEW DGMS
- +5 DO GETIENS^EASECU2(DFN,+DGREL("V"),DT)
- +6 SET DGMS=$PIECE($GET(^DIC(11,+$PIECE($GET(^DPT(DFN,0)),"^",5),0)),"^",3)
- SET DGMS=$SELECT("^M^S^"[("^"_DGMS_"^"):"YES",DGMS']"":"",1:"NO")
- +7 DO GETREL^DGMTU11(DFN,"S",DT,$GET(DGMTI))
- IF $DATA(DGREL("S"))
- SET DGMS="YES"
- +8 ;
- SPOUSE1 SET DIE="^DGMT(408.22,"
- SET DA=DGIRI
- SET DR=".05"_$SELECT($GET(DGMTI):"///",1:"//")_"^S X=DGMS"
- DO ^DIE
- KILL DIE,DA,DR
- +1 SET DGSPFL=$PIECE($GET(^DGMT(408.22,DGIRI,0)),"^",5)
- +2 QUIT
- +3 ;
- ACT ; ask date active as of (use dob if KIDS)
- +1 ; In: DOB
- +2 ; DGRP0ND as 0 node of PATIENT RELATION file (relation=piece 2)
- +3 ;Out: DGACT as date patient should be activated as of
- +4 ; DGFL as -1 if '^' or -2 if time-out
- +5 NEW RELATION,X,Y
- +6 SET DGFL=$GET(DGFL)
- SET RELATION=$PIECE(DGRP0ND,"^",2)
- +7 ;use DOB is self
- IF RELATION=1
- SET DGACT=DOB
- QUIT
- +8 ;if son or daughter, use DOB as default
- IF "^3^4^"[("^"_RELATION_"^")
- SET Y=DOB
- XECUTE ^DD("DD")
- SET DIR("B")=Y
- +9 ;
- READ ; get active as of date
- +1 ; DIR("B") set before entry
- +2 ; DOB passed in as input
- +3 NEW DGDT,DGISDT,DGDTSPEC
- +4 IF '$DATA(DGTSTDT)
- NEW DGTSTDT
- SET DGTSTDT=$SELECT($DATA(DGMTDT):DGMTDT,1:DT)
- +5 SET DGDT=$EXTRACT(DGTSTDT,1,3)_"1231"
- SET DGISDT=$EXTRACT(DGDT,1,3)+1700
- SET DGACT=DOB
- +6 SET DGDTSPEC=$SELECT($GET(DGEDDEP):":EPX",1:":EP")
- +7 SET DIR(0)="D^"_DOB_":"_DGDT_DGDTSPEC
- SET DIR("A")="EFFECTIVE DATE"
- +8 SET DIR("?")="^D HELP1^EASECED3(DGISDT)"
- +9 DO ^DIR
- KILL DIR
- IF Y'>0
- SET DGFL=$SELECT($DATA(DTOUT):-2,$DATA(DUOUT)!$DATA(DIRUT):-1,1:0)
- if DGFL
- GOTO ACTQ
- GOTO READ
- +10 SET DGACT=Y
- ACTQ KILL DIRUT,DTOUT,DUOUT
- +1 QUIT