source: WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHS3.m@ 1639

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1DVBHS3 ; ALB/JLU;Routine for HINQ screen 3 ; 8/22/05 9:46pm
2 ;;4.0;HINQ;**49**;03/25/92
3 ;
4 K DVBX(1)
5 F LP2=.322,.32101 S X="DVBDIQ(2,"_DFN_","_LP2_")" K @X
6 K DVBDIQ(2.04)
7 I $D(X(1)) S DVBX(1)=X(1)
8 S DIC="^DPT(",DA=DFN,DIQ(0)="E",DIQ="DVBDIQ("
9 S DR=".302;.3014;.322;.32101;.361"
10 D EN^DIQ1
11 S DR=".3721",DR(2.04)=".01;2:6",DIQ(0)="IE"
12 F LP=0:0 S LP=$O(^DPT(DFN,.372,LP)) Q:'LP S DA(2.04)=LP D EN^DIQ1
13 I $D(DVBX(1)) S X(1)=DVBX(1) K DVBX(1)
14 S DVBSCRN=3 D SCRHD^DVBHUTIL
15 S DVBJS=35
16 ;
17 ;DVB*4*49 - Combat Disability removed - Combined % Disability okay
18 ;W !?11,"Comb. % Disab.: "
19 ;I $D(DVBDXPCT) W +DVBDXPCT
20 W !,"Act. Duty Training: "
21 I $D(DVBBIR) W $S($P(DVBBIR,U,24)["Y":"YES",$P(DVBBIR,U,24)["N":"NO",1:"")
22 ;as of DVB*4*49 Additional Service is no longer being sent by VBA
23 ;
24 W ?24,"Tot. Act. Ser.: "
25 I $D(DVBTOTAS) W ?40,DVBTOTAS
26 ;
27 W ?63,"Perm. & Tot.: "
28 ;DVB*4*49 - P&T now being sent by VBA. 3=yes,2=no, else null
29 I $D(DVBPTI) W ?56,$S(DVBPTI=2:"No",DVBPTI=3:"Yes",1:"")
30 ;
31 W !,DVBON,"[1]",DVBOFF X DVBLIT1
32 W ?4,"Ver. SVC data: "
33 W ?21,DVBDIQ(2,DFN,.322,"E")
34 I $D(DVBP(6)) W ?49,$S($P(DVBP(6),U,8)["Y":"YES",$P(DVBP(6),U,8)["N":"NO",1:"")
35 ;
36 W !,DVBON,"[2]",DVBOFF X DVBLIT1
37 W ?4,"Vietnam Ser.:"
38 W ?21,DVBDIQ(2,DFN,.32101,"E")
39 I $D(DVBP(6)) W ?49,$S($P(DVBP(6),U,4)["Y":"YES",$P(DVBP(6),U,4)["N":"NO",1:"")
40 ;
41 W !,DVBON,"[3]",DVBOFF X DVBLIT1
42 W ?4,"Rated Disab.(Pat. File)-Comb. SC%: "
43 I DVBDIQ(2,DFN,.361,"E")'="NSC" W ?37,$S(DVBDIQ(2,DFN,.302,"E")]"":+DVBDIQ(2,DFN,.302,"E"),1:"")
44 ;W ?37,+DVBDIQ(2,DFN,.302,"E")
45 W ?42,"Eff. Date Comb. Eval.: "_DVBDIQ(2,DFN,.3014,"E")
46 I $P($G(^DPT(DFN,.372,0)),U,3)>0 D LABELS
47 I $D(DVBDIQ(2.04)) F LP=0:0 S LP=$O(DVBDIQ(2.04,LP)) Q:'LP D
48 . I ($Y+5)>IOSL,$E(IOST,1,2)="C-" D PAUSE
49 . W !,$E(DVBDIQ(2.04,LP,.01,"E"),1,40),?42,DVBDIQ(2.04,LP,2,"E")
50 . W ?50,$G(DVBDIQ(2.04,LP,4,"I")),?55,$G(DVBDIQ(2.04,LP,5,"E"))
51 . W ?68,$G(DVBDIQ(2.04,LP,6,"E"))
52 N DVBEDT
53 I +$G(DVBEFF)>0 S M=$E(DVBEFF,1,2) D MM^DVBHQM11 S DVBEDT=M_" "_$E(DVBEFF,3,4)_","_$E(DVBEFF,5,8)
54 W !,?4,"Rated Disab. (HINQ)- Comb. SC%: "
55 W ?39,$S($G(DVBDXPCT)]"":+DVBDXPCT,1:"")
56 W ?44,"Eff. Date Comb. Eval.: "_$G(DVBEDT)
57 I $D(DVBDX)>9 D S1^DVBHQZ6
58 Q
59PAUSE ;
60 N DIR
61 S DIR(0)="E" D ^DIR
62 I ('(+Y))!$D(DIRUT) S QUIT=1
63 W @IOF,!
64 Q
65CHKDIS ;check to see if any of the disabilities comng from VBA are absent
66 ;from the VistA DISABILITY CONDITION file (#31)
67 Q
68 N DVBC,DVBERR
69 S (DVBC,DVBERR)=0
70 F S DVBC=$O(DVBDX(DVBC)) Q:DVBC'>0 D
71 . N DVBDIS,DVBDISAB
72 . S DVBDISAB=$P(DVBDX(DVBC),U)
73 . S DVBDIS=$O(^DIC(31,"C",DVBDISAB,""))
74 . I $G(DVBDIS)']"" W !,"Disability code "_DVBDISAB_" is missing from this site's DISABILITY",!,"CONDITIONS file (#13). "_DVBDISAB_" not updated to VistA. Check with ADPAC." S DVBERR=1
75 I $G(DVBERR)=0 Q
76 N DVBANS
77 R !,"Hit any key to continue: ",DVBANS:DTIME
78 Q
79CHKEFF(DVBDT) ;
80 Q:$G(DVBDT)']""
81 F DVBE=1:1:4 I $E(DVBDT,1)=" " S DVBDT=$E(DVBDT,2,8)
82 I DVBDT'?1.8N S DVBDT="" Q
83 D
84 . S DVBOFFST="00000000"
85 . S DVBDT=$E(DVBOFFST,1,8-$L(DVBDT))_DVBDT
86 . I +DVBDT?5.6N S DVBDT=$E(DVBDT,3,4)_"00"_$E(DVBDT,5,8)
87 S DVBDT=($E(DVBDT,5,8)-1700)_$E(DVBDT,1,2)_$E(DVBDT,3,4)
88 Q
89LABELS ;
90 W !?55,"Original",?68,"Current"
91 W !?3,"Disability",?43,"%",?49,"Extr.",?54,"Eff. Date",?67,"Eff. Date"
92 Q
Note: See TracBrowser for help on using the repository browser.