104 lines
5.3 KiB
Mathematica
104 lines
5.3 KiB
Mathematica
DVBHQM2 ;ISC-ALBANY/PKE-MAIL DELIVERY PROGRAM ;8/19/87 05:43
|
|
;;4.0;HINQ;**49**;03/25/92
|
|
G EN
|
|
LIN S CT=CT+1,A1=A_CT_",0)",@A1=T1 Q
|
|
DD S:Y Y=$S($E(Y,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),"^",Y[".") Q
|
|
;
|
|
EN ;P&T now sent by VBA, 2=no, 3=yes, else null
|
|
I $D(DVBPTI),((DVBPTI=2)!(DVBPTI=3)) S DVBPTI=$S(DVBPTI=2:"No",DVBPTI=3:"Yes",1:""),T1=" Perm.,Total Disability = "_DVBPTI D LIN
|
|
I $D(DVBAAHB),((DVBAAHB="A")!(DVBAAHB="H")) S Y=DVBAAHB S Y=$S(Y="A":"A&A Paid",Y="H":"Housebound Paid",1:"") S T1=" AID & ATTEND = "_Y D LIN
|
|
I $D(DVBFIDUC),(DVBFIDUC>0) S T1="Chief Attorney, fiduciary = "_DVBFIDUC D LIN
|
|
;;;I $D(DVBFIDUC),DVBFIDUC,$D(^DIC(4,DVBFIDUC,0)) S DVBFIDUC=$P(^(0),U),T1="Chief Attorney, fiduciary = "_DVBFIDUC D LIN
|
|
;VBA field is Unemployable, codes will Y=Unemploy, N=Employ DVB*4*49
|
|
I $D(DVBEI),((DVBEI="N")!(DVBEI="Y")) S DVBEI=$S(DVBEI="N":"Employable or not an issue",DVBEI="Y":"Unemployable",1:""),T1=" Employable indicator = "_DVBEI D LIN
|
|
;new VBA codes, I=incompetent or C=competent DVB*4*49
|
|
I $D(DVBCI),((DVBCI'=" ")) S DVBCI=$S(DVBCI=1!(DVBCI="C"):"Competent, or not an issue",DVBCI="I"!(DVBCI="2"):"Incompetent",1:DVBCI),T1=" Competency indicator = "_DVBCI D LIN
|
|
;Severence Recoup, PFOP, Competency Pay Status and Consol Payment will
|
|
;no longer be sent by VBA - DVB*4*49
|
|
;
|
|
I $D(DVBP(2)) D P2^DVBHQM11
|
|
PNX I $D(DVBSPNAM),DVBSPNAM'?10" " S T1=" " D LIN S T1="Spouse name = "_DVBSPNAM D SDB,LIN
|
|
S T1="" D LIN
|
|
S T1=" "
|
|
;CHAMPVA no longer sent by VBA - DVB*4*49
|
|
K C I $D(DVBBAS(1)) F N=32:1:35 I $P(DVBBAS(1),U,N) D SHDR Q
|
|
I $D(C) D COUNT ;DVB*4*49 - some fields for C not sent by VBA any more
|
|
;so calculate from Child Status field
|
|
I $D(C) D LIN S T1="",$P(T1,"-",80)="" D LIN S T1="School = "_$P(C,U,3)_" Helpless School = "_$P(C,U,4)_" Depend. total = "_$$DEP($P(C,U,1))_" This Award = "_$$DEP($P(C,U,2)) D LIN
|
|
I '$D(C),T1'["Not" S T1=$E(T1,1,23) D LIN
|
|
K C
|
|
I $D(DVBCHILD) S T1="" D LIN S T1="Child name DOB Child Status" D LIN
|
|
I $D(DVBCHILD) F DVBDOB=0:0 S DVBDOB=$O(DVBCHILD(DVBDOB)) Q:'DVBDOB S Y=DVBDOB,V=$P(DVBCHILD(Y),U),T1=$P(DVBCHILD(Y),U,2) D CDATE,CHILD D
|
|
. F DVBB=$L(T1):1:10 S T1=T1_" "
|
|
. S T1=T1_" "_$E(Y_" ",1,11)_" "_V D LIN
|
|
K DVBPSNAM,DVBSPDOB,DVBCHILD,DVBDOB,V
|
|
;
|
|
;-8
|
|
;with DVB*4*49 Hardship Exp no longer sent by VBA, so removed from line
|
|
S T1=" " D LIN
|
|
S T1="Check Amount= ''' Net Award= '''"
|
|
I $D(DVBBAS(1)) S $P(T1,"'",5,6)="$"_$P(DVBBAS(1),U,20)
|
|
I $D(DVBCHECK) S $P(T1,"'",2,3)="$"_DVBCHECK
|
|
;I $P(^DIC(8,$P(^DPT(DFN,.36),U),0),U)'="NSC" D LIN
|
|
D LIN
|
|
K DVBCAP
|
|
;
|
|
RINC ;
|
|
I $G(DVBINC)]"" I +$P(DVBINC,U,15)>0 S T1=" Income for VA Purposes= '$"_$P(DVBINC,U,15)_".00'" D LIN
|
|
;
|
|
EX ;
|
|
K C,T2,T1,DVBDXPCT,DVBPT,DVBPTI,DVBAAHB,DVBFIDUC,DVBEI,DVBCI,DVBCPS,DVBSPNAM,DVBSPDOB,DVBCHILD,DVBDOB,V,DVBCHECK,Y
|
|
D ADD^DVBHQM31
|
|
G ERR^DVBHQM3 ;with DVB*4*49 no call made to EN^DVBHQM3
|
|
;
|
|
SHDR S T1=T1_" Number of CHILDREN"
|
|
I N>31 S C=$P(DVBBAS(1),U,32,35) Q
|
|
;
|
|
RHDR S T1="" D LIN
|
|
S T1="last date previously INCOME REPORTED amount, type" D LIN
|
|
S T1="Reported Reported This Year For VA purposes Medical or Last Expense" D LIN
|
|
S T1="",$P(T1,"-",80)="" D LIN Q
|
|
;
|
|
FILLER S T1="" F N=14,12,13,15,16,17 I N'=16 S T2=$S(N'=14:"$",1:"")_+$P(DVBINC,U,N),T1=T1_$J(T2,6) S:N<16 T1=T1_" " I N=17 S T2=$P(DVBINC,U,16) D RTYP S T1=T1_" "_T2 D LIN S T1="" D LIN
|
|
Q
|
|
;
|
|
RTYP S T2=$S(T2=" ":T2,T2="B":"SS/Other",T2="C":"Unusual Med.Exp.",T2="O":"Other",T2="R":"10%Ret.Pay excl.",T2="S":"Social Security",1:"") Q
|
|
;
|
|
AAA S V=Y S:Y>3&(Y<8) V=Y-4 S V=$S(V=0:"HB and/or A&A TERM",V=1:"HOSPITALIZED, HB,A&A PAY",V=2:"PAY A&A",V=3:"HB ONLY ",V=" ":"HB and/or A&A NOT GRANTED",1:"") I +Y,Y>3&(Y<8) S Y=V_", INCREMENT FOR SPOUSE" Q
|
|
S Y=V Q
|
|
;
|
|
CHILD Q:$G(V)'?1U S V=$S(V="H":"Helpless Child",V="M":"Minor Child",V="N":"Not an award dep.",V="S":"School Child",V="U":"Unclaimed DIC Child",1:"")
|
|
Q
|
|
;
|
|
CPS S Y=$S(Y=1:"Competent,or not an issue,Pay direct",Y=2:"Incompetent by VA, Court .. pay fiduciary",Y=3:"Incompetent by Court, .. pay fiduciary",Y=4:"Competent by Court, Incompetent by VA .. pay direct",Y=5:"Supervised direct pay",1:Y) Q
|
|
;
|
|
SDB I $D(DVBSPDOB),DVBSPDOB I DVBSPDOB?8N S M=$E(DVBSPDOB,1,2) D MM^DVBHQM11 S T1=T1_" DOB = "_M_" "_$S(+$E(DVBSPDOB,3,4)>0:$E(DVBSPDOB,3,4)_", ",1:" ")_$E(DVBSPDOB,5,8) K M
|
|
Q
|
|
;
|
|
CDATE I DVBDOB'?9.10N S Y="" Q
|
|
;change CDATE to receive date as MMDDYYYY - DVB*4*49
|
|
;if there are more than 10 children then the characters are thrown
|
|
;off 1 place
|
|
I $L(DVBDOB)=10 S $E(DVBDOB,2,9)=$E(DVBDOB,3,10)
|
|
S M=$E(DVBDOB,2,3) D MM^DVBHQM11
|
|
S Y=M_" "_$S(+$E(DVBDOB,4,5)>0:$E(DVBDOB,4,5)_",",1:" ")_$E(DVBDOB,6,9)
|
|
Q
|
|
DEP(X) ;;V-S^V-S-F^V-S-M^V-S-2P^V-F^V-M^V-2P^V^
|
|
;Dependency codes
|
|
Q:X>89 X Q:X'?2N X
|
|
I X="00" S X="V" Q X
|
|
I X="80" S X="V-C" Q X
|
|
I $E(X,2)=0 S X=$P($P($T(DEP),";;",2),"^",$E(X,1)) Q X
|
|
I X?2N S X=$P($P($T(DEP),";;",2),"^",$E(X,1))_"-"_$E(X,2)_"C" Q X
|
|
Q X
|
|
COUNT ;loop through the DVBCHILD array and count the total, helpless and
|
|
;school children
|
|
N DVBC,DVBH,DVBS,DVBT
|
|
S (DVBC,DVBH,DVBS,DVBT)=0
|
|
F S DVBC=$O(DVBCHILD(DVBC)) Q:DVBC'>0 D
|
|
. I $P(DVBCHILD(DVBC),U)="H" S DVBH=DVBH+1
|
|
. I $P(DVBCHILD(DVBC),U)="S" S DVBS=DVBS+1
|
|
. S DVBT=DVBT+1
|
|
S C=DVBT_"^"_+$P(C,U,2)_"^"_DVBS_"^"_DVBH
|
|
Q
|