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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1DGMTUTL2 ;ALB/RMM - Means Test Consistency Checker ; 04/28/2005
2 ;;5.3;Registration;**463,655**;Aug 13, 1993
3 ;
4 ; This routine sets the data strings used in the Income Test
5 ; Inconsistency Checks.
6 Q
7 ;
8ZIC(VAFIEN,DEPIEN) ; Build ZIC the data string for the veteran
9 ;
10 N NODE0,NODE1,NODE2,ZIC
11 S NODE0=$G(^DGMT(408.21,VAFIEN,0))
12 S NODE1=$G(^DGMT(408.21,VAFIEN,1))
13 S NODE2=$G(^DGMT(408.21,VAFIEN,2))
14 S ZIC="ZIC"
15 S $P(ZIC,U,2)=$P(NODE0,U,1) ;Income Year
16 S $P(ZIC,U,3)=$P(NODE0,U,8) ;Social Security
17 S $P(ZIC,U,4)=$P(NODE0,U,9) ;U.S. Civil Service
18 S $P(ZIC,U,5)=$P(NODE0,U,10) ;U.S. Railroad Retirement
19 S $P(ZIC,U,6)=$P(NODE0,U,11) ;Military Retirement
20 S $P(ZIC,U,7)=$P(NODE0,U,12) ;Unemployment Compensation
21 S $P(ZIC,U,9)=$P(NODE0,U,14) ;Total Income from Employment
22 S $P(ZIC,U,10)=$P(NODE0,U,15) ;Interest,Dividend,Annuity
23 S $P(ZIC,U,11)=$P(NODE0,U,16) ;Workers Comp. or Black Lung
24 S $P(ZIC,U,12)=$P(NODE0,U,17) ;All Other Income
25 S $P(ZIC,U,13)=$P(NODE1,U,1) ;Medical Expenses
26 S $P(ZIC,U,14)=$P(NODE1,U,2) ;Funeral And Burial Expenses
27 S $P(ZIC,U,15)=$P(NODE1,U,3) ;Educational Expenses
28 S $P(ZIC,U,16)=$P(NODE2,U,1) ;Cash, Amount In Bank Accounts
29 S $P(ZIC,U,17)=$P(NODE2,U,2) ;Stocks And Bonds
30 S $P(ZIC,U,18)=$P(NODE2,U,3) ;Real Property
31 S $P(ZIC,U,19)=$P(NODE2,U,4) ;Other Property or Assets
32 S $P(ZIC,U,20)=$P(NODE2,U,5) ;Debts
33 ;
34 ; Adjust date field to correct format
35 S $P(ZIC,U,2)=$E($P(ZIC,U,2),1,3)+1700_$E($P(ZIC,U,2),4,7)
36 ;
37 Q ZIC
38 ;
39ZIR(VAFIEN,DEPIEN) ; Build ZIR the data string for the veteran
40 N NODE0,ZIR
41 S NODE0=$G(^DGMT(408.22,VAFIEN,0)),ZIR="ZIR"
42 S $P(ZIR,U,3)=$P(NODE0,U,6) ;Lived With Patient
43 S $P(ZIR,U,4)=$P(NODE0,U,7) ;Amount Contributed to Spouse
44 S $P(ZIR,U,8)=$P(NODE0,U,11) ;Child Had Income
45 S $P(ZIR,U,9)=$P(NODE0,U,12) ;Income Available to You
46 Q ZIR
47 ;
48ZMT(DGMTI) ; Build ZMT the data string for the veteran
49 ;
50 N NODE0,NODE2,ZMT
51 S NODE0=$G(^DGMT(408.31,DGMTI,0))
52 S NODE2=$G(^DGMT(408.31,DGMTI,2)),ZMT="ZMT"
53 S $P(ZMT,U,2)=$P(NODE0,U,1) ;Means Test Date
54 S $P(ZMT,U,3)=$P(NODE0,U,3) ;Means Test Status
55 S $P(ZMT,U,4)=$P(NODE0,U,4) ;Income
56 S $P(ZMT,U,5)=$P(NODE0,U,5) ;Net Worth
57 S $P(ZMT,U,6)=$P(NODE0,U,10) ;Date/Time of Adjudication
58 S $P(ZMT,U,7)=$P(NODE0,U,11) ;Agreed to Pay Deductible
59 S $P(ZMT,U,8)=$P(NODE0,U,12) ;Threshold A
60 S $P(ZMT,U,9)=$P(NODE0,U,15) ;Deductible Expenses
61 S $P(ZMT,U,10)=$P(NODE0,U,7) ;Date/Time MT Completed
62 S $P(ZMT,U,11)=$P(NODE0,U,16) ;Previous Yr MT Threshold Flag
63 S $P(ZMT,U,12)=$P(NODE0,U,18) ;Total Dependents
64 S $P(ZMT,U,13)=$P(NODE0,U,20) ;Hardship
65 S $P(ZMT,U,14)=$P(NODE0,U,21) ;Hardship Review Date
66 S $P(ZMT,U,15)=$P(NODE0,U,24) ;Date Veteran Signed Test
67 S $P(ZMT,U,16)=$P(NODE0,U,14) ;Declines to Give Income Info
68 S $P(ZMT,U,17)=$P(NODE0,U,19) ;Type of Test
69 S $P(ZMT,U,18)=$P(NODE0,U,23) ;Source of Income Test
70 S $P(ZMT,U,19)=$P($G(^DGMT(408.31,DGMTI,"PRIM")),U,1) ;Primary Test?
71 S $P(ZMT,U,20)=$P(NODE0,U,25) ;Date IVM Verif. MT Completed
72 S $P(ZMT,U,21)=$P(NODE0,U,26) ;Refused To Sign
73 S $P(ZMT,U,22)=$P(NODE2,U,5) ;Site Conducting Test
74 S $P(ZMT,U,23)=$P(NODE2,U,4) ;Hardship Review Site
75 S $P(ZMT,U,24)=$P(NODE2,U,1) ;Hardship Effective Date
76 S $P(ZMT,U,25)=$P(NODE2,U,2) ;Date/Time Test Last Edited
77 S $P(ZMT,U,26)=$P(NODE2,U,3) ;Test Determined Status
78 S $P(ZMT,U,28)=$P(NODE0,U,27) ;GMT Threshold
79 ;
80 ; Adjust date fields to correct format
81 S $P(ZMT,U,2)=$E($P(ZMT,U,2),1,3)+1700_$E($P(ZMT,U,2),4,7)
82 S $P(ZMT,U,10)=$E($P(ZMT,U,10),1,3)+1700_$E($P(ZMT,U,10),4,7)
83 S $P(ZMT,U,25)=$E($P(ZMT,U,25),1,3)+1700_$E($P(ZMT,U,25),4,7)_$P($P(ZMT,U,25),".",2)_"-400"
84 ;
85 ; Change Status IENs to Codes
86 S:$P(ZMT,U,26)="" $P(ZMT,U,26)=$P(ZMT,U,3)
87 S $P(ZMT,U,3)=$P(^DG(408.32,$P(ZMT,U,3),0),U,2)
88 S $P(ZMT,U,26)=$P(^DG(408.32,$P(ZMT,U,26),0),U,2)
89 ;
90 Q ZMT
91 ;
92ZDP(VAFIEN,DEPIEN) ; Build ZDP the data string for the veteran
93 ;
94 N NODE0,NODER,DGPR,ZDP,LIEN
95 S NODE0=$G(^DGPR(408.12,+VAFIEN,0)),ZDP="ZDP"
96 S DGPR=+$P(NODE0,U,3),NODER=^DGPR(408.13,DGPR,0)
97 S $P(ZDP,U,2)=$P(NODER,U,1) ;Name
98 S $P(ZDP,U,3)=$P(NODER,U,2) ;Sex
99 S $P(ZDP,U,4)=$P(NODER,U,3) ;Date of Birth
100 S $P(ZDP,U,5)=$P(NODER,U,9) ;Social Security Number
101 S $P(ZDP,U,6)=$P(NODE0,U,2) ;Relationship To Patient
102 S $P(ZDP,U,7)=+VAFIEN ;Internal Entry Number
103 S LIEN=$O(^DGPR(408.12,+VAFIEN,"E","AID"),-1)
104 S $P(ZDP,U,9)=+^DGPR(408.12,+VAFIEN,"E",LIEN,0)
105 ;
106 ; Change format to match CC format
107 S $P(ZDP,U,2)=$TR($P(ZDP,U,2),",","~")
108 S $P(ZDP,U,4)=$E($P(ZDP,U,4),1,3)+1700_$E($P(ZDP,U,4),4,7)
109 S $P(ZDP,U,9)=$E($P(ZDP,U,9),1,3)+1700_$E($P(ZDP,U,9),4,7)
110 ;
111 Q ZDP
112
Note: See TracBrowser for help on using the repository browser.