source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR9DEM.m@ 1420

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1RMPR9DEM ;HOIFO/HNC/SPS - GUI 2319 DEM VADPT IN RESULTS ARRAY ;9/19/02 11:27
2 ;;3.0;PROSTHETICS;**59**;Feb 09, 1996
3EN(RESULTS,IEN) ;broker entry point
4 ;translate ien 668 to DFN
5 ;
6TST ;S IEN=311
7 S DFN=$P($G(^RMPR(668,IEN,0)),U,2)
8 I DFN="" S RESULTS(999)="NOTHING TO REPORT" G EXIT
9 D DEM^VADPT
10 S RESULTS(0)=VADM(1) ;Name
11 S RESULTS(1)=VADM(2) ;SSN
12 S RESULTS(2)=VADM(3) ;Date of Birth
13 S RESULTS(3)=VADM(4) ;Age
14 S RESULTS(4)=VADM(5) ;Sex
15 S RESULTS(5)=VADM(6) ;Date of Death
16 S RESULTS(6)=VADM(8) ;Race
17 S RESULTS(7)=VADM(9) ;Religion
18 S RESULTS(8)=VADM(10) ;Marital Status
19 S RESULTS(9)=VA("PID") ;Primary Long ID
20 S RESULTS(10)=VA("BID") ;Primary Short ID
21 ;I $G(VAERR)'="" S RESULTS(999)=VAERR
22 ;
23 S DFN=$P($G(^RMPR(668,IEN,0)),U,2)
24 I DFN="" S RESULTS(999)="NOTHING TO REPORT" G EXIT
25 D ADD^VADPT
26 S RESULTS(12)=VAPA(1) ;First line address
27 S RESULTS(13)=VAPA(4) ;City
28 S RESULTS(14)=VAPA(5) ;State
29 S RESULTS(15)=VAPA(6) ;Zip
30 S RESULTS(16)=VAPA(7) ;County
31 S RESULTS(17)=VAPA(8) ;Phone
32 S RESULTS(18)=VAPA(11) ;Zip+4
33 ;NOK
34 D OAD^VADPT
35 S RESULTS(19)=VAOA(9) ;NOK name
36 S RESULTS(20)=VAOA(1) ;NOK Address
37 S RESULTS(21)=VAOA(4) ;NOK CITY
38 S RESULTS(22)=VAOA(5) ;NOK STATE
39 S RESULTS(23)=VAOA(6) ;NOK ZIP
40 S RESULTS(24)=VAOA(8) ;NOK PHONE
41 S RESULTS(25)=VAOA(10) ;NOK RELATIONSHIP
42 ; Eligibility segment
43 D ELIG^VADPT
44 S RESULTS(11)=VAEL(7) ;Claim #
45 S RESULTS(26)=$P(VAEL(6),U,2) ;Patient Type
46 S RESULTS(27)=$P(VAEL(2),U,2) ;Period of Service
47 S RESULTS(28)=$P(VAEL(1),U,2) ;Primary Eligibility Code
48 S RESULTS(29)=$S(VAEL(8)]"":$P(VAEL(8),U,2),1:"NOT VERIFIED") ;Verification?
49 ;Monetary Benefit Info from MB^VADPT
50 D MB^VADPT
51 S RESULTS(30)="NO" I $P(VAMB(1),U)=1 S RESULTS(30)="YES",RMPRCHK=$P(VAMB(1),U,2)
52 S RESULTS(31)="NO" I $P(VAMB(2),U)=1 S RESULTS(31)="YES",RMPRCHK=$P(VAMB(2),U,2)
53 S RESULTS(32)="NO" I $P(VAMB(4),U)=1 S RESULTS(32)="YES",RMPRCHK=$P(VAMB(4),U,2)
54 S RESULTS(33)="NO" I $P(VAMB(7),U)=1 S RESULTS(33)="YES",RMPRCHK=$P(VAMB(7),U,2)
55 S RESULTS(34)=0 I $G(RMPRCHK)]"" S RESULTS(34)=$G(RMPRCHK) ;Total Annual VA Check Amount
56 ;Prosthetics Disability Codes
57 S (RMPRDC,RO,FG)=0 I '$D(^RMPR(665,DFN,1)) S RESULTS(35)="None" S RO=1
58 K RMPRDC
59 I RO=0 F S:'FG RMPRDC="" S RO=$O(^RMPR(665,DFN,1,RO)) Q:RO'>0 D
60 .S RR=^(RO,0) S:$P(RR,U,10) FG=1 I '$P(RR,U,10) S RMPRDC=RMPRDC_$P(^RMPR(662,+RR,0),U,1)_"-"_$S($P(RR,U,3)=1:"SC",$P(RR,U,3)=2:"NSC",1:"") S FG=1
61 S:FG=1 RESULTS(35)=RMPRDC
62 ;POW
63 D SVC^VADPT
64 S RESULTS(36)=$S(VASV(4)=1:"YES",1:"NO") ;POW YES/NO
65 ;Emergency Contact
66 S VAOA("A")=1 D OAD^VADPT
67 S RESULTS(37)=VAOA(9) ;Name of Emergency Contact
68 S RESULTS(38)=VAOA(1) ;Street Address
69 S RESULTS(39)=VAOA(4) ;City
70 S RESULTS(40)=$P(VAOA(5),U,2) ;State
71 S RESULTS(41)=VAOA(6) ;Zip
72 S RESULTS(42)=VAOA(8) ;Home Phone
73 S RESULTS(43)=VAOA(10) ;Relationship
74 I $G(VAERR)'="" S RESULTS(999)=VAERR
75 ;
76 Q
77EXIT ;
78 Q
79 ;END
Note: See TracBrowser for help on using the repository browser.