DVBHQM3 ;ISC-ALBANY/PKE,JLU-MAIL DELIVERY PROGRAM ;8/19/87 07:16
;;4.0;HINQ;**49**;03/25/92
G EN
LIN Q:CT>300 S CT=CT+1,A1=A_CT_",0)",@A1=T1 Q
;
EN ;this code will not be used after DVB*4*49, as the individual income
;fields will no longer be sent from the VBA
Q
I $D(DVBINC) S DVBHOLD=$P(DVBINC,U,13)
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
K DVBHOLD,DVBEINC,DVBSSA,DVBRETT,DVBRETO,DVBOINC
LOOP1 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
K B,DVBSPENC,DVBSPSSA,DVBSPRET,DVBSPETO,DVBSPINC
;
RETIR I $D(DVBRTYPE) S T1=" " D LIN S T1="Type of Retirement Income Verified Reported" D LIN
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
K DVBCHECK,DVBRTYPE,DVBRTYP,DVBVMA,DVBRMA,Y,Y1,T,TX,BL
;
D ADD^DVBHQM31
ERR D:'$D(DVBMM) ^XMD
G:$D(DVBMM2) KLL
S DVBSTATS=$S($D(DVBABREV):"A",$D(DVBERR):"E",$D(DVBNETER):"V",1:"N") S:$D(XMZ) DVBIXMZ=XMZ
D SET^DVBHQUT
KLL 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
K DVBBAS,DVBVET,DVBDIA,DVBCHI,DVBWIT,DVBADD,DVBDBF,DVBDBE,DVBREF,DVBFUT,DVBINC,DVBMON,DVBBIR
QUIT
;
TR 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
;
RTYPE 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
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
Q
;
T0 ;;
;;DVBHOLD=Income reported
;;DVBEINC=Earned annual Income
;;DVBSSA=Annual Soc. Sec.
;;DVBRETT=Type of other Retirement
;;DVBRETO=Amount of other Retirement
;;DVBOINC=Other annual Income
;;DVBSPENC=Spouse earned annual income
;;DVBSPSSA=Spouse annual Soc. Sec.
;;DVBSPRET=Spouse type of other Retirement
;;DVBSPETO=Spouse other Retirement
;;DVBSPINC=Spouse other annual Income
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHQM3 2590 printed Oct 16, 2024@17:59:35 Page 2
DVBHQM3 ;ISC-ALBANY/PKE,JLU-MAIL DELIVERY PROGRAM ;8/19/87 07:16
+1 ;;4.0;HINQ;**49**;03/25/92
+2 GOTO EN
LIN if CT>300
QUIT
SET CT=CT+1
SET A1=A_CT_",0)"
SET @A1=T1
QUIT
+1 ;
EN ;this code will not be used after DVB*4*49, as the individual income
+1 ;fields will no longer be sent from the VBA
+2 QUIT
+3 IF $DATA(DVBINC)
SET DVBHOLD=$PIECE(DVBINC,U,13)
+4 SET T=0
FOR B="DVBHOLD","DVBEINC","DVBSSA","DVBRETT","DVBRETO","DVBOINC"
SET T=T+1
IF $DATA(@B)
IF +@B
SET CT=CT+1
if B="DVBRETT"
DO TR
SET A1=A_CT_",0)"
SET TX=$PIECE($TEXT(T0+T),"=",2)
SET @A1=$EXTRACT(BL,1,26-$LENGTH(TX))_TX_" = "_$EXTRACT(BL,1,5-$LENGTH(@B))_+@B
+5 KILL DVBHOLD,DVBEINC,DVBSSA,DVBRETT,DVBRETO,DVBOINC
LOOP1 FOR B="DVBSPENC","DVBSPSSA","DVBSPRET","DVBSPETO","DVBSPINC"
SET T=T+1
IF $DATA(@B)
IF +@B
SET CT=CT+1
if B="DVBSPRET"
DO TR
SET A1=A_CT_",0)"
SET TX=$PIECE($TEXT(T0+T),"=",2)
SET @A1=$EXTRACT(BL,1,26-$LENGTH(TX))_TX_" = "_$EXTRACT(BL,1,6-$LENGTH(@B))_@B
+1 KILL B,DVBSPENC,DVBSPSSA,DVBSPRET,DVBSPETO,DVBSPINC
+2 ;
RETIR IF $DATA(DVBRTYPE)
SET T1=" "
DO LIN
SET T1="Type of Retirement Income Verified Reported"
DO LIN
+1 IF $DATA(DVBRTYPE)
FOR DVBRTYP=0:0
SET DVBRTYP=$ORDER(DVBRTYPE(DVBRTYP))
if 'DVBRTYP
QUIT
SET Y=DVBRTYP
DO RTYPE
SET T1=Y_$EXTRACT(BL,1,30-$LENGTH(Y))_DVBVMA_$EXTRACT(BL,1,9-$LENGTH(DVBVMA))_DVBRMA
DO LIN
+2 KILL DVBCHECK,DVBRTYPE,DVBRTYP,DVBVMA,DVBRMA,Y,Y1,T,TX,BL
+3 ;
+4 DO ADD^DVBHQM31
ERR if '$DATA(DVBMM)
DO ^XMD
+1 if $DATA(DVBMM2)
GOTO KLL
+2 SET DVBSTATS=$SELECT($DATA(DVBABREV):"A",$DATA(DVBERR):"E",$DATA(DVBNETER):"V",1:"N")
if $DATA(XMZ)
SET DVBIXMZ=XMZ
+3 DO SET^DVBHQUT
KLL KILL 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
+1 KILL DVBBAS,DVBVET,DVBDIA,DVBCHI,DVBWIT,DVBADD,DVBDBF,DVBDBE,DVBREF,DVBFUT,DVBINC,DVBMON,DVBBIR
+2 QUIT
+3 ;
TR SET V=@B
SET V=$SELECT(V="B":"BLACKLUNG",V="M":"MILITARY",V="C":"CIVIL SERVICE",V="R":"RAILROAD",V="O":"OTHER",V="X":"COMBINATION",1:V)
SET @B=V
QUIT
+1 ;
RTYPE SET Y1=""
if Y>7
SET Y1="-spouse"
SET Y=Y-100
SET Y=$SELECT(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)
SET Y=Y_Y1
KILL Y1
+1 SET DVBVMA=$PIECE(DVBRTYPE(DVBRTYP),U)
SET DVBRMA=$PIECE(DVBRTYPE(DVBRTYP),U,2)
FOR Z=1:1:4
if $LENGTH(DVBVMA)<6
SET DVBVMA=" "_DVBVMA
if $LENGTH(DVBRMA)<6
SET DVBRMA=" "_DVBRMA
+2 QUIT
+3 ;
T0 ;;
+1 ;;DVBHOLD=Income reported
+2 ;;DVBEINC=Earned annual Income
+3 ;;DVBSSA=Annual Soc. Sec.
+4 ;;DVBRETT=Type of other Retirement
+5 ;;DVBRETO=Amount of other Retirement
+6 ;;DVBOINC=Other annual Income
+7 ;;DVBSPENC=Spouse earned annual income
+8 ;;DVBSPSSA=Spouse annual Soc. Sec.
+9 ;;DVBSPRET=Spouse type of other Retirement
+10 ;;DVBSPETO=Spouse other Retirement
+11 ;;DVBSPINC=Spouse other annual Income
