| [613] | 1 | DGMTUTL2 ;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 | ;
|
|---|
| 8 | ZIC(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 | ;
|
|---|
| 39 | ZIR(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 | ;
|
|---|
| 48 | ZMT(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 | ;
|
|---|
| 92 | ZDP(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 |
|
|---|
