- RMPR9DEM ;HOIFO/HNC/SPS - GUI 2319 DEM VADPT IN RESULTS ARRAY ;9/19/02 11:27
- ;;3.0;PROSTHETICS;**59**;Feb 09, 1996
- EN(RESULTS,IEN) ;broker entry point
- ;translate ien 668 to DFN
- ;
- TST ;S IEN=311
- S DFN=$P($G(^RMPR(668,IEN,0)),U,2)
- I DFN="" S RESULTS(999)="NOTHING TO REPORT" G EXIT
- D DEM^VADPT
- S RESULTS(0)=VADM(1) ;Name
- S RESULTS(1)=VADM(2) ;SSN
- S RESULTS(2)=VADM(3) ;Date of Birth
- S RESULTS(3)=VADM(4) ;Age
- S RESULTS(4)=VADM(5) ;Sex
- S RESULTS(5)=VADM(6) ;Date of Death
- S RESULTS(6)=VADM(8) ;Race
- S RESULTS(7)=VADM(9) ;Religion
- S RESULTS(8)=VADM(10) ;Marital Status
- S RESULTS(9)=VA("PID") ;Primary Long ID
- S RESULTS(10)=VA("BID") ;Primary Short ID
- ;I $G(VAERR)'="" S RESULTS(999)=VAERR
- ;
- S DFN=$P($G(^RMPR(668,IEN,0)),U,2)
- I DFN="" S RESULTS(999)="NOTHING TO REPORT" G EXIT
- D ADD^VADPT
- S RESULTS(12)=VAPA(1) ;First line address
- S RESULTS(13)=VAPA(4) ;City
- S RESULTS(14)=VAPA(5) ;State
- S RESULTS(15)=VAPA(6) ;Zip
- S RESULTS(16)=VAPA(7) ;County
- S RESULTS(17)=VAPA(8) ;Phone
- S RESULTS(18)=VAPA(11) ;Zip+4
- ;NOK
- D OAD^VADPT
- S RESULTS(19)=VAOA(9) ;NOK name
- S RESULTS(20)=VAOA(1) ;NOK Address
- S RESULTS(21)=VAOA(4) ;NOK CITY
- S RESULTS(22)=VAOA(5) ;NOK STATE
- S RESULTS(23)=VAOA(6) ;NOK ZIP
- S RESULTS(24)=VAOA(8) ;NOK PHONE
- S RESULTS(25)=VAOA(10) ;NOK RELATIONSHIP
- ; Eligibility segment
- D ELIG^VADPT
- S RESULTS(11)=VAEL(7) ;Claim #
- S RESULTS(26)=$P(VAEL(6),U,2) ;Patient Type
- S RESULTS(27)=$P(VAEL(2),U,2) ;Period of Service
- S RESULTS(28)=$P(VAEL(1),U,2) ;Primary Eligibility Code
- S RESULTS(29)=$S(VAEL(8)]"":$P(VAEL(8),U,2),1:"NOT VERIFIED") ;Verification?
- ;Monetary Benefit Info from MB^VADPT
- D MB^VADPT
- S RESULTS(30)="NO" I $P(VAMB(1),U)=1 S RESULTS(30)="YES",RMPRCHK=$P(VAMB(1),U,2)
- S RESULTS(31)="NO" I $P(VAMB(2),U)=1 S RESULTS(31)="YES",RMPRCHK=$P(VAMB(2),U,2)
- S RESULTS(32)="NO" I $P(VAMB(4),U)=1 S RESULTS(32)="YES",RMPRCHK=$P(VAMB(4),U,2)
- S RESULTS(33)="NO" I $P(VAMB(7),U)=1 S RESULTS(33)="YES",RMPRCHK=$P(VAMB(7),U,2)
- S RESULTS(34)=0 I $G(RMPRCHK)]"" S RESULTS(34)=$G(RMPRCHK) ;Total Annual VA Check Amount
- ;Prosthetics Disability Codes
- S (RMPRDC,RO,FG)=0 I '$D(^RMPR(665,DFN,1)) S RESULTS(35)="None" S RO=1
- K RMPRDC
- I RO=0 F S:'FG RMPRDC="" S RO=$O(^RMPR(665,DFN,1,RO)) Q:RO'>0 D
- .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
- S:FG=1 RESULTS(35)=RMPRDC
- ;POW
- D SVC^VADPT
- S RESULTS(36)=$S(VASV(4)=1:"YES",1:"NO") ;POW YES/NO
- ;Emergency Contact
- S VAOA("A")=1 D OAD^VADPT
- S RESULTS(37)=VAOA(9) ;Name of Emergency Contact
- S RESULTS(38)=VAOA(1) ;Street Address
- S RESULTS(39)=VAOA(4) ;City
- S RESULTS(40)=$P(VAOA(5),U,2) ;State
- S RESULTS(41)=VAOA(6) ;Zip
- S RESULTS(42)=VAOA(8) ;Home Phone
- S RESULTS(43)=VAOA(10) ;Relationship
- I $G(VAERR)'="" S RESULTS(999)=VAERR
- ;
- Q
- EXIT ;
- Q
- ;END
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR9DEM 2930 printed Feb 19, 2025@00:00:01 Page 2
- RMPR9DEM ;HOIFO/HNC/SPS - GUI 2319 DEM VADPT IN RESULTS ARRAY ;9/19/02 11:27
- +1 ;;3.0;PROSTHETICS;**59**;Feb 09, 1996
- EN(RESULTS,IEN) ;broker entry point
- +1 ;translate ien 668 to DFN
- +2 ;
- TST ;S IEN=311
- +1 SET DFN=$PIECE($GET(^RMPR(668,IEN,0)),U,2)
- +2 IF DFN=""
- SET RESULTS(999)="NOTHING TO REPORT"
- GOTO EXIT
- +3 DO DEM^VADPT
- +4 ;Name
- SET RESULTS(0)=VADM(1)
- +5 ;SSN
- SET RESULTS(1)=VADM(2)
- +6 ;Date of Birth
- SET RESULTS(2)=VADM(3)
- +7 ;Age
- SET RESULTS(3)=VADM(4)
- +8 ;Sex
- SET RESULTS(4)=VADM(5)
- +9 ;Date of Death
- SET RESULTS(5)=VADM(6)
- +10 ;Race
- SET RESULTS(6)=VADM(8)
- +11 ;Religion
- SET RESULTS(7)=VADM(9)
- +12 ;Marital Status
- SET RESULTS(8)=VADM(10)
- +13 ;Primary Long ID
- SET RESULTS(9)=VA("PID")
- +14 ;Primary Short ID
- SET RESULTS(10)=VA("BID")
- +15 ;I $G(VAERR)'="" S RESULTS(999)=VAERR
- +16 ;
- +17 SET DFN=$PIECE($GET(^RMPR(668,IEN,0)),U,2)
- +18 IF DFN=""
- SET RESULTS(999)="NOTHING TO REPORT"
- GOTO EXIT
- +19 DO ADD^VADPT
- +20 ;First line address
- SET RESULTS(12)=VAPA(1)
- +21 ;City
- SET RESULTS(13)=VAPA(4)
- +22 ;State
- SET RESULTS(14)=VAPA(5)
- +23 ;Zip
- SET RESULTS(15)=VAPA(6)
- +24 ;County
- SET RESULTS(16)=VAPA(7)
- +25 ;Phone
- SET RESULTS(17)=VAPA(8)
- +26 ;Zip+4
- SET RESULTS(18)=VAPA(11)
- +27 ;NOK
- +28 DO OAD^VADPT
- +29 ;NOK name
- SET RESULTS(19)=VAOA(9)
- +30 ;NOK Address
- SET RESULTS(20)=VAOA(1)
- +31 ;NOK CITY
- SET RESULTS(21)=VAOA(4)
- +32 ;NOK STATE
- SET RESULTS(22)=VAOA(5)
- +33 ;NOK ZIP
- SET RESULTS(23)=VAOA(6)
- +34 ;NOK PHONE
- SET RESULTS(24)=VAOA(8)
- +35 ;NOK RELATIONSHIP
- SET RESULTS(25)=VAOA(10)
- +36 ; Eligibility segment
- +37 DO ELIG^VADPT
- +38 ;Claim #
- SET RESULTS(11)=VAEL(7)
- +39 ;Patient Type
- SET RESULTS(26)=$PIECE(VAEL(6),U,2)
- +40 ;Period of Service
- SET RESULTS(27)=$PIECE(VAEL(2),U,2)
- +41 ;Primary Eligibility Code
- SET RESULTS(28)=$PIECE(VAEL(1),U,2)
- +42 ;Verification?
- SET RESULTS(29)=$SELECT(VAEL(8)]"":$PIECE(VAEL(8),U,2),1:"NOT VERIFIED")
- +43 ;Monetary Benefit Info from MB^VADPT
- +44 DO MB^VADPT
- +45 SET RESULTS(30)="NO"
- IF $PIECE(VAMB(1),U)=1
- SET RESULTS(30)="YES"
- SET RMPRCHK=$PIECE(VAMB(1),U,2)
- +46 SET RESULTS(31)="NO"
- IF $PIECE(VAMB(2),U)=1
- SET RESULTS(31)="YES"
- SET RMPRCHK=$PIECE(VAMB(2),U,2)
- +47 SET RESULTS(32)="NO"
- IF $PIECE(VAMB(4),U)=1
- SET RESULTS(32)="YES"
- SET RMPRCHK=$PIECE(VAMB(4),U,2)
- +48 SET RESULTS(33)="NO"
- IF $PIECE(VAMB(7),U)=1
- SET RESULTS(33)="YES"
- SET RMPRCHK=$PIECE(VAMB(7),U,2)
- +49 ;Total Annual VA Check Amount
- SET RESULTS(34)=0
- IF $GET(RMPRCHK)]""
- SET RESULTS(34)=$GET(RMPRCHK)
- +50 ;Prosthetics Disability Codes
- +51 SET (RMPRDC,RO,FG)=0
- IF '$DATA(^RMPR(665,DFN,1))
- SET RESULTS(35)="None"
- SET RO=1
- +52 KILL RMPRDC
- +53 IF RO=0
- FOR
- if 'FG
- SET RMPRDC=""
- SET RO=$ORDER(^RMPR(665,DFN,1,RO))
- if RO'>0
- QUIT
- Begin DoDot:1
- +54 SET RR=^(RO,0)
- if $PIECE(RR,U,10)
- SET FG=1
- IF '$PIECE(RR,U,10)
- SET RMPRDC=RMPRDC_$PIECE(^RMPR(662,+RR,0),U,1)_"-"_$SELECT($PIECE(RR,U,3)=1:"SC",$PIECE(RR,U,3)=2:"NSC",1:"")
- SET FG=1
- End DoDot:1
- +55 if FG=1
- SET RESULTS(35)=RMPRDC
- +56 ;POW
- +57 DO SVC^VADPT
- +58 ;POW YES/NO
- SET RESULTS(36)=$SELECT(VASV(4)=1:"YES",1:"NO")
- +59 ;Emergency Contact
- +60 SET VAOA("A")=1
- DO OAD^VADPT
- +61 ;Name of Emergency Contact
- SET RESULTS(37)=VAOA(9)
- +62 ;Street Address
- SET RESULTS(38)=VAOA(1)
- +63 ;City
- SET RESULTS(39)=VAOA(4)
- +64 ;State
- SET RESULTS(40)=$PIECE(VAOA(5),U,2)
- +65 ;Zip
- SET RESULTS(41)=VAOA(6)
- +66 ;Home Phone
- SET RESULTS(42)=VAOA(8)
- +67 ;Relationship
- SET RESULTS(43)=VAOA(10)
- +68 IF $GET(VAERR)'=""
- SET RESULTS(999)=VAERR
- +69 ;
- +70 QUIT
- EXIT ;
- +1 QUIT
- +2 ;END
