[613] | 1 | RMPR9DEM ;HOIFO/HNC/SPS - GUI 2319 DEM VADPT IN RESULTS ARRAY ;9/19/02 11:27
|
---|
| 2 | ;;3.0;PROSTHETICS;**59**;Feb 09, 1996
|
---|
| 3 | EN(RESULTS,IEN) ;broker entry point
|
---|
| 4 | ;translate ien 668 to DFN
|
---|
| 5 | ;
|
---|
| 6 | TST ;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
|
---|
| 77 | EXIT ;
|
---|
| 78 | Q
|
---|
| 79 | ;END
|
---|