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

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1DGMTDD2 ;ALB/RMO,LBD - Income Relation file (#408.22) Data Dictionary Calls ;13 MAR 1992 3:00 pm
2 ;;5.3;Registration;**33,45,518**;Aug 13, 1993
3 ;
4ID ;Identifier for Income Relation file
5 N DGIN0,DGPRI,Y
6 S DGIN0=$G(^DGMT(408.21,+$P($G(^(0)),U,2),0))
7 S DGPRI=+$P(DGIN0,U,2),Y=+DGIN0 X ^DD("DD")
8 W " ",Y W:$P($G(^DGPR(408.12,DGPRI,0)),U,2)'=1 " Relation: ",$$NAME^DGMTU1(DGPRI)," (",$$REL^DGMTU1(DGPRI),")" W !
9 Q
10 ;
11FUN ;"Trigger" Cross-reference on the Married field (#.05) and
12 ;Dependent Children field (#.08) to delete funeral and burial
13 ;expenses
14 ; If the test is a LTC Copay test do not delete the funeral and
15 ; burial expenses. Added for LTC Phase III (DG*5.3*518)
16 N DGFLD,DGIN0,DGINI,DGVAL,DGMT
17 S DGINI=+$P($G(^DGMT(408.22,DA,0)),U,2),DGIN1=$G(^DGMT(408.21,DGINI,1))
18 S DGMT=+$G(^DGMT(408.21,DGINI,"MT"))
19 I DGMT,$P($G(^DGMT(408.31,DGMT,0)),U,19)=3 Q
20 S DGFLD=1.02,DGVAL=$P(DGIN1,U,2)
21 I DGVAL]"" D KILL S $P(^DGMT(408.21,DGINI,1),U,2)=""
22 Q
23 ;
24SP ;"Trigger" Cross-reference on the Amount Contributed to Spouse field
25 ;(#.07) to delete net worth on file for a spouse
26 N DFN,DGIN2,DGINI,DGLY,DGREL,DGVAL
27 S DGIR0=$G(^DGMT(408.22,DA,0))
28 S DFN=+DGIR0,DGLY=+$G(^DGMT(408.21,+$P(DGIR0,U,2),0)) D
29 .N DA,X
30 .D GETREL^DGMTU11(DFN,"S",DGLY,$S($G(DGMTI):DGMTI,1:""))
31 S DGINI=+$$IAI^DGMTU3(+$G(DGREL("S")),DGLY)
32 S DGIN2=$G(^DGMT(408.21,DGINI,2))
33 F DGFLD=2.01:.01:2.05 S DGVAL=$P(DGIN2,U,(DGFLD-2)/.01) I DGVAL]"" D
34 .D KILL
35 .S $P(^DGMT(408.21,DGINI,2),U,(DGFLD-2)/.01)=""
36 Q
37 ;
38INC ;"Trigger" Cross-reference on the Child Had Income field (#.11) and
39 ;Income Available To You field (#.12) to delete educational expenses
40 ;on file for a child
41 N DGINI
42 S DGINI=+$P($G(^DGMT(408.22,DA,0)),U,2)
43 I $P($G(^DGMT(408.21,DGINI,0)),U,14)]"" D
44 .N DGFLD,DGVAL
45 .I $P($G(^DGMT(408.21,DGINI,1)),U,3)]"" S DGVAL=$P(^(1),U,3),DGFLD=1.03 D KILL S $P(^DGMT(408.21,DGINI,1),U,3)=""
46 Q
47KILL ;Kill Cross-Reference
48 N DA,DGIX,X
49 S DA=DGINI,X=DGVAL,DGIX=0
50 F S DGIX=$O(^DD(408.21,DGFLD,1,DGIX)) Q:'DGIX X ^(DGIX,2) S X=DGVAL
51 Q
52 ;
53MAR ;Input Transform check for the Married field (#.05)
54 ;for an active spouse
55 N DFN,DGIR0,DGLY,DGREL
56 S DGIR0=$G(^DGMT(408.22,DA,0))
57 S DFN=+DGIR0,DGLY=+$G(^DGMT(408.21,+$P(DGIR0,U,2),0)) D
58 .N DA,X
59 .D GETREL^DGMTU11(DFN,"S",DGLY,$S($G(DGMTI):DGMTI,1:""))
60 I $D(DGREL("S")) W !?5,"An active spouse exists. Married cannot be 'NO'.",!?5,"You have to use the 'Expand Dependent' action and inactive first." K X
61 Q
62 ;
63DEP ;Input Transform check for the Dependent Children field (#.08)
64 ;for active children
65 N DFN,DGDEP,DGIR0,DGLY,DGREL
66 S DGIR0=$G(^DGMT(408.22,DA,0))
67 S DFN=+DGIR0,DGLY=+$G(^DGMT(408.21,+$P(DGIR0,U,2),0)) D
68 .N DA,X
69 .D GETREL^DGMTU11(DFN,"C",DGLY,$S($G(DGMTI):DGMTI,1:""))
70 I $D(DGREL("C")) W !?5,"Active children exist. Dependent Children cannot be 'NO'." K X
71 Q
72 ;
73LIV ;Input Transform check for Lived With Patient field (#.06)
74 N DGIR0,DGPRI
75 S DGIR0=$G(^DGMT(408.22,DA,0)),DGPRI=+$P($G(^DGMT(408.21,+$P(DGIR0,U,2),0)),U,2)
76 I $P($G(^DGPR(408.12,DGPRI,0)),U,2)=1,'$P(DGIR0,U,5) W !?5,"This field does not need to be filled in unless the patient is married." K X
77 Q
78 ;
79AMT ;Input Transform check for Amount Contributed To Spouse field (#.07)
80 N DGIR0,DGPRI
81 S DGIR0=$G(^DGMT(408.22,DA,0)),DGPRI=+$P($G(^DGMT(408.21,+$P(DGIR0,U,2),0)),U,2)
82 I $P($G(^DGPR(408.12,DGPRI,0)),U,2)=1,('$P(DGIR0,U,5)!($P(DGIR0,U,6)'=0)) W !?5,"This field does not need to be filled in unless the patient was married",!?5,"and did not live with his or her spouse." K X
83 Q
84 ;
85CON ;Input Transform check for Contributed To Support field (#.1)
86 N DGIR0,DGPRI
87 S DGIR0=$G(^DGMT(408.22,DA,0)),DGPRI=+$P($G(^DGMT(408.21,+$P(DGIR0,U,2),0)),U,2)
88 I "^3^4^5^6^"[(U_$P($G(^DGPR(408.12,DGPRI,0)),U,2)_U),$P(DGIR0,U,6)'=0 W !?5,"This field does not need to be filled in unless the child did not",!?5,"live with the patient." K X
89 Q
90 ;
91AVL ;Input Transform check for Income Available To You field (#.12)
92 I '$P($G(^DGMT(408.22,DA,0)),U,11) W !?5,"This field does not need to be filled in unless the child has income." K X
93 Q
94 ;
95NAM ;Output Transform for Individual Annual Income field (#.02)
96 N DGIN0,DGPRI
97 S DGIN0=$G(^DGMT(408.21,Y,0)),DGPRI=+$P(DGIN0,U,2),Y=+DGIN0 X ^DD("DD")
98 S Y=Y_" "_$$NAME^DGMTU1(DGPRI)
99 Q
100 ;
101LIVHLP ;Help for Lived With Patient field (#.06)
102 N DGIR0,DGPRI
103 S DGIR0=$G(^DGMT(408.22,DA,0)),DGPRI=+$P($G(^DGMT(408.21,+$P(DGIR0,U,2),0)),U,2)
104 I $P($G(^DGPR(408.12,DGPRI,0)),U,2)=1 W !?5,"Enter in this field whether the veteran resided with his or her spouse",!?5,"last calendar year. If they were living apart because one was",!?5,"hospitalized or in a nursing home, enter 'YES'."
105 I "^3^4^5^6^"[(U_$P($G(^DGPR(408.12,DGPRI,0)),U,2)_U) W !?5,"Enter in this field whether the child resided with the veteran last",!?5,"calendar year."
106 W !
107 Q
Note: See TracBrowser for help on using the repository browser.