- 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 Mar 13, 2025@21:03:37 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
