source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPEIS2.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1DGRPEIS2 ;ALB/MIR,ERC - EDIT INCOME SCREENING DATA (SCREEN 9) ; 10/6/05 4:33pm
2 ;;5.3;Registration;**10,45,122,653**;Aug 13, 1993;Build 2
3 ; -Called from DGRPE to edit Scr #9 (Income Screening)
4EDIT9 ; Allow edit of income screening amounts (called from DGRPE)
5 ; In: DFN
6 ; DGRPANN as string of selected items
7 ; DGRPSEL as allowable groups for edit (V, S, and/or D)
8 ; DGRPSELT (maybe) as type of dependent selected (V=vet,
9 ; S=spouse, and D=dependent). If not defined, it is set
10 ; to DGRPSEL.
11 I 'DGRPANN Q ; if no string passed in (nothing selected)
12 S DGRPSELT=$G(DGRPSELT) I DGRPSELT']"" S DGRPSELT=DGRPSEL ; if no V, S, or D preface, edit all
13 D ALL^DGMTU21(DFN,"VSD",DT,"IP")
14 I '$G(DGREL("V")) D HELP^DGRPEIS3 G EDIT9Q
15 I DGRPSELT["V" S DGPRI=+DGREL("V"),DGMTED=$D(DGMTED("V")) D EDT
16 I '$G(DGRPOUT)&(DGRPSELT["S") S DGPRI=+DGREL("S"),DGMTED=$D(DGMTED("S")) D EDT
17 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
18 S DGFL=$G(DGFL)
19 K DGCNT
20EDIT9Q Q
21 ;
22EDT ;Edit inc and nt worth
23 N DA,DGERR,DGFIN,DGINI,DGIRI,DIE,DR,OK
24 I '$D(DGTSTDT) N DGTSTDT S DGTSTDT=$S($D(DGMTDT):DGMTDT,1:DT)
25 D GETIENS^DGMTU2(DFN,+DGPRI,DGTSTDT) G EDTQ:DGERR
26 I DGRPSELT]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
27 I DGMTED W " [Must edit through means test!!]" Q
28 S DA=DGINI,DIE="^DGMT(408.21,",DR="[DGRP ENTER/EDIT ANNUAL INCOME]" D ^DIE S:'$D(DGFIN) DGRPOUT=1
29 I $D(DTOUT) S DGFL=-2,DGRPOUT=1 Q
30 I 'DGRPOUT S DR="103////^S X=DUZ;104///^S X=""NOW""" D ^DIE
31 I 'DGRPOUT&'$D(DGINC("V")) D GETIENS^DGMTU2(DFN,+DGREL("V"),DT) S DGINC("V")=DGINI G:DGERR EDTQ
32 I 'DGRPOUT&($G(DA)'=$G(DGINC("V"))) S DA=DGINC("V") D ^DIE
33 ;
34 ;log patient for transmission to HEC if DCD criteria are met
35 D LOGDCD^IVMCUC($G(DFN))
36 ;
37EDTQ Q
38 ;
39SPOUSE ; make sure marital status, spouse is up-to-date
40 ; input -- DFN
41 ; DGREL("V") as returned from GETREL for veteran
42 ; used -- DGSPFL as VETS marital status
43 N DGMS
44 D GETIENS^DGMTU2(DFN,+DGREL("V"),DT)
45 S DGMS=$P($G(^DIC(11,+$P($G(^DPT(DFN,0)),"^",5),0)),"^",3),DGMS=$S("^M^S^"[("^"_DGMS_"^"):"YES",DGMS']"":"",1:"NO")
46 D GETREL^DGMTU11(DFN,"S",DT,$G(DGMTI)) I $D(DGREL("S")) S DGMS="YES"
47 ;
48SPOUSE1 S DIE="^DGMT(408.22,",DA=DGIRI,DR=".05"_$S($G(DGMTI):"///",1:"//")_"^S X=DGMS" D ^DIE K DIE,DA,DR
49 S DGSPFL=$P($G(^DGMT(408.22,DGIRI,0)),"^",5)
50 Q
51 ;
52ACT ; ask date active as of (use dob if KIDS)
53 ; In: DOB
54 ; DGRP0ND as 0 node of PATIENT RELATION file (relation=piece 2)
55 ;Out: DGACT as date patient should be activated as of
56 ; DGFL as -1 if '^' or -2 if time-out
57 N RELATION,X,Y
58 S DGFL=$G(DGFL),RELATION=$P(DGRP0ND,"^",2)
59 I RELATION=1 S DGACT=DOB Q ;use DOB is self
60 I "^3^4^"[("^"_RELATION_"^") S Y=DOB X ^DD("DD") S DIR("B")=Y ;if son or daughter, use DOB as default
61 ;
62READ ; get active as of date
63 ; DIR("B") set before entry
64 ; DOB passed in as input
65 N DGDT,DGISDT,DGDTSPEC
66 I '$D(DGTSTDT) N DGTSTDT S DGTSTDT=$S($D(DGMTDT):DGMTDT,1:DT)
67 S DGDT=$E(DGTSTDT,1,3)-1_"1231",DGISDT=$E(DGDT,1,3)+1700,DGACT=DOB
68 S DGDTSPEC=$S($G(DGEDDEP):":EPX",1:":EP")
69 S DIR(0)="D^"_DOB_":"_DGDT_DGDTSPEC,DIR("A")="EFFECTIVE DATE"
70 S DIR("?")="^D HELP1^DGRPEIS3(DGISDT)"
71 D ^DIR K DIR I Y'>0 S DGFL=$S($D(DTOUT):-2,$D(DUOUT)!$D(DIRUT):-1,1:0) G ACTQ:DGFL,READ
72 S DGACT=Y
73ACTQ K DIRUT,DTOUT,DUOUT
74 Q
75RELTYPE(RELIEN,TYPE) ;* Return type of relationship
76 ;
77 ;* INPUT
78 ; RELIEN - IEN from Income Person file (408.13)
79 ; TYPE - 0: Pull specific relationship from Relationship file
80 ; - 1: Just return "spouse", "child", "dependent"
81 ;
82 ;* OUTPUT
83 ; DGPATREL - Relationship value
84 ;
85 N DGPTRLIN,DGRELIEN,DGPATREL
86 S TYPE=+$G(TYPE)
87 I +$G(RELIEN)>0 DO
88 .S DGPTRLIN=""
89 .S DGPTRLIN=$O(^DGPR(408.12,"C",RELIEN_";DGPR(408.13,",DGPTRLIN))
90 .S DGRELIEN=$P($G(^DGPR(408.12,DGPTRLIN,0)),"^",2)
91 .S DGPATREL=$P($G(^DG(408.11,DGRELIEN,0)),"^",1)
92 .S:DGPATREL']"" DGPATREL="dependent"
93 .I +TYPE=1 S DGPATREL=$S(DGPATREL["SPOUSE":"spouse",($G(DGRPS)=8):"relative",$G(DGSCR8):"relative",1:"child")
94 I +$G(RELIEN)'>0 DO
95 .S:$G(DGANS)="S" DGPATREL="spouse"
96 .S:$G(DGANS)="C" DGPATREL="child"
97 .S:$G(DGANS)="D" DGPATREL="relative"
98 S:DGPATREL="" DGPATREL="relative"
99 Q DGPATREL
Note: See TracBrowser for help on using the repository browser.