RMPV0RMPRPAT ; OIT/JDA - Adapted from RMPRPAT; Dec 01, 2024@21:44:41
;;1.0;PROSTHETICS VISION 4 SIGHT II;**2**;Jan 31, 2025;Build 38
;Per VHA Directive 10-93-142, this routine should not be modified.
;
; Reference to file #665 supported by ICR #6537
; Reference to file #2 (^DPT) supported by ICR #7019
; Reference to RMPRPAT0 supported by ICR #7557
; Reference to RMPRPAT1 supported by ICR #7558
; Reference to RMPRPAT2 supported by ICR #7563
; Reference to 2319^RMPOBIL2 supported by ICR #7560
; Reference to STAR^RMPRPAT supported by ICR #7561
; Reference to DISP^RMPRPAT5 supported by ICR #7567
; Reference to NPC^RMPRPAT5 supported by ICR #7567
;
RMPRPAT ;PHX/RFM/JLT-DISPLAY 2319 FIRST PAGE ;8/29/1994
;;3.0;PROSTHETICS;**29,62,162**;Feb 09, 1996;Build 5
;
; RVD - patch # 62 - sets RMPRNAM, RMPRSSN,RMPRDOB and RMPRSSNE
;
ASK ;Set common variables
Q:$G(RMPRDFN)<1
;PATCH *162 => insure activity screen displays first time (RMPRFRST) in and Home Oxygen activity is NOT included (RCNT=7) for inside issue option
N RCNT
D HOMEZIS^RMPVRT S DFN=RMPRDFN,RMPRBACK=1,RMPRFRST=1,RCNT=7 I $G(RSTCK)'=1 S RCNT=8,RFLG=1
D ADD^VADPT,OAD^VADPT,DEM^VADPT,ELIG^VADPT
;next 2 lines added by patch #62
S RMPRNAM=$P(VADM(1),U),RMPRSSN=$P(VADM(2),U)
S RMPRDOB=$P(VADM(3),U),RMPRSSNE=VA("PID")
D WRITEIND^RMPVIO("@IOF")
S %X="^RMPR(665,"_RMPRDFN_",",%Y="R5(" D %XY^%RCR S RMPRCNUM=VAEL(7)
ASK1 ;CALL ROUTINE TO DISPLAY SCREEN SELECTI0N
Q:$G(RMPRDFN)'>0 S DFN=RMPRDFN
I '$D(VAEL(7)) D ELIG^VADPT
I '$D(VAPA(1)) D ADD^VADPT
I '$D(VADM(1)) D DEM^VADPT
I '$D(VAOA(1)) D OAD^VADPT
I $D(^RMPR(665,RMPRDFN,8,0)) D WRITECTL^RMPVIO("!"),WRITE^RMPVIO("*Comments on file")
I '$D(^RMPR(665,RMPRDFN,1,0)) D WRITE^RMPVIO($C(7)),WRITECTL^RMPVIO("!!"),WRITE^RMPVIO("*No Disability Code on File!")
I $D(^RMPR(665,RMPRDFN,1,0)),'$O(^(0)) D WRITE^RMPVIO($C(7)),WRITECTL^RMPVIO("!!"),WRITE^RMPVIO("*No Disability Code on File!")
D DISP^RMPRPAT5 K ANS D WRITECTL^RMPVIO("!")
K RMPRQ,RMPRQUES,DIR,RMPREND1,RMPRL
D ASK1^RMPRPAT1 K ANS I $G(RMPRFRST)=1,$G(RSTCK) D HELP^RMPRPAT1 ;insure activity list appears upon entry
D %DIR^RMPVFM
K DIR,RMPRFRST
I Y["^" G EXIT
I Y="",'$D(RMPR1APN) G EXIT
I Y>0 S ANS=Y G QUE
;RMPR1APN is set in the entry action to menu RMPR PRINT 2319
;and killed in the exit action. We do not want to prompt
;patient name while creating records, only in display
;options
;prompt to select a new patient
I Y="",$D(RMPR1APN) S RMPR2APN=RMPRDFN D GETPAT^RMPV0RMPRUTIL
I '$D(RMPRDFN) S RMPRDFN=RMPR2APN G EXIT
I $D(RMPR2APN) K RMPR2APN D ASK1
Q
ASK2 ;ASK TO CONTINUE AFTER SCREEN DISPLAY
G ASK1
HELP D WRITECTL^RMPVIO("!"),WRITE^RMPVIO("You may only enter screen 1-8,`^`, or `return`") G ASK2
Q
STAR ;DISPLAY ADDRESS INFO
Q:$G(DFN)'>0
S RMPRBACK=1
I '$D(VADM(1))!('$D(VAOA(8))!('$D(VAPA(8))!('$D(VAEL(7))))) N VAHOW D DEM^VADPT,ADD^VADPT,OAD^VADPT
D:$E(IOST)["C" WRITEIND^RMPVIO("@IOF")
D WRITECTL^RMPVIO("!"),WRITE^RMPVIO($E(RMPRNAM,1,20)),WRITECTL^RMPVIO("?23"),WRITE^RMPVIO("SSN: "),WRITE^RMPVIO($P(VADM(2),U,2)),WRITECTL^RMPVIO("?42")
D WRITE^RMPVIO("DOB: "),WRITE^RMPVIO($P(VADM(3),U,2)),WRITECTL^RMPVIO("?61"),WRITE^RMPVIO("CLAIM# "),WRITE^RMPVIO(VAEL(7)) ;RMPRCNUM
STARD D WRITECTL^RMPVIO("!!"),WRITE^RMPVIO("Phone: "),WRITE^RMPVIO(VAPA(8)),WRITECTL^RMPVIO("?40"),WRITE^RMPVIO("Phone: "),WRITE^RMPVIO(VAOA(8))
D WRITECTL^RMPVIO("!"),WRITE^RMPVIO("Current Address:"),WRITECTL^RMPVIO("?40"),WRITE^RMPVIO("Primary Next of Kin Address:")
D WRITECTL^RMPVIO("!"),WRITE^RMPVIO(VAPA(1)),WRITECTL^RMPVIO("?40"),WRITE^RMPVIO(VAOA(1))
; lines truncated
I VAPA(2)=""&(VAPA(3)="") D:VAPA(4)'="" WRITECTL^RMPVIO("!"),WRITE^RMPVIO(VAPA(4)_", "_$P(VAPA(5),U,2)_" "_VAPA(6)) D
. D:VAOA(4)'="" WRITECTL^RMPVIO("?40"),WRITE^RMPVIO(VAOA(4)_", "_$P(VAOA(5),U,2)_" "_VAOA(6)) D:VAOA(10)'="" WRITECTL^RMPVIO("!"),WRITECTL^RMPVIO("?40"),WRITE^RMPVIO("Relationship: "),WRITE^RMPVIO(VAOA(10)) G END
I VAPA(2)'=""&(VAPA(3)="") D WRITECTL^RMPVIO("!"),WRITE^RMPVIO(VAPA(2)) D:VAOA(4)'="" WRITECTL^RMPVIO("?40"),WRITE^RMPVIO(VAOA(4)_", "_$P(VAOA(5),U,2)_" "_VAOA(6)) D
. D:VAPA(4)'="" WRITECTL^RMPVIO("!"),WRITE^RMPVIO(VAPA(4)_", "_$P(VAPA(5),U,2)_" "_VAPA(6)) D:VAOA(10)'="" WRITECTL^RMPVIO("?40"),WRITE^RMPVIO("Relationship: "),WRITE^RMPVIO(VAOA(10)) G END
I VAPA(2)'=""&(VAPA(3))'="" D WRITECTL^RMPVIO("!"),WRITE^RMPVIO(VAPA(2)) D:VAOA(4)'="" WRITECTL^RMPVIO("?40"),WRITE^RMPVIO(VAOA(4)_", "),WRITE^RMPVIO($P(VAOA(5),U,2)_" "_VAOA(6)),WRITECTL^RMPVIO("!"),WRITE^RMPVIO(VAPA(3)) D
. D:VAOA(10)'="" WRITECTL^RMPVIO("?40"),WRITE^RMPVIO("Relationship: "),WRITE^RMPVIO(VAOA(10))
; end truncation
I D:VAPA(4)'="" WRITECTL^RMPVIO("!"),WRITE^RMPVIO(VAPA(4)_", "_$P(VAPA(5),U,2)_" "_VAPA(6))
END D ELIG^VADPT
D WRITECTL^RMPVIO("!!"),WRITE^RMPVIO("Patient Type: "),WRITE^RMPVIO($P(VAEL(6),U,2)),WRITECTL^RMPVIO("?40")
D WRITE^RMPVIO("Period of Service: "),WRITE^RMPVIO($P(VAEL(2),U,2))
D WRITECTL^RMPVIO("!"),WRITE^RMPVIO("Primary Eligibility Code:"),WRITECTL^RMPVIO("?40")
D WRITE^RMPVIO("Status: "),WRITE^RMPVIO($P(VAEL(9),U,2)),WRITECTL^RMPVIO("!"),WRITE^RMPVIO($P(VAEL(1),U,2))
D WRITECTL^RMPVIO("?40"),WRITE^RMPVIO("Eligibility Status: "),WRITE^RMPVIO($E($P(VAEL(8),U,2),1,19))
D MB^VADPT
D WRITECTL^RMPVIO("!!"),WRITE^RMPVIO("Receiving A&A Benefits? ")
D:VAMB(1)=0 WRITE^RMPVIO("NO") D:$P(VAMB(1),U,1)=1 WRITE^RMPVIO($P(VAMB(1),U,2))
D WRITECTL^RMPVIO("?40"),WRITE^RMPVIO("Receiving Housebound Benefits? ")
D:VAMB(2)=0 WRITE^RMPVIO("NO") D:$P(VAMB(2),U,1)=1 WRITE^RMPVIO($P(VAMB(2),U,2))
D WRITECTL^RMPVIO("!"),WRITE^RMPVIO("Receiving Social Security? ")
D:VAMB(3)=0 WRITE^RMPVIO("NO") D:$P(VAMB(3),U,1)=1 WRITE^RMPVIO($P(VAMB(3),U,2))
D WRITECTL^RMPVIO("?40"),WRITE^RMPVIO("Receiving VA Pension? ") D:VAMB(4)=0 WRITE^RMPVIO("NO")
D:$P(VAMB(4),U,1)=1 WRITE^RMPVIO($P(VAMB(4),U,2))
D WRITECTL^RMPVIO("!"),WRITE^RMPVIO("Receiving Military Retirement? ")
D:VAMB(5)=0 WRITE^RMPVIO("NO") D:$P(VAMB(5),U,1)=1 WRITE^RMPVIO($P(VAMB(5),U,2))
D WRITECTL^RMPVIO("?40"),WRITE^RMPVIO("Receiving VA Disability? ") D:VAMB(7)=0 WRITE^RMPVIO("NO")
D:$P(VAMB(7),U,1)=1 WRITE^RMPVIO($P(VAMB(7),U,2))
S (RO,FG)=0 I '$D(^RMPR(665,RMPRDFN,1)) D WRITECTL^RMPVIO("!"),WRITE^RMPVIO("No Prosthetic Disability Codes entered for this Patient.") S RO=1
; line truncated
I RO=0 F D:'FG WRITECTL^RMPVIO("!"),WRITE^RMPVIO("Prosthetic Disability Code(s):") S RO=$O(^RMPR(665,RMPRDFN,1,RO)) Q:RO'>0 S RR=^(RO,0) S:$P(RR,U,10) FG=1 D
. I '$P(RR,U,10) D WRITE^RMPVIO(" "),WRITE^RMPVIO($P(^RMPR(662,+RR,0),U,1)),WRITE^RMPVIO("-"),WRITE^RMPVIO($S($P(RR,U,3)=1:"SC",$P(RR,U,3)=2:"NSC",1:"")) S FG=1
; end truncation
I $P($G(^DPT(DFN,.372,0)),U,4)>IOSL-2-$Y D QUEST2 G:$G(RMNOQUIT)=0 ASK1
; line truncated
S RO=0 F I=0:0 S RO=$O(^DPT(DFN,.372,RO)) Q:RO'>0!$D(RMPREND1) I +$P(^(RO,0),U,1),$D(^DIC(31,+$P(^(0),U,1))) D
. D:'$D(RMPRL) WRITECTL^RMPVIO("!"),WRITE^RMPVIO("Patient Name: "),WRITE^RMPVIO(VADM(1)),WRITECTL^RMPVIO("?40"),WRITE^RMPVIO("SSN: "),WRITE^RMPVIO($P(VADM(2),U,2)),WRITECTL^RMPVIO("!!"),WRITE^RMPVIO("MAS Disability Code(s):") D WRI
; end truncation
K RMNOQUIT G:$D(RMPREND1) ASK1
D SVC^VADPT D WRITECTL^RMPVIO("!!"),WRITE^RMPVIO("*POW? "),WRITE^RMPVIO($S(VASV(4)=1:"YES",1:"NO"))
G:$D(RMPRBACK) QUES
D WRITEIND^RMPVIO("@IOF") G ASK1
WRI I $Y>(IOSL-6),'$D(RMPRQUES) D QUEST1 Q:$D(RMPREND1) ;patch *162, replace GOTO with Quit when within FOR loop
; line truncated
D WRITECTL^RMPVIO("!"),WRITE^RMPVIO($E($P(^DIC(31,$P(^DPT(DFN,.372,RO,0),U,1),0),U,1),1,30)),WRITECTL^RMPVIO("?40")
D WRITE^RMPVIO("Disability% "),WRITE^RMPVIO($P(^DPT(DFN,.372,RO,0),U,2)),WRITECTL^RMPVIO("?56"),WRITE^RMPVIO(" Service Connected? ")
D:$P(^DPT(DFN,.372,RO,0),U,3)=1 WRITE^RMPVIO("YES") D:$P(^DPT(DFN,.372,RO,0),U,3)=0 WRITE^RMPVIO("NO") S RMPRL=1 Q
; end truncation
QUES ;ASK WHAT PAGE OF A PATIENT'S 10-2319
K RMPRFLG,RMPRL F I=0:0 Q:$Y>21 D WRITECTL^RMPVIO("!")
QUES1 D READCTL^RMPVIO("!"),READPMT^RMPVIO("Enter return to continue or `^` to exit: "),READ^RMPVIO(.ANS)
G:'$T EXIT
I ANS="" G ASK1
I $G(ANS)="" G EXIT
I "^"[ANS G ASK1
E D WRITE^RMPVIO($C(7)),WRITECTL^RMPVIO("!"),WRITE^RMPVIO("You must enter an `^` to exit!") G QUES1
QUE D:ANS=5 WRITEIND^RMPVIO("@IOF")
G EXIT:"^"[ANS,STAR^RMPRPAT:ANS=1,^RMPRPAT0:ANS=2,^RMPRPAT1:ANS=3
I ANS=4 G ^RMPRPAT2
I ANS=8 G 2319^RMPOBIL2
G DU^RMPRAINQ:ANS=5
G ^RMPRPAT5:ANS=6
I ANS=7 S RMPRDIR7=1 G EN^RMPV0RMPRDIS
D WRITECTL^RMPVIO("!!"),WRITE^RMPVIO($C(7)) G QUES
Q
EXIT ;EXIT FOR DISPLAY OF A PATIENT'S 10-2319
;must always exit through this point
I '$D(^RMPR(665,RMPRDFN,1,0)) D DIS^RMPV0RMPRPAT5
I $D(^RMPR(665,RMPRDFN,1,0)),'$O(^(0)) D DIS^RMPV0RMPRPAT5
I $D(^RMPR(665,RMPRDFN,1,0)),$O(^(0)) K RMPRKILL
D NPC^RMPRPAT5
K RMPRCOMB,Y,DIE,DIC,RMPRCCO,DIR,VASV,VAMB,VAEL,VADM,VAPA,FG,VAOA,TYPE,RMPROBL,RC,AMIS,CST,DATE,DEL,RFLG,QTY,REM,SN,STA,RR,RO,I,J,RMPRCNUM,RMPRFG,TRANS,TRANS1,RK,FLG,RA,RI,RT,RTCH,LC,MC,RMPRDT,RMPRJOB,RMPRWO
K RMPR2APN,RMPRQ,RR5,R5,DFN,FL,PAGE,AN,FRM,VEN,RZ,%X,%Y,VA,VAERR,TLC,TMC,R660,RCK,RJ,RDA,RL,RTC,RTCD,RTHD,RTR,RW,RWP,RMPRQUES,RMPREND1 D KVAR^VADPT
K:'$D(RMPRF)!($G(RMPRBACK)<1) RMPRDOB,RMPRDFN,RMPRNAM,RMPRSSN,RMPRBACK
Q
QUEST1 S RMPRQUES=1
N DIR S DIR(0)="E" D WRITECTL^RMPVIO("!!") D %DIR^RMPVFM D WRITEIND^RMPVIO("@IOF")
I $D(DTOUT)!($D(DUOUT)) S RMPREND1=1 Q ;patch *162, set quit flag if user chooses to exit option
D WRITECTL^RMPVIO("!") Q
QUEST2 ;PUT MAS DISABILITY CODES ON NEXT PAGE IF THEY WILL NOT ALL FIT ON THIS
;PAGE
N DIR S DIR(0)="E" D WRITECTL^RMPVIO("!!") D %DIR^RMPVFM D WRITEIND^RMPVIO("@IOF") S RMNOQUIT=1
I $D(DTOUT)!($D(DUOUT)) S RMNOQUIT=0
D WRITEIND^RMPVIO("@IOF")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPV0RMPRPAT 9789 printed May 25, 2026@12:50:53 Page 2
RMPV0RMPRPAT ; OIT/JDA - Adapted from RMPRPAT; Dec 01, 2024@21:44:41
+1 ;;1.0;PROSTHETICS VISION 4 SIGHT II;**2**;Jan 31, 2025;Build 38
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; Reference to file #665 supported by ICR #6537
+5 ; Reference to file #2 (^DPT) supported by ICR #7019
+6 ; Reference to RMPRPAT0 supported by ICR #7557
+7 ; Reference to RMPRPAT1 supported by ICR #7558
+8 ; Reference to RMPRPAT2 supported by ICR #7563
+9 ; Reference to 2319^RMPOBIL2 supported by ICR #7560
+10 ; Reference to STAR^RMPRPAT supported by ICR #7561
+11 ; Reference to DISP^RMPRPAT5 supported by ICR #7567
+12 ; Reference to NPC^RMPRPAT5 supported by ICR #7567
+13 ;
RMPRPAT ;PHX/RFM/JLT-DISPLAY 2319 FIRST PAGE ;8/29/1994
+1 ;;3.0;PROSTHETICS;**29,62,162**;Feb 09, 1996;Build 5
+2 ;
+3 ; RVD - patch # 62 - sets RMPRNAM, RMPRSSN,RMPRDOB and RMPRSSNE
+4 ;
ASK ;Set common variables
+1 if $GET(RMPRDFN)<1
QUIT
+2 ;PATCH *162 => insure activity screen displays first time (RMPRFRST) in and Home Oxygen activity is NOT included (RCNT=7) for inside issue option
+3 NEW RCNT
+4 DO HOMEZIS^RMPVRT
SET DFN=RMPRDFN
SET RMPRBACK=1
SET RMPRFRST=1
SET RCNT=7
IF $GET(RSTCK)'=1
SET RCNT=8
SET RFLG=1
+5 DO ADD^VADPT
DO OAD^VADPT
DO DEM^VADPT
DO ELIG^VADPT
+6 ;next 2 lines added by patch #62
+7 SET RMPRNAM=$PIECE(VADM(1),U)
SET RMPRSSN=$PIECE(VADM(2),U)
+8 SET RMPRDOB=$PIECE(VADM(3),U)
SET RMPRSSNE=VA("PID")
+9 DO WRITEIND^RMPVIO("@IOF")
+10 SET %X="^RMPR(665,"_RMPRDFN_","
SET %Y="R5("
DO %XY^%RCR
SET RMPRCNUM=VAEL(7)
ASK1 ;CALL ROUTINE TO DISPLAY SCREEN SELECTI0N
+1 if $GET(RMPRDFN)'>0
QUIT
SET DFN=RMPRDFN
+2 IF '$DATA(VAEL(7))
DO ELIG^VADPT
+3 IF '$DATA(VAPA(1))
DO ADD^VADPT
+4 IF '$DATA(VADM(1))
DO DEM^VADPT
+5 IF '$DATA(VAOA(1))
DO OAD^VADPT
+6 IF $DATA(^RMPR(665,RMPRDFN,8,0))
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO("*Comments on file")
+7 IF '$DATA(^RMPR(665,RMPRDFN,1,0))
DO WRITE^RMPVIO($CHAR(7))
DO WRITECTL^RMPVIO("!!")
DO WRITE^RMPVIO("*No Disability Code on File!")
+8 IF $DATA(^RMPR(665,RMPRDFN,1,0))
IF '$ORDER(^(0))
DO WRITE^RMPVIO($CHAR(7))
DO WRITECTL^RMPVIO("!!")
DO WRITE^RMPVIO("*No Disability Code on File!")
+9 DO DISP^RMPRPAT5
KILL ANS
DO WRITECTL^RMPVIO("!")
+10 KILL RMPRQ,RMPRQUES,DIR,RMPREND1,RMPRL
+11 ;insure activity list appears upon entry
DO ASK1^RMPRPAT1
KILL ANS
IF $GET(RMPRFRST)=1
IF $GET(RSTCK)
DO HELP^RMPRPAT1
+12 DO %DIR^RMPVFM
+13 KILL DIR,RMPRFRST
+14 IF Y["^"
GOTO EXIT
+15 IF Y=""
IF '$DATA(RMPR1APN)
GOTO EXIT
+16 IF Y>0
SET ANS=Y
GOTO QUE
+17 ;RMPR1APN is set in the entry action to menu RMPR PRINT 2319
+18 ;and killed in the exit action. We do not want to prompt
+19 ;patient name while creating records, only in display
+20 ;options
+21 ;prompt to select a new patient
+22 IF Y=""
IF $DATA(RMPR1APN)
SET RMPR2APN=RMPRDFN
DO GETPAT^RMPV0RMPRUTIL
+23 IF '$DATA(RMPRDFN)
SET RMPRDFN=RMPR2APN
GOTO EXIT
+24 IF $DATA(RMPR2APN)
KILL RMPR2APN
DO ASK1
+25 QUIT
ASK2 ;ASK TO CONTINUE AFTER SCREEN DISPLAY
+1 GOTO ASK1
HELP DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO("You may only enter screen 1-8,`^`, or `return`")
GOTO ASK2
+1 QUIT
STAR ;DISPLAY ADDRESS INFO
+1 if $GET(DFN)'>0
QUIT
+2 SET RMPRBACK=1
+3 IF '$DATA(VADM(1))!('$DATA(VAOA(8))!('$DATA(VAPA(8))!('$DATA(VAEL(7)))))
NEW VAHOW
DO DEM^VADPT
DO ADD^VADPT
DO OAD^VADPT
+4 if $EXTRACT(IOST)["C"
DO WRITEIND^RMPVIO("@IOF")
+5 DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO($EXTRACT(RMPRNAM,1,20))
DO WRITECTL^RMPVIO("?23")
DO WRITE^RMPVIO("SSN: ")
DO WRITE^RMPVIO($PIECE(VADM(2),U,2))
DO WRITECTL^RMPVIO("?42")
+6 ;RMPRCNUM
DO WRITE^RMPVIO("DOB: ")
DO WRITE^RMPVIO($PIECE(VADM(3),U,2))
DO WRITECTL^RMPVIO("?61")
DO WRITE^RMPVIO("CLAIM# ")
DO WRITE^RMPVIO(VAEL(7))
STARD DO WRITECTL^RMPVIO("!!")
DO WRITE^RMPVIO("Phone: ")
DO WRITE^RMPVIO(VAPA(8))
DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO("Phone: ")
DO WRITE^RMPVIO(VAOA(8))
+1 DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO("Current Address:")
DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO("Primary Next of Kin Address:")
+2 DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO(VAPA(1))
DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO(VAOA(1))
+3 ; lines truncated
+4 IF VAPA(2)=""&(VAPA(3)="")
if VAPA(4)'=""
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO(VAPA(4)_", "_$PIECE(VAPA(5),U,2)_" "_VAPA(6))
Begin DoDot:1
+5 if VAOA(4)'=""
DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO(VAOA(4)_", "_$PIECE(VAOA(5),U,2)_" "_VAOA(6))
if VAOA(10)'=""
DO WRITECTL^RMPVIO("!")
DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO("Relationship: ")
DO WRITE^RMPVIO(VAOA(10))
GOTO END
End DoDot:1
+6 IF VAPA(2)'=""&(VAPA(3)="")
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO(VAPA(2))
if VAOA(4)'=""
DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO(VAOA(4)_", "_$PIECE(VAOA(5),U,2)_" "_VAOA(6))
Begin DoDot:1
+7 if VAPA(4)'=""
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO(VAPA(4)_", "_$PIECE(VAPA(5),U,2)_" "_VAPA(6))
if VAOA(10)'=""
DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO("Relationship: ")
DO WRITE^RMPVIO(VAOA(10))
GOTO END
End DoDot:1
+8 IF VAPA(2)'=""&(VAPA(3))'=""
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO(VAPA(2))
if VAOA(4)'=""
DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO(VAOA(4)_", ")
DO WRITE^RMPVIO($PIECE(VAOA(5),U,2)_" "_VAOA(6))
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO(VAPA(3))
Begin DoDot:1
+9 if VAOA(10)'=""
DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO("Relationship: ")
DO WRITE^RMPVIO(VAOA(10))
End DoDot:1
+10 ; end truncation
+11 IF $TEST
if VAPA(4)'=""
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO(VAPA(4)_", "_$PIECE(VAPA(5),U,2)_" "_VAPA(6))
END DO ELIG^VADPT
+1 DO WRITECTL^RMPVIO("!!")
DO WRITE^RMPVIO("Patient Type: ")
DO WRITE^RMPVIO($PIECE(VAEL(6),U,2))
DO WRITECTL^RMPVIO("?40")
+2 DO WRITE^RMPVIO("Period of Service: ")
DO WRITE^RMPVIO($PIECE(VAEL(2),U,2))
+3 DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO("Primary Eligibility Code:")
DO WRITECTL^RMPVIO("?40")
+4 DO WRITE^RMPVIO("Status: ")
DO WRITE^RMPVIO($PIECE(VAEL(9),U,2))
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO($PIECE(VAEL(1),U,2))
+5 DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO("Eligibility Status: ")
DO WRITE^RMPVIO($EXTRACT($PIECE(VAEL(8),U,2),1,19))
+6 DO MB^VADPT
+7 DO WRITECTL^RMPVIO("!!")
DO WRITE^RMPVIO("Receiving A&A Benefits? ")
+8 if VAMB(1)=0
DO WRITE^RMPVIO("NO")
if $PIECE(VAMB(1),U,1)=1
DO WRITE^RMPVIO($PIECE(VAMB(1),U,2))
+9 DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO("Receiving Housebound Benefits? ")
+10 if VAMB(2)=0
DO WRITE^RMPVIO("NO")
if $PIECE(VAMB(2),U,1)=1
DO WRITE^RMPVIO($PIECE(VAMB(2),U,2))
+11 DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO("Receiving Social Security? ")
+12 if VAMB(3)=0
DO WRITE^RMPVIO("NO")
if $PIECE(VAMB(3),U,1)=1
DO WRITE^RMPVIO($PIECE(VAMB(3),U,2))
+13 DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO("Receiving VA Pension? ")
if VAMB(4)=0
DO WRITE^RMPVIO("NO")
+14 if $PIECE(VAMB(4),U,1)=1
DO WRITE^RMPVIO($PIECE(VAMB(4),U,2))
+15 DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO("Receiving Military Retirement? ")
+16 if VAMB(5)=0
DO WRITE^RMPVIO("NO")
if $PIECE(VAMB(5),U,1)=1
DO WRITE^RMPVIO($PIECE(VAMB(5),U,2))
+17 DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO("Receiving VA Disability? ")
if VAMB(7)=0
DO WRITE^RMPVIO("NO")
+18 if $PIECE(VAMB(7),U,1)=1
DO WRITE^RMPVIO($PIECE(VAMB(7),U,2))
+19 SET (RO,FG)=0
IF '$DATA(^RMPR(665,RMPRDFN,1))
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO("No Prosthetic Disability Codes entered for this Patient.")
SET RO=1
+20 ; line truncated
+21 IF RO=0
FOR
if 'FG
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO("Prosthetic Disability Code(s):")
SET RO=$ORDER(^RMPR(665,RMPRDFN,1,RO))
if RO'>0
QUIT
SET RR=^(RO,0)
if $PIECE(RR,U,10)
SET FG=1
Begin DoDot:1
+22 IF '$PIECE(RR,U,10)
DO WRITE^RMPVIO(" ")
DO WRITE^RMPVIO($PIECE(^RMPR(662,+RR,0),U,1))
DO WRITE^RMPVIO("-")
DO WRITE^RMPVIO($SELECT($PIECE(RR,U,3)=1:"SC",$PIECE(RR,U,3)=2:"NSC",1:""))
SET FG=1
End DoDot:1
+23 ; end truncation
+24 IF $PIECE($GET(^DPT(DFN,.372,0)),U,4)>IOSL-2-$Y
DO QUEST2
if $GET(RMNOQUIT)=0
GOTO ASK1
+25 ; line truncated
+26 SET RO=0
FOR I=0:0
SET RO=$ORDER(^DPT(DFN,.372,RO))
if RO'>0!$DATA(RMPREND1)
QUIT
IF +$PIECE(^(RO,0),U,1)
IF $DATA(^DIC(31,+$PIECE(^(0),U,1)))
Begin DoDot:1
+27 if '$DATA(RMPRL)
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO("Patient Name: ")
DO WRITE^RMPVIO(VADM(1))
DO WRITECTL^RMPVIO("?40")
DO WRITE^RMPVIO("SSN: ")
DO WRITE^RMPVIO($PIECE(VADM(2),U,2))
DO WRITECTL^RMPVIO("!!")
DO WRITE^RMPVIO("MAS Disability Code(s):")
DO WRI
End DoDot:1
+28 ; end truncation
+29 KILL RMNOQUIT
if $DATA(RMPREND1)
GOTO ASK1
+30 DO SVC^VADPT
DO WRITECTL^RMPVIO("!!")
DO WRITE^RMPVIO("*POW? ")
DO WRITE^RMPVIO($SELECT(VASV(4)=1:"YES",1:"NO"))
+31 if $DATA(RMPRBACK)
GOTO QUES
+32 DO WRITEIND^RMPVIO("@IOF")
GOTO ASK1
WRI ;patch *162, replace GOTO with Quit when within FOR loop
IF $Y>(IOSL-6)
IF '$DATA(RMPRQUES)
DO QUEST1
if $DATA(RMPREND1)
QUIT
+1 ; line truncated
+2 DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO($EXTRACT($PIECE(^DIC(31,$PIECE(^DPT(DFN,.372,RO,0),U,1),0),U,1),1,30))
DO WRITECTL^RMPVIO("?40")
+3 DO WRITE^RMPVIO("Disability% ")
DO WRITE^RMPVIO($PIECE(^DPT(DFN,.372,RO,0),U,2))
DO WRITECTL^RMPVIO("?56")
DO WRITE^RMPVIO(" Service Connected? ")
+4 if $PIECE(^DPT(DFN,.372,RO,0),U,3)=1
DO WRITE^RMPVIO("YES")
if $PIECE(^DPT(DFN,.372,RO,0),U,3)=0
DO WRITE^RMPVIO("NO")
SET RMPRL=1
QUIT
+5 ; end truncation
QUES ;ASK WHAT PAGE OF A PATIENT'S 10-2319
+1 KILL RMPRFLG,RMPRL
FOR I=0:0
if $Y>21
QUIT
DO WRITECTL^RMPVIO("!")
QUES1 DO READCTL^RMPVIO("!")
DO READPMT^RMPVIO("Enter return to continue or `^` to exit: ")
DO READ^RMPVIO(.ANS)
+1 if '$TEST
GOTO EXIT
+2 IF ANS=""
GOTO ASK1
+3 IF $GET(ANS)=""
GOTO EXIT
+4 IF "^"[ANS
GOTO ASK1
+5 IF '$TEST
DO WRITE^RMPVIO($CHAR(7))
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO("You must enter an `^` to exit!")
GOTO QUES1
QUE if ANS=5
DO WRITEIND^RMPVIO("@IOF")
+1 if "^"[ANS
GOTO EXIT
if ANS=1
GOTO STAR^RMPRPAT
if ANS=2
GOTO ^RMPRPAT0
if ANS=3
GOTO ^RMPRPAT1
+2 IF ANS=4
GOTO ^RMPRPAT2
+3 IF ANS=8
GOTO 2319^RMPOBIL2
+4 if ANS=5
GOTO DU^RMPRAINQ
+5 if ANS=6
GOTO ^RMPRPAT5
+6 IF ANS=7
SET RMPRDIR7=1
GOTO EN^RMPV0RMPRDIS
+7 DO WRITECTL^RMPVIO("!!")
DO WRITE^RMPVIO($CHAR(7))
GOTO QUES
+8 QUIT
EXIT ;EXIT FOR DISPLAY OF A PATIENT'S 10-2319
+1 ;must always exit through this point
+2 IF '$DATA(^RMPR(665,RMPRDFN,1,0))
DO DIS^RMPV0RMPRPAT5
+3 IF $DATA(^RMPR(665,RMPRDFN,1,0))
IF '$ORDER(^(0))
DO DIS^RMPV0RMPRPAT5
+4 IF $DATA(^RMPR(665,RMPRDFN,1,0))
IF $ORDER(^(0))
KILL RMPRKILL
+5 DO NPC^RMPRPAT5
+6 KILL RMPRCOMB,Y,DIE,DIC,RMPRCCO,DIR,VASV,VAMB,VAEL,VADM,VAPA,FG,VAOA,TYPE,RMPROBL,RC,AMIS,CST,DATE,DEL,RFLG,QTY,REM,SN,STA,RR,RO,I,J,RMPRCNUM,RMPRFG,TRANS,TRANS1,RK,FLG,RA,RI,RT,RTCH,LC,MC,RMPRDT,RMPRJOB,RMPRWO
+7 KILL RMPR2APN,RMPRQ,RR5,R5,DFN,FL,PAGE,AN,FRM,VEN,RZ,%X,%Y,VA,VAERR,TLC,TMC,R660,RCK,RJ,RDA,RL,RTC,RTCD,RTHD,RTR,RW,RWP,RMPRQUES,RMPREND1
DO KVAR^VADPT
+8 if '$DATA(RMPRF)!($GET(RMPRBACK)<1)
KILL RMPRDOB,RMPRDFN,RMPRNAM,RMPRSSN,RMPRBACK
+9 QUIT
QUEST1 SET RMPRQUES=1
+1 NEW DIR
SET DIR(0)="E"
DO WRITECTL^RMPVIO("!!")
DO %DIR^RMPVFM
DO WRITEIND^RMPVIO("@IOF")
+2 ;patch *162, set quit flag if user chooses to exit option
IF $DATA(DTOUT)!($DATA(DUOUT))
SET RMPREND1=1
QUIT
+3 DO WRITECTL^RMPVIO("!")
QUIT
QUEST2 ;PUT MAS DISABILITY CODES ON NEXT PAGE IF THEY WILL NOT ALL FIT ON THIS
+1 ;PAGE
+2 NEW DIR
SET DIR(0)="E"
DO WRITECTL^RMPVIO("!!")
DO %DIR^RMPVFM
DO WRITEIND^RMPVIO("@IOF")
SET RMNOQUIT=1
+3 IF $DATA(DTOUT)!($DATA(DUOUT))
SET RMNOQUIT=0
+4 DO WRITEIND^RMPVIO("@IOF")
+5 QUIT
