DGMTUTL2 ;ALB/RMM,TGH - Means Test Consistency Checker ; 04/28/2005
;;5.3;Registration;**463,655,890**;Aug 13, 1993;Build 40
;
; This routine sets the data strings used in the Income Test
; Inconsistency Checks.
Q
;
ZIC(VAFIEN,DEPIEN) ; Build ZIC the data string for the veteran
;
N NODE0,NODE1,NODE2,ZIC
S NODE0=$G(^DGMT(408.21,VAFIEN,0))
S NODE1=$G(^DGMT(408.21,VAFIEN,1))
S NODE2=$G(^DGMT(408.21,VAFIEN,2))
S ZIC="ZIC"
S $P(ZIC,U,2)=$P(NODE0,U,1) ;Income Year
S $P(ZIC,U,3)=$P(NODE0,U,8) ;Social Security
S $P(ZIC,U,4)=$P(NODE0,U,9) ;U.S. Civil Service
S $P(ZIC,U,5)=$P(NODE0,U,10) ;U.S. Railroad Retirement
S $P(ZIC,U,6)=$P(NODE0,U,11) ;Military Retirement
S $P(ZIC,U,7)=$P(NODE0,U,12) ;Unemployment Compensation
S $P(ZIC,U,9)=$P(NODE0,U,14) ;Total Income from Employment
S $P(ZIC,U,10)=$P(NODE0,U,15) ;Interest,Dividend,Annuity
S $P(ZIC,U,11)=$P(NODE0,U,16) ;Workers Comp. or Black Lung
S $P(ZIC,U,12)=$P(NODE0,U,17) ;All Other Income
S $P(ZIC,U,13)=$P(NODE1,U,1) ;Medical Expenses
S $P(ZIC,U,14)=$P(NODE1,U,2) ;Funeral And Burial Expenses
S $P(ZIC,U,15)=$P(NODE1,U,3) ;Educational Expenses
S $P(ZIC,U,16)=$P(NODE2,U,1) ;Cash, Amount In Bank Accounts
S $P(ZIC,U,17)=$P(NODE2,U,2) ;Stocks And Bonds
S $P(ZIC,U,18)=$P(NODE2,U,3) ;Real Property
S $P(ZIC,U,19)=$P(NODE2,U,4) ;Other Property or Assets
S $P(ZIC,U,20)=$P(NODE2,U,5) ;Debts
;
; Adjust date field to correct format
S $P(ZIC,U,2)=$E($P(ZIC,U,2),1,3)+1700_$E($P(ZIC,U,2),4,7)
;
Q ZIC
;
ZIR(VAFIEN,DEPIEN) ; Build ZIR the data string for the veteran
N NODE0,ZIR
S NODE0=$G(^DGMT(408.22,VAFIEN,0)),ZIR="ZIR"
S $P(ZIR,U,2)=$P(NODE0,U,5) ;Married Last Year
S $P(ZIR,U,3)=$P(NODE0,U,6) ;Lived With Patient
S $P(ZIR,U,4)=$P(NODE0,U,7) ;Amount Contributed to Spouse
S $P(ZIR,U,8)=$P(NODE0,U,11) ;Child Had Income
S $P(ZIR,U,9)=$P(NODE0,U,12) ;Income Available to You
S $P(ZIR,U,15)=$P(NODE0,U,20) ;Contributed to Spouse DG*5.3*890
Q ZIR
;
ZMT(DGMTI) ; Build ZMT the data string for the veteran
;
N NODE0,NODE2,ZMT
S NODE0=$G(^DGMT(408.31,DGMTI,0))
S NODE2=$G(^DGMT(408.31,DGMTI,2)),ZMT="ZMT"
S $P(ZMT,U,2)=$P(NODE0,U,1) ;Means Test Date
S $P(ZMT,U,3)=$P(NODE0,U,3) ;Means Test Status
S $P(ZMT,U,4)=$P(NODE0,U,4) ;Income
S $P(ZMT,U,5)=$P(NODE0,U,5) ;Net Worth
S $P(ZMT,U,6)=$P(NODE0,U,10) ;Date/Time of Adjudication
S $P(ZMT,U,7)=$P(NODE0,U,11) ;Agreed to Pay Deductible
S $P(ZMT,U,8)=$P(NODE0,U,12) ;Threshold A
S $P(ZMT,U,9)=$P(NODE0,U,15) ;Deductible Expenses
S $P(ZMT,U,10)=$P(NODE0,U,7) ;Date/Time MT Completed
S $P(ZMT,U,11)=$P(NODE0,U,16) ;Previous Yr MT Threshold Flag
S $P(ZMT,U,12)=$P(NODE0,U,18) ;Total Dependents
S $P(ZMT,U,13)=$P(NODE0,U,20) ;Hardship
S $P(ZMT,U,14)=$P(NODE0,U,21) ;Hardship Review Date
S $P(ZMT,U,15)=$P(NODE0,U,24) ;Date Veteran Signed Test
S $P(ZMT,U,16)=$P(NODE0,U,14) ;Declines to Give Income Info
S $P(ZMT,U,17)=$P(NODE0,U,19) ;Type of Test
S $P(ZMT,U,18)=$P(NODE0,U,23) ;Source of Income Test
S $P(ZMT,U,19)=$P($G(^DGMT(408.31,DGMTI,"PRIM")),U,1) ;Primary Test?
S $P(ZMT,U,20)=$P(NODE0,U,25) ;Date IVM Verif. MT Completed
S $P(ZMT,U,21)=$P(NODE0,U,26) ;Refused To Sign
S $P(ZMT,U,22)=$P(NODE2,U,5) ;Site Conducting Test
S $P(ZMT,U,23)=$P(NODE2,U,4) ;Hardship Review Site
S $P(ZMT,U,24)=$P(NODE2,U,1) ;Hardship Effective Date
S $P(ZMT,U,25)=$P(NODE2,U,2) ;Date/Time Test Last Edited
S $P(ZMT,U,26)=$P(NODE2,U,3) ;Test Determined Status
S $P(ZMT,U,28)=$P(NODE0,U,27) ;GMT Threshold
;
; Adjust date fields to correct format
S $P(ZMT,U,2)=$E($P(ZMT,U,2),1,3)+1700_$E($P(ZMT,U,2),4,7)
S $P(ZMT,U,10)=$E($P(ZMT,U,10),1,3)+1700_$E($P(ZMT,U,10),4,7)
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"
;
; Change Status IENs to Codes
S:$P(ZMT,U,26)="" $P(ZMT,U,26)=$P(ZMT,U,3)
S $P(ZMT,U,3)=$P(^DG(408.32,$P(ZMT,U,3),0),U,2)
S $P(ZMT,U,26)=$P(^DG(408.32,$P(ZMT,U,26),0),U,2)
;
Q ZMT
;
ZDP(VAFIEN,DEPIEN) ; Build ZDP the data string for the veteran
;
N NODE0,NODER,DGPR,ZDP,LIEN
S NODE0=$G(^DGPR(408.12,+VAFIEN,0)),ZDP="ZDP"
S DGPR=+$P(NODE0,U,3),NODER=^DGPR(408.13,DGPR,0)
S $P(ZDP,U,2)=$P(NODER,U,1) ;Name
S $P(ZDP,U,3)=$P(NODER,U,2) ;Sex
S $P(ZDP,U,4)=$P(NODER,U,3) ;Date of Birth
S $P(ZDP,U,5)=$P(NODER,U,9) ;Social Security Number
S $P(ZDP,U,6)=$P(NODE0,U,2) ;Relationship To Patient
S $P(ZDP,U,7)=+VAFIEN ;Internal Entry Number
S LIEN=$O(^DGPR(408.12,+VAFIEN,"E","AID"),-1)
S $P(ZDP,U,9)=+^DGPR(408.12,+VAFIEN,"E",LIEN,0)
;
; Change format to match CC format
S $P(ZDP,U,2)=$TR($P(ZDP,U,2),",","~")
S $P(ZDP,U,4)=$E($P(ZDP,U,4),1,3)+1700_$E($P(ZDP,U,4),4,7)
S $P(ZDP,U,9)=$E($P(ZDP,U,9),1,3)+1700_$E($P(ZDP,U,9),4,7)
;
Q ZDP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTUTL2 5247 printed Nov 22, 2024@17:55:42 Page 2
DGMTUTL2 ;ALB/RMM,TGH - Means Test Consistency Checker ; 04/28/2005
+1 ;;5.3;Registration;**463,655,890**;Aug 13, 1993;Build 40
+2 ;
+3 ; This routine sets the data strings used in the Income Test
+4 ; Inconsistency Checks.
+5 QUIT
+6 ;
ZIC(VAFIEN,DEPIEN) ; Build ZIC the data string for the veteran
+1 ;
+2 NEW NODE0,NODE1,NODE2,ZIC
+3 SET NODE0=$GET(^DGMT(408.21,VAFIEN,0))
+4 SET NODE1=$GET(^DGMT(408.21,VAFIEN,1))
+5 SET NODE2=$GET(^DGMT(408.21,VAFIEN,2))
+6 SET ZIC="ZIC"
+7 ;Income Year
SET $PIECE(ZIC,U,2)=$PIECE(NODE0,U,1)
+8 ;Social Security
SET $PIECE(ZIC,U,3)=$PIECE(NODE0,U,8)
+9 ;U.S. Civil Service
SET $PIECE(ZIC,U,4)=$PIECE(NODE0,U,9)
+10 ;U.S. Railroad Retirement
SET $PIECE(ZIC,U,5)=$PIECE(NODE0,U,10)
+11 ;Military Retirement
SET $PIECE(ZIC,U,6)=$PIECE(NODE0,U,11)
+12 ;Unemployment Compensation
SET $PIECE(ZIC,U,7)=$PIECE(NODE0,U,12)
+13 ;Total Income from Employment
SET $PIECE(ZIC,U,9)=$PIECE(NODE0,U,14)
+14 ;Interest,Dividend,Annuity
SET $PIECE(ZIC,U,10)=$PIECE(NODE0,U,15)
+15 ;Workers Comp. or Black Lung
SET $PIECE(ZIC,U,11)=$PIECE(NODE0,U,16)
+16 ;All Other Income
SET $PIECE(ZIC,U,12)=$PIECE(NODE0,U,17)
+17 ;Medical Expenses
SET $PIECE(ZIC,U,13)=$PIECE(NODE1,U,1)
+18 ;Funeral And Burial Expenses
SET $PIECE(ZIC,U,14)=$PIECE(NODE1,U,2)
+19 ;Educational Expenses
SET $PIECE(ZIC,U,15)=$PIECE(NODE1,U,3)
+20 ;Cash, Amount In Bank Accounts
SET $PIECE(ZIC,U,16)=$PIECE(NODE2,U,1)
+21 ;Stocks And Bonds
SET $PIECE(ZIC,U,17)=$PIECE(NODE2,U,2)
+22 ;Real Property
SET $PIECE(ZIC,U,18)=$PIECE(NODE2,U,3)
+23 ;Other Property or Assets
SET $PIECE(ZIC,U,19)=$PIECE(NODE2,U,4)
+24 ;Debts
SET $PIECE(ZIC,U,20)=$PIECE(NODE2,U,5)
+25 ;
+26 ; Adjust date field to correct format
+27 SET $PIECE(ZIC,U,2)=$EXTRACT($PIECE(ZIC,U,2),1,3)+1700_$EXTRACT($PIECE(ZIC,U,2),4,7)
+28 ;
+29 QUIT ZIC
+30 ;
ZIR(VAFIEN,DEPIEN) ; Build ZIR the data string for the veteran
+1 NEW NODE0,ZIR
+2 SET NODE0=$GET(^DGMT(408.22,VAFIEN,0))
SET ZIR="ZIR"
+3 ;Married Last Year
SET $PIECE(ZIR,U,2)=$PIECE(NODE0,U,5)
+4 ;Lived With Patient
SET $PIECE(ZIR,U,3)=$PIECE(NODE0,U,6)
+5 ;Amount Contributed to Spouse
SET $PIECE(ZIR,U,4)=$PIECE(NODE0,U,7)
+6 ;Child Had Income
SET $PIECE(ZIR,U,8)=$PIECE(NODE0,U,11)
+7 ;Income Available to You
SET $PIECE(ZIR,U,9)=$PIECE(NODE0,U,12)
+8 ;Contributed to Spouse DG*5.3*890
SET $PIECE(ZIR,U,15)=$PIECE(NODE0,U,20)
+9 QUIT ZIR
+10 ;
ZMT(DGMTI) ; Build ZMT the data string for the veteran
+1 ;
+2 NEW NODE0,NODE2,ZMT
+3 SET NODE0=$GET(^DGMT(408.31,DGMTI,0))
+4 SET NODE2=$GET(^DGMT(408.31,DGMTI,2))
SET ZMT="ZMT"
+5 ;Means Test Date
SET $PIECE(ZMT,U,2)=$PIECE(NODE0,U,1)
+6 ;Means Test Status
SET $PIECE(ZMT,U,3)=$PIECE(NODE0,U,3)
+7 ;Income
SET $PIECE(ZMT,U,4)=$PIECE(NODE0,U,4)
+8 ;Net Worth
SET $PIECE(ZMT,U,5)=$PIECE(NODE0,U,5)
+9 ;Date/Time of Adjudication
SET $PIECE(ZMT,U,6)=$PIECE(NODE0,U,10)
+10 ;Agreed to Pay Deductible
SET $PIECE(ZMT,U,7)=$PIECE(NODE0,U,11)
+11 ;Threshold A
SET $PIECE(ZMT,U,8)=$PIECE(NODE0,U,12)
+12 ;Deductible Expenses
SET $PIECE(ZMT,U,9)=$PIECE(NODE0,U,15)
+13 ;Date/Time MT Completed
SET $PIECE(ZMT,U,10)=$PIECE(NODE0,U,7)
+14 ;Previous Yr MT Threshold Flag
SET $PIECE(ZMT,U,11)=$PIECE(NODE0,U,16)
+15 ;Total Dependents
SET $PIECE(ZMT,U,12)=$PIECE(NODE0,U,18)
+16 ;Hardship
SET $PIECE(ZMT,U,13)=$PIECE(NODE0,U,20)
+17 ;Hardship Review Date
SET $PIECE(ZMT,U,14)=$PIECE(NODE0,U,21)
+18 ;Date Veteran Signed Test
SET $PIECE(ZMT,U,15)=$PIECE(NODE0,U,24)
+19 ;Declines to Give Income Info
SET $PIECE(ZMT,U,16)=$PIECE(NODE0,U,14)
+20 ;Type of Test
SET $PIECE(ZMT,U,17)=$PIECE(NODE0,U,19)
+21 ;Source of Income Test
SET $PIECE(ZMT,U,18)=$PIECE(NODE0,U,23)
+22 ;Primary Test?
SET $PIECE(ZMT,U,19)=$PIECE($GET(^DGMT(408.31,DGMTI,"PRIM")),U,1)
+23 ;Date IVM Verif. MT Completed
SET $PIECE(ZMT,U,20)=$PIECE(NODE0,U,25)
+24 ;Refused To Sign
SET $PIECE(ZMT,U,21)=$PIECE(NODE0,U,26)
+25 ;Site Conducting Test
SET $PIECE(ZMT,U,22)=$PIECE(NODE2,U,5)
+26 ;Hardship Review Site
SET $PIECE(ZMT,U,23)=$PIECE(NODE2,U,4)
+27 ;Hardship Effective Date
SET $PIECE(ZMT,U,24)=$PIECE(NODE2,U,1)
+28 ;Date/Time Test Last Edited
SET $PIECE(ZMT,U,25)=$PIECE(NODE2,U,2)
+29 ;Test Determined Status
SET $PIECE(ZMT,U,26)=$PIECE(NODE2,U,3)
+30 ;GMT Threshold
SET $PIECE(ZMT,U,28)=$PIECE(NODE0,U,27)
+31 ;
+32 ; Adjust date fields to correct format
+33 SET $PIECE(ZMT,U,2)=$EXTRACT($PIECE(ZMT,U,2),1,3)+1700_$EXTRACT($PIECE(ZMT,U,2),4,7)
+34 SET $PIECE(ZMT,U,10)=$EXTRACT($PIECE(ZMT,U,10),1,3)+1700_$EXTRACT($PIECE(ZMT,U,10),4,7)
+35 SET $PIECE(ZMT,U,25)=$EXTRACT($PIECE(ZMT,U,25),1,3)+1700_$EXTRACT($PIECE(ZMT,U,25),4,7)_$PIECE($PIECE(ZMT,U,25),".",2)_"-400"
+36 ;
+37 ; Change Status IENs to Codes
+38 if $PIECE(ZMT,U,26)=""
SET $PIECE(ZMT,U,26)=$PIECE(ZMT,U,3)
+39 SET $PIECE(ZMT,U,3)=$PIECE(^DG(408.32,$PIECE(ZMT,U,3),0),U,2)
+40 SET $PIECE(ZMT,U,26)=$PIECE(^DG(408.32,$PIECE(ZMT,U,26),0),U,2)
+41 ;
+42 QUIT ZMT
+43 ;
ZDP(VAFIEN,DEPIEN) ; Build ZDP the data string for the veteran
+1 ;
+2 NEW NODE0,NODER,DGPR,ZDP,LIEN
+3 SET NODE0=$GET(^DGPR(408.12,+VAFIEN,0))
SET ZDP="ZDP"
+4 SET DGPR=+$PIECE(NODE0,U,3)
SET NODER=^DGPR(408.13,DGPR,0)
+5 ;Name
SET $PIECE(ZDP,U,2)=$PIECE(NODER,U,1)
+6 ;Sex
SET $PIECE(ZDP,U,3)=$PIECE(NODER,U,2)
+7 ;Date of Birth
SET $PIECE(ZDP,U,4)=$PIECE(NODER,U,3)
+8 ;Social Security Number
SET $PIECE(ZDP,U,5)=$PIECE(NODER,U,9)
+9 ;Relationship To Patient
SET $PIECE(ZDP,U,6)=$PIECE(NODE0,U,2)
+10 ;Internal Entry Number
SET $PIECE(ZDP,U,7)=+VAFIEN
+11 SET LIEN=$ORDER(^DGPR(408.12,+VAFIEN,"E","AID"),-1)
+12 SET $PIECE(ZDP,U,9)=+^DGPR(408.12,+VAFIEN,"E",LIEN,0)
+13 ;
+14 ; Change format to match CC format
+15 SET $PIECE(ZDP,U,2)=$TRANSLATE($PIECE(ZDP,U,2),",","~")
+16 SET $PIECE(ZDP,U,4)=$EXTRACT($PIECE(ZDP,U,4),1,3)+1700_$EXTRACT($PIECE(ZDP,U,4),4,7)
+17 SET $PIECE(ZDP,U,9)=$EXTRACT($PIECE(ZDP,U,9),1,3)+1700_$EXTRACT($PIECE(ZDP,U,9),4,7)
+18 ;
+19 QUIT ZDP
+20
