EASECED2.m

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 ---EASECED2   1745     printed  Apr 09, 2024@20:58:10                                                                                                                                                                                                    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