source: FOIAVistA/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHQM3.m@ 1582

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1DVBHQM3 ;ISC-ALBANY/PKE,JLU-MAIL DELIVERY PROGRAM ;8/19/87 07:16
2 ;;4.0;HINQ;**49**;03/25/92
3 G EN
4LIN Q:CT>300 S CT=CT+1,A1=A_CT_",0)",@A1=T1 Q
5 ;
6EN ;this code will not be used after DVB*4*49, as the individual income
7 ;fields will no longer be sent from the VBA
8 Q
9 I $D(DVBINC) S DVBHOLD=$P(DVBINC,U,13)
10 S T=0 F B="DVBHOLD","DVBEINC","DVBSSA","DVBRETT","DVBRETO","DVBOINC" S T=T+1 I $D(@B),+@B S CT=CT+1 D:B="DVBRETT" TR S A1=A_CT_",0)",TX=$P($T(T0+T),"=",2),@A1=$E(BL,1,26-$L(TX))_TX_" = "_$E(BL,1,5-$L(@B))_+@B
11 K DVBHOLD,DVBEINC,DVBSSA,DVBRETT,DVBRETO,DVBOINC
12LOOP1 F B="DVBSPENC","DVBSPSSA","DVBSPRET","DVBSPETO","DVBSPINC" S T=T+1 I $D(@B),+@B S CT=CT+1 D:B="DVBSPRET" TR S A1=A_CT_",0)",TX=$P($T(T0+T),"=",2),@A1=$E(BL,1,26-$L(TX))_TX_" = "_$E(BL,1,6-$L(@B))_@B
13 K B,DVBSPENC,DVBSPSSA,DVBSPRET,DVBSPETO,DVBSPINC
14 ;
15RETIR I $D(DVBRTYPE) S T1=" " D LIN S T1="Type of Retirement Income Verified Reported" D LIN
16 I $D(DVBRTYPE) F DVBRTYP=0:0 S DVBRTYP=$O(DVBRTYPE(DVBRTYP)) Q:'DVBRTYP S Y=DVBRTYP D RTYPE S T1=Y_$E(BL,1,30-$L(Y))_DVBVMA_$E(BL,1,9-$L(DVBVMA))_DVBRMA D LIN
17 K DVBCHECK,DVBRTYPE,DVBRTYP,DVBVMA,DVBRMA,Y,Y1,T,TX,BL
18 ;
19 D ADD^DVBHQM31
20ERR D:'$D(DVBMM) ^XMD
21 G:$D(DVBMM2) KLL
22 S DVBSTATS=$S($D(DVBABREV):"A",$D(DVBERR):"E",$D(DVBNETER):"V",1:"N") S:$D(XMZ) DVBIXMZ=XMZ
23 D SET^DVBHQUT
24KLL K XMSUB,XMTEXT,XMDUZ,XMORIG,XMY,ER,DVBSSN,DVBSN,DVBCN,DVBABREV,T1,T2,T3,T4,M,DVBP(1),DVBP(2),DVBP(3),DVBP(4),DVBP(5),DVBP(6),Z,ZZ,A,A1,BL,CT,DVBREQUE,DVBNETER,DVBOTM,DVBERR,DVBERR1,DVBSTATS,DVBIXMZ,DVBNAME,L,C,DVBCTN,DVBCHNO
25 K DVBBAS,DVBVET,DVBDIA,DVBCHI,DVBWIT,DVBADD,DVBDBF,DVBDBE,DVBREF,DVBFUT,DVBINC,DVBMON,DVBBIR
26 QUIT
27 ;
28TR S V=@B,V=$S(V="B":"BLACKLUNG",V="M":"MILITARY",V="C":"CIVIL SERVICE",V="R":"RAILROAD",V="O":"OTHER",V="X":"COMBINATION",1:V),@B=V Q
29 ;
30RTYPE S Y1="" S:Y>7 Y1="-spouse",Y=Y-100 S Y=$S(Y=1:"Social Security",Y=2:"Civil Service",Y=3:"Military Retirement",Y=4:"Black Lung",Y=5:"Railroad Retirement",Y=6:"Other Retirement",Y=7:"Medicare Benefits",1:Y) S Y=Y_Y1 K Y1
31 S DVBVMA=$P(DVBRTYPE(DVBRTYP),U),DVBRMA=$P(DVBRTYPE(DVBRTYP),U,2) F Z=1:1:4 S:$L(DVBVMA)<6 DVBVMA=" "_DVBVMA S:$L(DVBRMA)<6 DVBRMA=" "_DVBRMA
32 Q
33 ;
34T0 ;;
35 ;;DVBHOLD=Income reported
36 ;;DVBEINC=Earned annual Income
37 ;;DVBSSA=Annual Soc. Sec.
38 ;;DVBRETT=Type of other Retirement
39 ;;DVBRETO=Amount of other Retirement
40 ;;DVBOINC=Other annual Income
41 ;;DVBSPENC=Spouse earned annual income
42 ;;DVBSPSSA=Spouse annual Soc. Sec.
43 ;;DVBSPRET=Spouse type of other Retirement
44 ;;DVBSPETO=Spouse other Retirement
45 ;;DVBSPINC=Spouse other annual Income
Note: See TracBrowser for help on using the repository browser.