DGVPTDV1 ;alb/mjk - DVBHS5 for export with PIMS v5.3; 4/21/93
;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
;
DVBHS5 ; ALB/JLU;Routine for HINQ screen 5; 10/04/91
;;V4.0;HINQ;**12,11**;03/25/92
N Y
K DVBX(1)
K DVBDIQ ;F LP2=.3611,.3616,.3612,.306,.3615,391,1901,.301,.302,.361,.36205,.3621,.36235,.3624,.36215,.3622,.36295,.3025,.303 S X="DVBDIQ(2,"_DFN_","_LP2_")" K @X
I $D(X(1)) S DVBX(1)=X(1)
S DIC="^DPT(",DIQ(0)="E",DIQ="DVBDIQ("
;S DR=".01;.09;.3611;.3616;.3612;.306;.3615;391;1901;.301;.302;.361;.36205;.3621;.36235;.3624;.36215;.3622;.36295;.3025;.303"
S DR=".01;.09;.3611;.3616;.3612;.306;.3615;391;1901;.301;.302;.361;.36205;.36235;.36215;.36295;.3025"
D EN^DIQ1
I $D(DVBX(1)) S X(1)=DVBX(1) K DVBX(1)
;
S DVBSCRN=5 D SCRHD^DVBHUTIL
S DVBJS=53
W !,"Check Amt.: ",$S($D(DVBCHECK):"$"_DVBCHECK,1:"")
W ?28,"Combined %: ",$S($D(DVBDXPCT):DVBDXPCT_"%",1:"")
W ?48,"Net Award Amt.: ",$S($D(DVBBAS(1)):"$"_$P(DVBBAS(1),U,20),1:"")
I $D(DVBP(1)) S T1=$P(DVBP(1),U,4) I +T1 S T2=$O(^DVB(395.1,"B",T1,"")) I T2 S DVBENT=$P(^DVB(395.1,T2,0),U,2)_"-"_T1
K T1,T2 W !,"Entitlement:",?15,$S($D(DVBENT):DVBENT,1:""),!,"Aid & Attendance: " I $D(DVBAAHB) S Y=DVBAAHB D AAA^DVBHQM2 W Y
;;;W !,"Rated (HINQ) Disabilities:" I $D(DVBDXNO),DVBDXNO'=0 D S1^DVBHQZ6
I $D(DVBSCR) K DVBSCR D LINE Q
;
W !,"--- ",DVBON,"Patient Data",DVBOFF," ---"
W !,DVBON,"(1)",DVBOFF," Elig. Stat.: ",$E(DVBDIQ(2,DFN,.3611,"E"),1,20) X DVBLIT1
W ?38,"Elig. Stat. ent. by: ",$E(DVBDIQ(2,DFN,.3616,"E"),1,18)
W !,?5,"Stat. date: ",DVBDIQ(2,DFN,.3612,"E")
W ?37,"Monetary Ben. Verif.: ",DVBDIQ(2,DFN,.306,"E")
W !,?3,"Verif. Meth.: ",$E(DVBDIQ(2,DFN,.3615,"E"),1,50)
W ?44,"Patient Elig.: "
I $D(^DPT(DFN,"E",0)),+$P(^(0),U,3) F DVBOH=0:0 S DVBOH=$O(^DPT(DFN,"E",DVBOH)) I DVBOH'=+^DPT(DFN,.36) S DVBOH=$S($D(^DIC(8,DVBOH,0)):$P(^(0),U),1:"") W $E(DVBOH,1,18) Q
W !!,DVBON,"(2)",DVBOFF," Pat. Type: ",$E(DVBDIQ(2,DFN,391,"E"),1,30) X DVBLIT1
W ?40,"Vet. (Y/N)?: ",DVBDIQ(2,DFN,1901,"E")
W !,?4,"Ser. Con.: ",DVBDIQ(2,DFN,.301,"E")
W ?40,"Ser. Con. %: ",DVBDIQ(2,DFN,.302,"E")
W !,?3,"Elig. Code: ",$E(DVBDIQ(2,DFN,.361,"E"),1,30)
W !!,DVBON,"(3)",DVBOFF," A&A: ",DVBDIQ(2,DFN,.36205,"E") X DVBLIT1
;W ?18,"Amt.: $",$E(DVBDIQ(2,DFN,.3621,"E"),1,11)
W ?41,"VA Pension: ",DVBDIQ(2,DFN,.36235,"E")
;W ?58,"Amt.: $",$E(DVBDIQ(2,DFN,.3624,"E"),1,11)
W !,"House Bound: ",DVBDIQ(2,DFN,.36215,"E")
;W ?18,"Amt.: $",$E(DVBDIQ(2,DFN,.3622,"E"),1,11)
W ?38,"VA Disability: ",DVBDIQ(2,DFN,.3025,"E")
;W ?58,"Amt.: $",$E(DVBDIQ(2,DFN,.303,"E"),1,11)
W !,"Tot.Ann. VA Check Amt.: $",DVBDIQ(2,DFN,.36295,"E")
S NEW=DVBDIQ(2,DFN,.01,"E"),NEW2=DVBDIQ(2,DFN,.09,"E") K DVBDIQ
S DVBDIQ(2,DFN,.01,"E")=NEW,DVBDIQ(2,DFN,.09,"E")=NEW2 K NEW,NEW2 Q
LINE W !,"------------------------------------------------------------------------------"
DGVPTDV1 ;alb/mjk - DVBHS5 for export with PIMS v5.3; 4/21/93
+1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
+2 ;
DVBHS5 ; ALB/JLU;Routine for HINQ screen 5; 10/04/91
+1 ;;V4.0;HINQ;**12,11**;03/25/92
+2 NEW Y
+3 KILL DVBX(1)
+4 ;F LP2=.3611,.3616,.3612,.306,.3615,391,1901,.301,.302,.361,.36205,.3621,.36235,.3624,.36215,.3622,.36295,.3025,.303 S X="DVBDIQ(2,"_DFN_","_LP2_")" K @X
KILL DVBDIQ
+5 IF $DATA(X(1))
SET DVBX(1)=X(1)
+6 SET DIC="^DPT("
SET DIQ(0)="E"
SET DIQ="DVBDIQ("
+7 ;S DR=".01;.09;.3611;.3616;.3612;.306;.3615;391;1901;.301;.302;.361;.36205;.3621;.36235;.3624;.36215;.3622;.36295;.3025;.303"
+8 SET DR=".01;.09;.3611;.3616;.3612;.306;.3615;391;1901;.301;.302;.361;.36205;.36235;.36215;.36295;.3025"
+9 DO EN^DIQ1
+10 IF $DATA(DVBX(1))
SET X(1)=DVBX(1)
KILL DVBX(1)
+11 ;
+12 SET DVBSCRN=5
DO SCRHD^DVBHUTIL
+13 SET DVBJS=53
+14 WRITE !,"Check Amt.: ",$SELECT($DATA(DVBCHECK):"$"_DVBCHECK,1:"")
+15 WRITE ?28,"Combined %: ",$SELECT($DATA(DVBDXPCT):DVBDXPCT_"%",1:"")
+16 WRITE ?48,"Net Award Amt.: ",$SELECT($DATA(DVBBAS(1)):"$"_$PIECE(DVBBAS(1),U,20),1:"")
+17 IF $DATA(DVBP(1))
SET T1=$PIECE(DVBP(1),U,4)
IF +T1
SET T2=$ORDER(^DVB(395.1,"B",T1,""))
IF T2
SET DVBENT=$PIECE(^DVB(395.1,T2,0),U,2)_"-"_T1
+18 KILL T1,T2
WRITE !,"Entitlement:",?15,$SELECT($DATA(DVBENT):DVBENT,1:""),!,"Aid & Attendance: "
IF $DATA(DVBAAHB)
SET Y=DVBAAHB
DO AAA^DVBHQM2
WRITE Y
+19 ;;;W !,"Rated (HINQ) Disabilities:" I $D(DVBDXNO),DVBDXNO'=0 D S1^DVBHQZ6
+20 IF $DATA(DVBSCR)
KILL DVBSCR
DO LINE
QUIT
+21 ;
+22 WRITE !,"--- ",DVBON,"Patient Data",DVBOFF," ---"
+23 WRITE !,DVBON,"(1)",DVBOFF," Elig. Stat.: ",$EXTRACT(DVBDIQ(2,DFN,.3611,"E"),1,20)
XECUTE DVBLIT1
+24 WRITE ?38,"Elig. Stat. ent. by: ",$EXTRACT(DVBDIQ(2,DFN,.3616,"E"),1,18)
+25 WRITE !,?5,"Stat. date: ",DVBDIQ(2,DFN,.3612,"E")
+26 WRITE ?37,"Monetary Ben. Verif.: ",DVBDIQ(2,DFN,.306,"E")
+27 WRITE !,?3,"Verif. Meth.: ",$EXTRACT(DVBDIQ(2,DFN,.3615,"E"),1,50)
+28 WRITE ?44,"Patient Elig.: "
+29 IF $DATA(^DPT(DFN,"E",0))
IF +$PIECE(^(0),U,3)
FOR DVBOH=0:0
SET DVBOH=$ORDER(^DPT(DFN,"E",DVBOH))
IF DVBOH'=+^DPT(DFN,.36)
SET DVBOH=$SELECT($DATA(^DIC(8,DVBOH,0)):$PIECE(^(0),U),1:"")
WRITE $EXTRACT(DVBOH,1,18)
QUIT
+30 WRITE !!,DVBON,"(2)",DVBOFF," Pat. Type: ",$EXTRACT(DVBDIQ(2,DFN,391,"E"),1,30)
XECUTE DVBLIT1
+31 WRITE ?40,"Vet. (Y/N)?: ",DVBDIQ(2,DFN,1901,"E")
+32 WRITE !,?4,"Ser. Con.: ",DVBDIQ(2,DFN,.301,"E")
+33 WRITE ?40,"Ser. Con. %: ",DVBDIQ(2,DFN,.302,"E")
+34 WRITE !,?3,"Elig. Code: ",$EXTRACT(DVBDIQ(2,DFN,.361,"E"),1,30)
+35 WRITE !!,DVBON,"(3)",DVBOFF," A&A: ",DVBDIQ(2,DFN,.36205,"E")
XECUTE DVBLIT1
+36 ;W ?18,"Amt.: $",$E(DVBDIQ(2,DFN,.3621,"E"),1,11)
+37 WRITE ?41,"VA Pension: ",DVBDIQ(2,DFN,.36235,"E")
+38 ;W ?58,"Amt.: $",$E(DVBDIQ(2,DFN,.3624,"E"),1,11)
+39 WRITE !,"House Bound: ",DVBDIQ(2,DFN,.36215,"E")
+40 ;W ?18,"Amt.: $",$E(DVBDIQ(2,DFN,.3622,"E"),1,11)
+41 WRITE ?38,"VA Disability: ",DVBDIQ(2,DFN,.3025,"E")
+42 ;W ?58,"Amt.: $",$E(DVBDIQ(2,DFN,.303,"E"),1,11)
+43 WRITE !,"Tot.Ann. VA Check Amt.: $",DVBDIQ(2,DFN,.36295,"E")
+44 SET NEW=DVBDIQ(2,DFN,.01,"E")
SET NEW2=DVBDIQ(2,DFN,.09,"E")
KILL DVBDIQ
+45 SET DVBDIQ(2,DFN,.01,"E")=NEW
SET DVBDIQ(2,DFN,.09,"E")=NEW2
KILL NEW,NEW2
QUIT
LINE WRITE !,"------------------------------------------------------------------------------"
