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

DGRPEIS2.m

Go to the documentation of this file. 
  1. DGRPEIS2 ;ALB/MIR,ERC - EDIT INCOME SCREENING DATA (SCREEN 9) ; 4/20/06 10:37am
  1.  ;;5.3;Registration;**10,45,122,653,688**;Aug 13, 1993;Build 29
  1.  ;  -Called from DGRPE to edit Scr #9 (Income Screening)
  1. EDIT9 ; Allow edit of income screening amounts (called from DGRPE)
  1.  ; In: DFN
  1.  ;     DGRPANN as string of selected items
  1.  ;     DGRPSEL as allowable groups for edit (V, S, and/or D)
  1.  ;     DGRPSELT (maybe) as type of dependent selected (V=vet,
  1.  ;        S=spouse, and D=dependent).  If not defined, it is set
  1.  ;        to DGRPSEL.
  1.  N MTVER,DGMTI,DGTY,DGIAIYR,DGTYEXT
  1.  I 'DGRPANN Q  ; if no string passed in (nothing selected)
  1.  S DGRPSELT=$G(DGRPSELT) I DGRPSELT']"" S DGRPSELT=DGRPSEL ; if no V, S, or D preface, edit all
  1.  D ALL^DGMTU21(DFN,"VSD",DT,"IP")
  1.  S DGIAIYR=$P($G(^DGMT(408.21,+$G(DGINC("V")),0)),"^",1)
  1.  S DGIAIYR=$E(DGIAIYR,1,3)+1700
  1.  S DGMTI=+$$LST^DGMTU(DFN,DT)
  1.  I (+DGMTI>0),(+DGIAIYR>0) DO
  1.  . S DGTY=$E($P(^DGMT(408.31,+DGMTI,0),"^",1),1,3)
  1.  . S DGTYEXT=DGTY+1700
  1.  . S:(DGTYEXT=DGIAIYR+1) MTVER=$P($G(^DGMT(408.31,+DGMTI,2)),"^",11)
  1.  . S:(DGTYEXT'=(DGIAIYR+1)) MTVER=$$VER^DGMTUTL3(.DGINC)
  1.  I (+DGMTI'>0)!(+DGIAIYR'>0) S MTVER=$$VER^DGMTUTL3(.DGINC)
  1.  I '$G(DGREL("V")) D HELP^DGRPEIS3 G EDIT9Q
  1.  I DGRPSELT["V" S DGPRI=+DGREL("V"),DGMTED=$D(DGMTED("V")) D EDT
  1.  I '$G(DGRPOUT)&(DGRPSELT["S") S DGPRI=+DGREL("S"),DGMTED=$D(DGMTED("S")) D EDT
  1.  I '$G(DGRPOUT)&(DGRPSELT["D") F DGCNT=0:0 S DGCNT=$O(DGREL("D",DGCNT)) Q:'DGCNT!($G(DGRPOUT))  S DGPRI=+DGREL("D",DGCNT),DGMTED=$D(DGMTED("D",DGCNT)) D EDT
  1.  S DGFL=$G(DGFL)
  1.  K DGCNT
  1. EDIT9Q Q
  1.  ;
  1. EDT ;Edit inc and nt worth
  1.  N DA,DGERR,DGFIN,DGINI,DGIRI,DIE,DR,OK
  1.  I '$D(DGTSTDT) N DGTSTDT S DGTSTDT=$S($D(DGMTDT):DGMTDT,1:DT)
  1.  D GETIENS^DGMTU2(DFN,+DGPRI,DGTSTDT) G EDTQ:DGERR
  1.  I DGRPSELT]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
  1.  I DGMTED W "    [Must edit through means test!!]" Q
  1.  S DA=DGINI,DIE="^DGMT(408.21,"
  1.  S:(+MTVER<1) DR="[DGRP ENTER/EDIT ANNUAL INCOME]"
  1.  S:(+MTVER=1) DR="[DGRP V1 ENTER/EDIT ANNUAL INC]"
  1.  D ^DIE S:'$D(DGFIN) DGRPOUT=1
  1.  I $D(DTOUT) S DGFL=-2,DGRPOUT=1 Q
  1.  I 'DGRPOUT S DR="103////^S X=DUZ;104///^S X=""NOW""" D ^DIE
  1.  I 'DGRPOUT&'$D(DGINC("V")) D GETIENS^DGMTU2(DFN,+DGREL("V"),DT) S DGINC("V")=DGINI G:DGERR EDTQ
  1.  I 'DGRPOUT&($G(DA)'=$G(DGINC("V"))) S DA=DGINC("V") D ^DIE
  1.  ;
  1.  ;log patient for transmission to HEC if DCD criteria are met
  1.  D LOGDCD^IVMCUC($G(DFN))
  1.  ;
  1. EDTQ Q
  1.  ;
  1. SPOUSE ; make sure marital status, spouse is up-to-date
  1.  ; input -- DFN
  1.  ;          DGREL("V") as returned from GETREL for veteran
  1.  ;  used -- DGSPFL as VETS marital status
  1.  N DGMS
  1.  D GETIENS^DGMTU2(DFN,+DGREL("V"),DT)
  1.  S DGMS=$P($G(^DIC(11,+$P($G(^DPT(DFN,0)),"^",5),0)),"^",3),DGMS=$S("^M^S^"[("^"_DGMS_"^"):"YES",DGMS']"":"",1:"NO")
  1.  D GETREL^DGMTU11(DFN,"S",DT,$G(DGMTI)) I $D(DGREL("S")) S DGMS="YES"
  1.  ;
  1. SPOUSE1 S DIE="^DGMT(408.22,",DA=DGIRI,DR=".05"_$S($G(DGMTI):"///",1:"//")_"^S X=DGMS" D ^DIE K DIE,DA,DR
  1.  S DGSPFL=$P($G(^DGMT(408.22,DGIRI,0)),"^",5)
  1.  Q
  1.  ;
  1. ACT ; ask date active as of (use dob if KIDS)
  1.  ; In:  DOB
  1.  ;      DGRP0ND as 0 node of PATIENT RELATION file (relation=piece 2)
  1.  ;Out:  DGACT as date patient should be activated as of
  1.  ;      DGFL as -1 if '^' or -2 if time-out
  1.  N RELATION,X,Y
  1.  S DGFL=$G(DGFL),RELATION=$P(DGRP0ND,"^",2)
  1.  I RELATION=1 S DGACT=DOB Q  ;use DOB is self
  1.  I "^3^4^"[("^"_RELATION_"^") S Y=DOB X ^DD("DD") S DIR("B")=Y ;if son or daughter, use DOB as default
  1.  ;
  1. READ ; get active as of date
  1.  ; DIR("B") set before entry
  1.  ; DOB passed in as input
  1.  N DGDT,DGISDT,DGDTSPEC,VDOB
  1.  I '$D(DGTSTDT) N DGTSTDT S DGTSTDT=$S($D(DGMTDT):DGMTDT,1:DT)
  1.  S DGDT=$E(DGTSTDT,1,3)-1_"1231",DGISDT=$E(DGDT,1,3)+1700,DGACT=DOB
  1.  S DGDTSPEC=$S($G(DGEDDEP):":EPX",1:":EP")
  1.  ;S DIR(0)="D^"_DOB_":"_DGDT_DGDTSPEC,DIR("A")="EFFECTIVE DATE"
  1.  S DIR(0)="D^"_DOB
  1.  I RELATION=2 S VDOB=$P($G(^DPT(DFN,0)),"^",3) S:(VDOB>DOB) $P(DIR(0),"^",2)=VDOB
  1.  S DIR(0)=DIR(0)_":"_DGDT_DGDTSPEC,DIR("A")="EFFECTIVE DATE"
  1.  S DIR("?")="^D HELP1^DGRPEIS3(DGISDT)"
  1.  D ^DIR K DIR I Y'>0 S DGFL=$S($D(DTOUT):-2,$D(DUOUT)!$D(DIRUT):-1,1:0) G ACTQ:DGFL,READ
  1.  S DGACT=Y
  1. ACTQ K DIRUT,DTOUT,DUOUT
  1.  Q
  1. RELTYPE(RELIEN,TYPE) ;* Return type of relationship
  1.  ;
  1.  ;* INPUT
  1.  ;    RELIEN - IEN from Income Person file (408.13)
  1.  ;    TYPE   - 0: Pull specific relationship from Relationship file
  1.  ;           - 1: Just return "spouse", "child", "dependent"
  1.  ;
  1.  ;* OUTPUT
  1.  ;    DGPATREL - Relationship value
  1.  ;
  1.  N DGPTRLIN,DGRELIEN,DGPATREL
  1.  S TYPE=+$G(TYPE)
  1.  I +$G(RELIEN)>0 DO
  1.  .S DGPTRLIN=""
  1.  .S DGPTRLIN=$O(^DGPR(408.12,"C",RELIEN_";DGPR(408.13,",DGPTRLIN))
  1.  .S DGRELIEN=$P($G(^DGPR(408.12,DGPTRLIN,0)),"^",2)
  1.  .S DGPATREL=$P($G(^DG(408.11,DGRELIEN,0)),"^",1)
  1.  .S:DGPATREL']"" DGPATREL="dependent"
  1.  .I +TYPE=1 S DGPATREL=$S(DGPATREL["SPOUSE":"spouse",($G(DGRPS)=8):"relative",$G(DGSCR8):"relative",1:"child")
  1.  I +$G(RELIEN)'>0 DO
  1.  .S:$G(DGANS)="S" DGPATREL="spouse"
  1.  .S:$G(DGANS)="C" DGPATREL="child"
  1.  .S:$G(DGANS)="D" DGPATREL="relative"
  1.  S:DGPATREL="" DGPATREL="relative"
  1.  Q DGPATREL