| 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
 | 
|---|