DVBHQM31 ;ISC-ALBANY/JLU-creates second column HINQ data ;9/28/88@0800
;;4.0;HINQ;**49**;03/25/92
;
ADD G:'$D(DVBP(6)) P1
I $P(DVBP(6),U,2)="Y" D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"VA Employee",DVBCTN=DVBCTN+1
I $P(DVBP(6),U,4)="Y" D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"Vietnam Service",DVBCTN=DVBCTN+1
I $P(DVBP(6),U,5)="Y" D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"Medal of Honor",DVBCTN=DVBCTN+1
I $D(DVBFIDUC) D
. I +$P($G(DVBP(6)),U,6)>1,(+$P($G(DVBP(6)),U,6)<5) S $P(DVBP(6),U,6)="Y"
I $P(DVBP(6),U,6)="Y" D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"Guardianship",DVBCTN=DVBCTN+1
I $P(DVBP(6),U,7)="Y" D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"Incompetent",DVBCTN=DVBCTN+1
I $P(DVBP(6),U,8)="Y" D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"Verified Svc-Data",DVBCTN=DVBCTN+1
I $P(DVBP(6),U,8)="N" D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"NOT verified Svc-Data",DVBCTN=DVBCTN+1
I $P(DVBP(6),U,8)="U" D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"Unknown Svc-Data",DVBCTN=DVBCTN+1
;
P1 G:'$D(DVBP(1)) P5
N DVBADAP
S DVBADAP=$S($P(DVBP(1),U)="E":"Equip. only",$P(DVBP(1),U)="A":"Auto & Equip.",$P(DVBP(1),U)="N":"None",1:"")
I $G(DVBADAP)]"" D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"Adaptive equipment = "_DVBADAP,DVBCTN=DVBCTN+1
I $P(DVBP(1),U,2)=1!($P(DVBP(1),U,2)="A") D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"Auto allowance = paid.",DVBCTN=DVBCTN+1
S T1=$P(DVBP(1),U,3) I T1?8N S M=$E(T1,5,6) D MM,SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"Original Award = "_M_" "_$E(T1,7,8)_", "_$E(T1,1,4),DVBCTN=DVBCTN+1
S T1=$P(DVBP(1),U,5) I T1?1.2N D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"Networth = "_$S(T1'="00":"$"_(T1-1*1000)_"-"_"$"_(T1*1000),T1="00":"Zero Networth"),DVBCTN=DVBCTN+1
I $D(DVBBAS(1)) S T1=$P(DVBBAS(1),U,42) I T1?1.2N D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"(Cust/Spouse) = "_$S(T1'="00":"$"_(T1-1*1000)_"-"_"$"_(T1*1000),T1="00":"Zero Networth"),DVBCTN=DVBCTN+1
;Nursing Home Indicator no longer coming from VBA - DVB*4*49
I $P(DVBP(1),U,7)=1 D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"Adaptive housing = PAID",DVBCTN=DVBCTN+1
;SSI, Combat Disability no longer coming from VBA - DVB*4*49
;
P5 Q:'$D(DVBP(5)) S T1=$P(DVBP(5),U) I T1 D SPAC S ^(0)=^TMP($J,DVBCTN,0)_Z_"PFOP Balance = "_" $"_+$E(T1,1,6)_"."_$E(T1,7,8),DVBCTN=DVBCTN+1
Q
;
SPAC K Z I $L(^TMP($J,DVBCTN,0))<48 S $P(Z," ",48-$L(^TMP($J,DVBCTN,0)))=" " Q
S DVBCTN=DVBCTN+1 G SPAC
;
MM S M=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",M) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHQM31 2400 printed Nov 22, 2024@17:08:55 Page 2
DVBHQM31 ;ISC-ALBANY/JLU-creates second column HINQ data ;9/28/88@0800
+1 ;;4.0;HINQ;**49**;03/25/92
+2 ;
ADD if '$DATA(DVBP(6))
GOTO P1
+1 IF $PIECE(DVBP(6),U,2)="Y"
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"VA Employee"
SET DVBCTN=DVBCTN+1
+2 IF $PIECE(DVBP(6),U,4)="Y"
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"Vietnam Service"
SET DVBCTN=DVBCTN+1
+3 IF $PIECE(DVBP(6),U,5)="Y"
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"Medal of Honor"
SET DVBCTN=DVBCTN+1
+4 IF $DATA(DVBFIDUC)
Begin DoDot:1
+5 IF +$PIECE($GET(DVBP(6)),U,6)>1
IF (+$PIECE($GET(DVBP(6)),U,6)<5)
SET $PIECE(DVBP(6),U,6)="Y"
End DoDot:1
+6 IF $PIECE(DVBP(6),U,6)="Y"
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"Guardianship"
SET DVBCTN=DVBCTN+1
+7 IF $PIECE(DVBP(6),U,7)="Y"
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"Incompetent"
SET DVBCTN=DVBCTN+1
+8 IF $PIECE(DVBP(6),U,8)="Y"
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"Verified Svc-Data"
SET DVBCTN=DVBCTN+1
+9 IF $PIECE(DVBP(6),U,8)="N"
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"NOT verified Svc-Data"
SET DVBCTN=DVBCTN+1
+10 IF $PIECE(DVBP(6),U,8)="U"
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"Unknown Svc-Data"
SET DVBCTN=DVBCTN+1
+11 ;
P1 if '$DATA(DVBP(1))
GOTO P5
+1 NEW DVBADAP
+2 SET DVBADAP=$SELECT($PIECE(DVBP(1),U)="E":"Equip. only",$PIECE(DVBP(1),U)="A":"Auto & Equip.",$PIECE(DVBP(1),U)="N":"None",1:"")
+3 IF $GET(DVBADAP)]""
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"Adaptive equipment = "_DVBADAP
SET DVBCTN=DVBCTN+1
+4 IF $PIECE(DVBP(1),U,2)=1!($PIECE(DVBP(1),U,2)="A")
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"Auto allowance = paid."
SET DVBCTN=DVBCTN+1
+5 SET T1=$PIECE(DVBP(1),U,3)
IF T1?8N
SET M=$EXTRACT(T1,5,6)
DO MM
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"Original Award = "_M_" "_$EXTRACT(T1,7,8)_", "_$EXTRACT(T1,1,4)
SET DVBCTN=DVBCTN+1
+6 SET T1=$PIECE(DVBP(1),U,5)
IF T1?1.2N
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"Networth = "_$SELECT(T1'="00":"$"_(T1-1*1000)_"-"_"$"_(T1*1000),T1="00":"Zero Networth")
SET DVBCTN=DVBCTN+1
+7 IF $DATA(DVBBAS(1))
SET T1=$PIECE(DVBBAS(1),U,42)
IF T1?1.2N
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"(Cust/Spouse) = "_$SELECT(T1'="00":"$"_(T1-1*1000)_"-"_"$"_(T1*1000),T1="00":"Zero Networth")
SET DVBCTN=DVBCTN+1
+8 ;Nursing Home Indicator no longer coming from VBA - DVB*4*49
+9 IF $PIECE(DVBP(1),U,7)=1
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"Adaptive housing = PAID"
SET DVBCTN=DVBCTN+1
+10 ;SSI, Combat Disability no longer coming from VBA - DVB*4*49
+11 ;
P5 if '$DATA(DVBP(5))
QUIT
SET T1=$PIECE(DVBP(5),U)
IF T1
DO SPAC
SET ^(0)=^TMP($JOB,DVBCTN,0)_Z_"PFOP Balance = "_" $"_+$EXTRACT(T1,1,6)_"."_$EXTRACT(T1,7,8)
SET DVBCTN=DVBCTN+1
+1 QUIT
+2 ;
SPAC KILL Z
IF $LENGTH(^TMP($JOB,DVBCTN,0))<48
SET $PIECE(Z," ",48-$LENGTH(^TMP($JOB,DVBCTN,0)))=" "
QUIT
+1 SET DVBCTN=DVBCTN+1
GOTO SPAC
+2 ;
MM SET M=$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",M)
QUIT
