| 1 | EASECED2 ;ALB/LBD - EDIT INCOME SCREENING DATA ;20 AUG 2001
 | 
|---|
| 2 |  ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5**;Mar 15, 2001
 | 
|---|
| 3 |  ;NOTE: This routine was modified from DGRPEIS2 for LTC Co-pay
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 | SPOUSE ; make sure marital status, spouse is up-to-date
 | 
|---|
| 7 |  ; input -- DFN
 | 
|---|
| 8 |  ;          DGREL("V") as returned from GETREL for veteran
 | 
|---|
| 9 |  ;  used -- DGSPFL as VETS marital status
 | 
|---|
| 10 |  N DGMS
 | 
|---|
| 11 |  D GETIENS^EASECU2(DFN,+DGREL("V"),DT)
 | 
|---|
| 12 |  S DGMS=$P($G(^DIC(11,+$P($G(^DPT(DFN,0)),"^",5),0)),"^",3),DGMS=$S("^M^S^"[("^"_DGMS_"^"):"YES",DGMS']"":"",1:"NO")
 | 
|---|
| 13 |  D GETREL^DGMTU11(DFN,"S",DT,$G(DGMTI)) I $D(DGREL("S")) S DGMS="YES"
 | 
|---|
| 14 |  ;
 | 
|---|
| 15 | SPOUSE1 S DIE="^DGMT(408.22,",DA=DGIRI,DR=".05"_$S($G(DGMTI):"///",1:"//")_"^S X=DGMS" D ^DIE K DIE,DA,DR
 | 
|---|
| 16 |  S DGSPFL=$P($G(^DGMT(408.22,DGIRI,0)),"^",5)
 | 
|---|
| 17 |  Q
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 | ACT ; ask date active as of (use dob if KIDS)
 | 
|---|
| 20 |  ; In:  DOB
 | 
|---|
| 21 |  ;      DGRP0ND as 0 node of PATIENT RELATION file (relation=piece 2)
 | 
|---|
| 22 |  ;Out:  DGACT as date patient should be activated as of
 | 
|---|
| 23 |  ;      DGFL as -1 if '^' or -2 if time-out
 | 
|---|
| 24 |  N RELATION,X,Y
 | 
|---|
| 25 |  S DGFL=$G(DGFL),RELATION=$P(DGRP0ND,"^",2)
 | 
|---|
| 26 |  I RELATION=1 S DGACT=DOB Q  ;use DOB is self
 | 
|---|
| 27 |  I "^3^4^"[("^"_RELATION_"^") S Y=DOB X ^DD("DD") S DIR("B")=Y ;if son or daughter, use DOB as default
 | 
|---|
| 28 |  ;
 | 
|---|
| 29 | READ ; get active as of date
 | 
|---|
| 30 |  ; DIR("B") set before entry
 | 
|---|
| 31 |  ; DOB passed in as input
 | 
|---|
| 32 |  N DGDT,DGISDT,DGDTSPEC
 | 
|---|
| 33 |  I '$D(DGTSTDT) N DGTSTDT S DGTSTDT=$S($D(DGMTDT):DGMTDT,1:DT)
 | 
|---|
| 34 |  S DGDT=$E(DGTSTDT,1,3)_"1231",DGISDT=$E(DGDT,1,3)+1700,DGACT=DOB
 | 
|---|
| 35 |  S DGDTSPEC=$S($G(DGEDDEP):":EPX",1:":EP")
 | 
|---|
| 36 |  S DIR(0)="D^"_DOB_":"_DGDT_DGDTSPEC,DIR("A")="EFFECTIVE DATE"
 | 
|---|
| 37 |  S DIR("?")="^D HELP1^EASECED3(DGISDT)"
 | 
|---|
| 38 |  D ^DIR K DIR I Y'>0 S DGFL=$S($D(DTOUT):-2,$D(DUOUT)!$D(DIRUT):-1,1:0) G ACTQ:DGFL,READ
 | 
|---|
| 39 |  S DGACT=Y
 | 
|---|
| 40 | ACTQ K DIRUT,DTOUT,DUOUT
 | 
|---|
| 41 |  Q
 | 
|---|