source: WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHQM2.m@ 1763

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

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1DVBHQM2 ;ISC-ALBANY/PKE-MAIL DELIVERY PROGRAM ;8/19/87 05:43
2 ;;4.0;HINQ;**49**;03/25/92
3 G EN
4LIN S CT=CT+1,A1=A_CT_",0)",@A1=T1 Q
5DD 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
6 ;
7EN ;P&T now sent by VBA, 2=no, 3=yes, else null
8 I $D(DVBPTI),((DVBPTI=2)!(DVBPTI=3)) S DVBPTI=$S(DVBPTI=2:"No",DVBPTI=3:"Yes",1:""),T1=" Perm.,Total Disability = "_DVBPTI D LIN
9 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
10 I $D(DVBFIDUC),(DVBFIDUC>0) S T1="Chief Attorney, fiduciary = "_DVBFIDUC D LIN
11 ;;;I $D(DVBFIDUC),DVBFIDUC,$D(^DIC(4,DVBFIDUC,0)) S DVBFIDUC=$P(^(0),U),T1="Chief Attorney, fiduciary = "_DVBFIDUC D LIN
12 ;VBA field is Unemployable, codes will Y=Unemploy, N=Employ DVB*4*49
13 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
14 ;new VBA codes, I=incompetent or C=competent DVB*4*49
15 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
16 ;Severence Recoup, PFOP, Competency Pay Status and Consol Payment will
17 ;no longer be sent by VBA - DVB*4*49
18 ;
19 I $D(DVBP(2)) D P2^DVBHQM11
20PNX I $D(DVBSPNAM),DVBSPNAM'?10" " S T1=" " D LIN S T1="Spouse name = "_DVBSPNAM D SDB,LIN
21 S T1="" D LIN
22 S T1=" "
23 ;CHAMPVA no longer sent by VBA - DVB*4*49
24 K C I $D(DVBBAS(1)) F N=32:1:35 I $P(DVBBAS(1),U,N) D SHDR Q
25 I $D(C) D COUNT ;DVB*4*49 - some fields for C not sent by VBA any more
26 ;so calculate from Child Status field
27 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
28 I '$D(C),T1'["Not" S T1=$E(T1,1,23) D LIN
29 K C
30 I $D(DVBCHILD) S T1="" D LIN S T1="Child name DOB Child Status" D LIN
31 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
32 . F DVBB=$L(T1):1:10 S T1=T1_" "
33 . S T1=T1_" "_$E(Y_" ",1,11)_" "_V D LIN
34 K DVBPSNAM,DVBSPDOB,DVBCHILD,DVBDOB,V
35 ;
36 ;-8
37 ;with DVB*4*49 Hardship Exp no longer sent by VBA, so removed from line
38 S T1=" " D LIN
39 S T1="Check Amount= ''' Net Award= '''"
40 I $D(DVBBAS(1)) S $P(T1,"'",5,6)="$"_$P(DVBBAS(1),U,20)
41 I $D(DVBCHECK) S $P(T1,"'",2,3)="$"_DVBCHECK
42 ;I $P(^DIC(8,$P(^DPT(DFN,.36),U),0),U)'="NSC" D LIN
43 D LIN
44 K DVBCAP
45 ;
46RINC ;
47 I $G(DVBINC)]"" I +$P(DVBINC,U,15)>0 S T1=" Income for VA Purposes= '$"_$P(DVBINC,U,15)_".00'" D LIN
48 ;
49EX ;
50 K C,T2,T1,DVBDXPCT,DVBPT,DVBPTI,DVBAAHB,DVBFIDUC,DVBEI,DVBCI,DVBCPS,DVBSPNAM,DVBSPDOB,DVBCHILD,DVBDOB,V,DVBCHECK,Y
51 D ADD^DVBHQM31
52 G ERR^DVBHQM3 ;with DVB*4*49 no call made to EN^DVBHQM3
53 ;
54SHDR S T1=T1_" Number of CHILDREN"
55 I N>31 S C=$P(DVBBAS(1),U,32,35) Q
56 ;
57RHDR S T1="" D LIN
58 S T1="last date previously INCOME REPORTED amount, type" D LIN
59 S T1="Reported Reported This Year For VA purposes Medical or Last Expense" D LIN
60 S T1="",$P(T1,"-",80)="" D LIN Q
61 ;
62FILLER 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
63 Q
64 ;
65RTYP 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
66 ;
67AAA 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
68 S Y=V Q
69 ;
70CHILD 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:"")
71 Q
72 ;
73CPS 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
74 ;
75SDB 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
76 Q
77 ;
78CDATE I DVBDOB'?9.10N S Y="" Q
79 ;change CDATE to receive date as MMDDYYYY - DVB*4*49
80 ;if there are more than 10 children then the characters are thrown
81 ;off 1 place
82 I $L(DVBDOB)=10 S $E(DVBDOB,2,9)=$E(DVBDOB,3,10)
83 S M=$E(DVBDOB,2,3) D MM^DVBHQM11
84 S Y=M_" "_$S(+$E(DVBDOB,4,5)>0:$E(DVBDOB,4,5)_",",1:" ")_$E(DVBDOB,6,9)
85 Q
86DEP(X) ;;V-S^V-S-F^V-S-M^V-S-2P^V-F^V-M^V-2P^V^
87 ;Dependency codes
88 Q:X>89 X Q:X'?2N X
89 I X="00" S X="V" Q X
90 I X="80" S X="V-C" Q X
91 I $E(X,2)=0 S X=$P($P($T(DEP),";;",2),"^",$E(X,1)) Q X
92 I X?2N S X=$P($P($T(DEP),";;",2),"^",$E(X,1))_"-"_$E(X,2)_"C" Q X
93 Q X
94COUNT ;loop through the DVBCHILD array and count the total, helpless and
95 ;school children
96 N DVBC,DVBH,DVBS,DVBT
97 S (DVBC,DVBH,DVBS,DVBT)=0
98 F S DVBC=$O(DVBCHILD(DVBC)) Q:DVBC'>0 D
99 . I $P(DVBCHILD(DVBC),U)="H" S DVBH=DVBH+1
100 . I $P(DVBCHILD(DVBC),U)="S" S DVBS=DVBS+1
101 . S DVBT=DVBT+1
102 S C=DVBT_"^"_+$P(C,U,2)_"^"_DVBS_"^"_DVBH
103 Q
Note: See TracBrowser for help on using the repository browser.