RMPV0RMPRDIS ; OIT/JDA - Adapted from RMPRDIS; 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
;
RMPRDIS ;PHX/JLT-DISPLAY/EDIT DISABILITY CODES
;;3.0;PROSTHETICS;;Feb 09, 1996
D GETPAT^RMPV0RMPRUTIL Q:'$D(RMPRDFN)
EN ;ADD DISABILITY CODE, CALLED FROM RMPRAP
N DIC,DIR
I $D(RMPRDIR7) S DIR(0)="Y",DIR("A")="Would you like to ADD/EDIT a Disability Code to the Patient's 2319",DIR("B")="YES",DIR("?")="Enter 'Y' to Edit a Disability Code, 'N' or '^' to continue."
I D %DIR^RMPVFM G:$D(DIRUT)!($D(DUOUT)) END G:+Y=0 DEA
I $G(RMPRDA) S DFN=$P($G(^RMPR(660.5,RMPRDA,0)),U,2) I +DFN,'$D(^RMPR(665,+DFN)) S ^RMPR(665,DFN,0)=DFN_U_RMPR("STA") S DA=DFN,DIK="^RMPR(665," D IX1^DIK
I '$D(^RMPR(665,RMPRDFN,1)) S ^RMPR(665,RMPRDFN,1,0)="^665.01PI^0^0"
D:'$D(RMPRBACK) LP L +^RMPR(665,RMPRDFN,1):1 I $T=0 D WRITECTL^RMPVIO("!"),WRITE^RMPVIO($C(7)),WRITECTL^RMPVIO("?5"),WRITE^RMPVIO("Someone else is Editing this entry") G END
AMP D WRITECTL^RMPVIO("!") S DA(1)=RMPRDFN,DIC="^RMPR(665,"_DA(1)_",1,",DIC(0)="AEQMZL",DLAYGO=665,DIC("W")="S RA=^(0) D DSP^RMPRDIS" D %DIC^RMPVFM K DLAYGO G:+Y'>0 DEND S RMPRY=Y,RMPRX=$P(Y,U,2)
I $P(^RMPR(665,RMPRDFN,1,+Y,0),U,10) S DIR(0)="Y",DIR("A",1)="DISABILITY CODE HAS BEEN MARKED AS DELETED.",DIR("A")="WOULD YOU LIKE TO RE-ACTIVATED THIS CODE",DIR("B")="NO",DIR("?")="Enter 'Y' to re-activate code."
I D %DIR^RMPVFM G:$D(DIRUT)!($D(DUOUT)) DEND K DIR I +Y=1 S DA=+RMPRY,DIE=DIC,DR="10///@" D %DIE^RMPVFM
S RC=0 F RI=0:0 S RI=$O(^RMPR(665,RMPRDFN,1,"B",RMPRX,RI)) Q:RI'>0 S RC=RC+1
I RC'>1 K DIRUT D DIR G:$D(DIRUT) AMP
EDIT K DIR S DIE="^RMPR(665,RMPRDFN,1,",DA(1)=RMPRDFN,DA=+RMPRY D SDR
D %DIE^RMPVFM I $D(DA),$P(^RMPR(665,DA(1),1,DA,0),U,4)'=4 S $P(^(0),U,5)=""
I $D(DA) I '$P(^RMPR(665,RMPRDFN,1,DA,0),U,3)!'$P(^(0),U,4) S DA(1)=RMPRDFN,DIK="^RMPR(665,RMPRDFN,1,",DA(1)=RMPRDFN D ^DIK D WRITECTL^RMPVIO("!"),WRITECTL^RMPVIO("?5"),WRITE^RMPVIO($C(7)),WRITE^RMPVIO("Deleted...")
G AMP
DEND L -^RMPR(665,RMPRDFN,1) K RMPRX,RMPRY,RT,RI,RA,RMPRT,RCC
I '$D(RMPRBACK) K DIC,Y,RMPRD,DIE,DR Q
DEA ;DEACTIVATE PATIENT PROSTHETICS DISABILITY CODES
;I $G(RMPRDFN)'>0 Q
Q:$D(RMPRDIR3) I '$D(RMPRBACK) K RMPRDFN D GETPAT^RMPV0RMPRUTIL G:'$D(RMPRDFN) END
Q:$G(RMPRDFN)'>0
I '$D(^RMPR(665,RMPRDFN,1))!($O(^RMPR(665,RMPRDFN,1,0))'>0) D WRITECTL^RMPVIO("!!"),WRITE^RMPVIO("Patient has no Prosthetics Disability codes"),WRITE^RMPVIO($C(7)) G END
; line truncated
D WRITECTL^RMPVIO("!"),WRITE^RMPVIO($P(^DPT(RMPRDFN,0),U,1)),WRITE^RMPVIO(" HAS THE FOLLOWING DISABILITY CODES:"),WRITECTL^RMPVIO("!")
F RI=0:0 S RI=$O(^RMPR(665,RMPRDFN,1,RI)) Q:RI'>0 S RA=^(RI,0) D WRITECTL^RMPVIO("!"),WRITECTL^RMPVIO("?5"),WRITE^RMPVIO($P(^RMPR(662,$P(RA,U,1),0),U,1)) D DSP
; end truncation
I $D(RMPRDIR7) D WRITECTL^RMPVIO("!!") S DIR(0)="Y",DIR("A")="Would you like to Mark a Disability Code as Deleted",DIR("B")="NO",DIR("?")="Enter 'Y' to Mark a Disability Code as Deleted" D %DIR^RMPVFM G:$D(DIRUT)!($D(DUOUT))!(+Y=0) END
S RA=0 F RI=0:1 S RA=$O(^RMPR(665,RMPRDFN,1,RA)) Q:RA'>0
I RI'>1 G SEL
K DIR D WRITECTL^RMPVIO("!!") S DIR(0)="Y"
S DIR("A")="Would you like to Mark all of the Patient's Disability Codes as Deleted",DIR("B")="NO",DIR("?")="Enter 'Y' to Mark all of the Patients Disability Codes as Deleted, 'N' to select a Disability Code."
D %DIR^RMPVFM G:$D(DIRUT)!($D(DUOUT)) END I +Y=0 G SEL
L +^RMPR(665,RMPRDFN,1):1 I $T=0 D WRITECTL^RMPVIO("!"),WRITE^RMPVIO($C(7)),WRITECTL^RMPVIO("?5"),WRITE^RMPVIO("Someone else is Editing this entry!") G END
F RI=0:0 S RI=$O(^RMPR(665,RMPRDFN,1,RI)) Q:RI'>0 I $D(^(RI,0)) S DA=RI,DIE="^RMPR(665,"_RMPRDFN_",1,",DR="5///^S X=2;10///^S X=DT",DA(1)=RMPRDFN D %DIE^RMPVFM
L -^RMPR(665,RMPRDFN,1)
END K RMPRX,RMPRY,RA,RI,RT,RC,RMPRT I $D(RMPRDIR3) Q
I $D(RMPRDIR7) K RMPRDIR7 G ASK1^RMPV0RMPRPAT
Q:$D(RMPRBACK) K RMPRDFN,RMPRSSN,RMPRNAM,RMPRDOB,RMPRD,DIE,DIR,DR,DIRUT,DIC,DIK,DA Q
SEL D WRITECTL^RMPVIO("!") S DIC="^RMPR(665,"_RMPRDFN_",1,"
S DIC(0)="AEQMZ",DIC("W")="S RA=^(0) D DSP^RMPRDIS"
D %DIC^RMPVFM G:+Y'>0&('$D(RMPRBACK)) DEA G:+Y'>0 END
L +^RMPR(665,RMPRDFN,1):1 I $T=0 D WRITECTL^RMPVIO("!"),WRITE^RMPVIO($C(7)),WRITECTL^RMPVIO("?5"),WRITE^RMPVIO("Someone else is Editing this entry!") G END
S DA=+Y,DA(1)=RMPRDFN,DIE=DIC,DR="5///^S X=2;10///^S X=DT" D %DIE^RMPVFM L -^RMPR(665,RMPRDFN,1) D WRITECTL^RMPVIO("!"),WRITECTL^RMPVIO("?5"),WRITE^RMPVIO("**CODE MARKED AS DELETED**") D WRITECTL^RMPVIO("!") G SEL
LP ;DISPLAY DISABILITY CODES
K RMPRD F RI=0:0 S RI=$O(^RMPR(665,RMPRDFN,1,RI)) Q:RI'>0 I $D(^(RI,0)) S RMPRD(RI)=^(0)
; line truncated
D WRITECTL^RMPVIO("!")
I $D(RMPRD) D WRITECTL^RMPVIO("!"),WRITE^RMPVIO($P(^DPT(RMPRDFN,0),U)),WRITE^RMPVIO(" HAS THE FOLLOWING CODES:"),WRITECTL^RMPVIO("!") F RI=0:0 S RI=$O(RMPRD(RI)) Q:RI'>0 D
. S RA=RMPRD(RI) D WRITECTL^RMPVIO("!"),WRITECTL^RMPVIO("?5"),WRITE^RMPVIO($P(^RMPR(662,$P(RA,U),0),U)) D DSP
; end truncation
Q
DIR K DIR I '$P(RMPRY,U,3) S DIR(0)="S^E:EDIT DISABILITY CODE;A:ADD DUPLICATE DISABILITY CODE",DIR("B")="EDIT" D %DIR^RMPVFM Q:$D(DIRUT) I Y["A" D FILE
Q
FILE K DD,DO,D0 S DIC="^RMPR(665,"_RMPRDFN_",1,",DIC(0)="EQML",DLAYGO=665 S X=RMPRX D FILEDICN^RMPVFM K DLAYGO S DA(1)=RMPRDFN,RMPRY=+Y Q
DSP I +$P(RA,U,3) D WRITECTL^RMPVIO("?15") D WRITE^RMPVIO($S($P(RA,U,3)=1:"SC ",1:"NSC "))
I +$P(RA,U,4) S RT=$P(^DD(665.01,3,0),U,3) D WRITECTL^RMPVIO("?21"),WRITE^RMPVIO($P($P(RT,":",$P(RA,U,4)+1),";",1)_" ")
I +$P(RA,U,5) S RT=$P(^DD(665.01,4,0),U,3) D WRITECTL^RMPVIO("?41"),WRITE^RMPVIO($P($P(RT,":",$P(RA,U,5)+1),";",1))
I +$P(RA,U,10) D WRITECTL^RMPVIO("?65"),WRITE^RMPVIO("Deleted...")
Q
SDR S DR=".01;5///1;2;3;S $P(^RMPR(665,DA(1),1,DA,0),U,8)=DUZ;1///^S X=DT;10///@;I $P(^RMPR(665,DA(1),1,DA,0),U,4)'=4 S Y="""";4" Q
CHK S RDA=$P(^RMPR(665,DA(1),1,DA,0),U) D K RDA
. F RI=0:0 S RI=$O(^RMPR(665,DA(1),1,"B",RDA,RI)) Q:RI'>0 S RV=$P(^RMPR(665,DA(1),1,RI,0),U,3) I (X=RV),(DA'=RI) K X Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPV0RMPRDIS 6167 printed May 25, 2026@12:50:51 Page 2
RMPV0RMPRDIS ; OIT/JDA - Adapted from RMPRDIS; 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 ;
RMPRDIS ;PHX/JLT-DISPLAY/EDIT DISABILITY CODES
+1 ;;3.0;PROSTHETICS;;Feb 09, 1996
+2 DO GETPAT^RMPV0RMPRUTIL
if '$DATA(RMPRDFN)
QUIT
EN ;ADD DISABILITY CODE, CALLED FROM RMPRAP
+1 NEW DIC,DIR
+2 IF $DATA(RMPRDIR7)
SET DIR(0)="Y"
SET DIR("A")="Would you like to ADD/EDIT a Disability Code to the Patient's 2319"
SET DIR("B")="YES"
SET DIR("?")="Enter 'Y' to Edit a Disability Code, 'N' or '^' to continue."
+3 IF $TEST
DO %DIR^RMPVFM
if $DATA(DIRUT)!($DATA(DUOUT))
GOTO END
if +Y=0
GOTO DEA
+4 IF $GET(RMPRDA)
SET DFN=$PIECE($GET(^RMPR(660.5,RMPRDA,0)),U,2)
IF +DFN
IF '$DATA(^RMPR(665,+DFN))
SET ^RMPR(665,DFN,0)=DFN_U_RMPR("STA")
SET DA=DFN
SET DIK="^RMPR(665,"
DO IX1^DIK
+5 IF '$DATA(^RMPR(665,RMPRDFN,1))
SET ^RMPR(665,RMPRDFN,1,0)="^665.01PI^0^0"
+6 if '$DATA(RMPRBACK)
DO LP
LOCK +^RMPR(665,RMPRDFN,1):1
IF $TEST=0
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO($CHAR(7))
DO WRITECTL^RMPVIO("?5")
DO WRITE^RMPVIO("Someone else is Editing this entry")
GOTO END
AMP DO WRITECTL^RMPVIO("!")
SET DA(1)=RMPRDFN
SET DIC="^RMPR(665,"_DA(1)_",1,"
SET DIC(0)="AEQMZL"
SET DLAYGO=665
SET DIC("W")="S RA=^(0) D DSP^RMPRDIS"
DO %DIC^RMPVFM
KILL DLAYGO
if +Y'>0
GOTO DEND
SET RMPRY=Y
SET RMPRX=$PIECE(Y,U,2)
+1 IF $PIECE(^RMPR(665,RMPRDFN,1,+Y,0),U,10)
SET DIR(0)="Y"
SET DIR("A",1)="DISABILITY CODE HAS BEEN MARKED AS DELETED."
SET DIR("A")="WOULD YOU LIKE TO RE-ACTIVATED THIS CODE"
SET DIR("B")="NO"
SET DIR("?")="Enter 'Y' to re-activate code."
+2 IF $TEST
DO %DIR^RMPVFM
if $DATA(DIRUT)!($DATA(DUOUT))
GOTO DEND
KILL DIR
IF +Y=1
SET DA=+RMPRY
SET DIE=DIC
SET DR="10///@"
DO %DIE^RMPVFM
+3 SET RC=0
FOR RI=0:0
SET RI=$ORDER(^RMPR(665,RMPRDFN,1,"B",RMPRX,RI))
if RI'>0
QUIT
SET RC=RC+1
+4 IF RC'>1
KILL DIRUT
DO DIR
if $DATA(DIRUT)
GOTO AMP
EDIT KILL DIR
SET DIE="^RMPR(665,RMPRDFN,1,"
SET DA(1)=RMPRDFN
SET DA=+RMPRY
DO SDR
+1 DO %DIE^RMPVFM
IF $DATA(DA)
IF $PIECE(^RMPR(665,DA(1),1,DA,0),U,4)'=4
SET $PIECE(^(0),U,5)=""
+2 IF $DATA(DA)
IF '$PIECE(^RMPR(665,RMPRDFN,1,DA,0),U,3)!'$PIECE(^(0),U,4)
SET DA(1)=RMPRDFN
SET DIK="^RMPR(665,RMPRDFN,1,"
SET DA(1)=RMPRDFN
DO ^DIK
DO WRITECTL^RMPVIO("!")
DO WRITECTL^RMPVIO("?5")
DO WRITE^RMPVIO($CHAR(7))
DO WRITE^RMPVIO("Deleted...")
+3 GOTO AMP
DEND LOCK -^RMPR(665,RMPRDFN,1)
KILL RMPRX,RMPRY,RT,RI,RA,RMPRT,RCC
+1 IF '$DATA(RMPRBACK)
KILL DIC,Y,RMPRD,DIE,DR
QUIT
DEA ;DEACTIVATE PATIENT PROSTHETICS DISABILITY CODES
+1 ;I $G(RMPRDFN)'>0 Q
+2 if $DATA(RMPRDIR3)
QUIT
IF '$DATA(RMPRBACK)
KILL RMPRDFN
DO GETPAT^RMPV0RMPRUTIL
if '$DATA(RMPRDFN)
GOTO END
+3 if $GET(RMPRDFN)'>0
QUIT
+4 IF '$DATA(^RMPR(665,RMPRDFN,1))!($ORDER(^RMPR(665,RMPRDFN,1,0))'>0)
DO WRITECTL^RMPVIO("!!")
DO WRITE^RMPVIO("Patient has no Prosthetics Disability codes")
DO WRITE^RMPVIO($CHAR(7))
GOTO END
+5 ; line truncated
+6 DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO($PIECE(^DPT(RMPRDFN,0),U,1))
DO WRITE^RMPVIO(" HAS THE FOLLOWING DISABILITY CODES:")
DO WRITECTL^RMPVIO("!")
+7 FOR RI=0:0
SET RI=$ORDER(^RMPR(665,RMPRDFN,1,RI))
if RI'>0
QUIT
SET RA=^(RI,0)
DO WRITECTL^RMPVIO("!")
DO WRITECTL^RMPVIO("?5")
DO WRITE^RMPVIO($PIECE(^RMPR(662,$PIECE(RA,U,1),0),U,1))
DO DSP
+8 ; end truncation
+9 IF $DATA(RMPRDIR7)
DO WRITECTL^RMPVIO("!!")
SET DIR(0)="Y"
SET DIR("A")="Would you like to Mark a Disability Code as Deleted"
SET DIR("B")="NO"
SET DIR("?")="Enter 'Y' to Mark a Disability Code as Deleted"
DO %DIR^RMPVFM
if $DATA(DIRUT)!($DATA(DUOUT))!(+Y=0)
GOTO END
+10 SET RA=0
FOR RI=0:1
SET RA=$ORDER(^RMPR(665,RMPRDFN,1,RA))
if RA'>0
QUIT
+11 IF RI'>1
GOTO SEL
+12 KILL DIR
DO WRITECTL^RMPVIO("!!")
SET DIR(0)="Y"
+13 SET DIR("A")="Would you like to Mark all of the Patient's Disability Codes as Deleted"
SET DIR("B")="NO"
SET DIR("?")="Enter 'Y' to Mark all of the Patients Disability Codes as Deleted, 'N' to select a Disability Code."
+14 DO %DIR^RMPVFM
if $DATA(DIRUT)!($DATA(DUOUT))
GOTO END
IF +Y=0
GOTO SEL
+15 LOCK +^RMPR(665,RMPRDFN,1):1
IF $TEST=0
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO($CHAR(7))
DO WRITECTL^RMPVIO("?5")
DO WRITE^RMPVIO("Someone else is Editing this entry!")
GOTO END
+16 FOR RI=0:0
SET RI=$ORDER(^RMPR(665,RMPRDFN,1,RI))
if RI'>0
QUIT
IF $DATA(^(RI,0))
SET DA=RI
SET DIE="^RMPR(665,"_RMPRDFN_",1,"
SET DR="5///^S X=2;10///^S X=DT"
SET DA(1)=RMPRDFN
DO %DIE^RMPVFM
+17 LOCK -^RMPR(665,RMPRDFN,1)
END KILL RMPRX,RMPRY,RA,RI,RT,RC,RMPRT
IF $DATA(RMPRDIR3)
QUIT
+1 IF $DATA(RMPRDIR7)
KILL RMPRDIR7
GOTO ASK1^RMPV0RMPRPAT
+2 if $DATA(RMPRBACK)
QUIT
KILL RMPRDFN,RMPRSSN,RMPRNAM,RMPRDOB,RMPRD,DIE,DIR,DR,DIRUT,DIC,DIK,DA
QUIT
SEL DO WRITECTL^RMPVIO("!")
SET DIC="^RMPR(665,"_RMPRDFN_",1,"
+1 SET DIC(0)="AEQMZ"
SET DIC("W")="S RA=^(0) D DSP^RMPRDIS"
+2 DO %DIC^RMPVFM
if +Y'>0&('$DATA(RMPRBACK))
GOTO DEA
if +Y'>0
GOTO END
+3 LOCK +^RMPR(665,RMPRDFN,1):1
IF $TEST=0
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO($CHAR(7))
DO WRITECTL^RMPVIO("?5")
DO WRITE^RMPVIO("Someone else is Editing this entry!")
GOTO END
+4 SET DA=+Y
SET DA(1)=RMPRDFN
SET DIE=DIC
SET DR="5///^S X=2;10///^S X=DT"
DO %DIE^RMPVFM
LOCK -^RMPR(665,RMPRDFN,1)
DO WRITECTL^RMPVIO("!")
DO WRITECTL^RMPVIO("?5")
DO WRITE^RMPVIO("**CODE MARKED AS DELETED**")
DO WRITECTL^RMPVIO("!")
GOTO SEL
LP ;DISPLAY DISABILITY CODES
+1 KILL RMPRD
FOR RI=0:0
SET RI=$ORDER(^RMPR(665,RMPRDFN,1,RI))
if RI'>0
QUIT
IF $DATA(^(RI,0))
SET RMPRD(RI)=^(0)
+2 ; line truncated
+3 DO WRITECTL^RMPVIO("!")
+4 IF $DATA(RMPRD)
DO WRITECTL^RMPVIO("!")
DO WRITE^RMPVIO($PIECE(^DPT(RMPRDFN,0),U))
DO WRITE^RMPVIO(" HAS THE FOLLOWING CODES:")
DO WRITECTL^RMPVIO("!")
FOR RI=0:0
SET RI=$ORDER(RMPRD(RI))
if RI'>0
QUIT
Begin DoDot:1
+5 SET RA=RMPRD(RI)
DO WRITECTL^RMPVIO("!")
DO WRITECTL^RMPVIO("?5")
DO WRITE^RMPVIO($PIECE(^RMPR(662,$PIECE(RA,U),0),U))
DO DSP
End DoDot:1
+6 ; end truncation
+7 QUIT
DIR KILL DIR
IF '$PIECE(RMPRY,U,3)
SET DIR(0)="S^E:EDIT DISABILITY CODE;A:ADD DUPLICATE DISABILITY CODE"
SET DIR("B")="EDIT"
DO %DIR^RMPVFM
if $DATA(DIRUT)
QUIT
IF Y["A"
DO FILE
+1 QUIT
FILE KILL DD,DO,D0
SET DIC="^RMPR(665,"_RMPRDFN_",1,"
SET DIC(0)="EQML"
SET DLAYGO=665
SET X=RMPRX
DO FILEDICN^RMPVFM
KILL DLAYGO
SET DA(1)=RMPRDFN
SET RMPRY=+Y
QUIT
DSP IF +$PIECE(RA,U,3)
DO WRITECTL^RMPVIO("?15")
DO WRITE^RMPVIO($SELECT($PIECE(RA,U,3)=1:"SC ",1:"NSC "))
+1 IF +$PIECE(RA,U,4)
SET RT=$PIECE(^DD(665.01,3,0),U,3)
DO WRITECTL^RMPVIO("?21")
DO WRITE^RMPVIO($PIECE($PIECE(RT,":",$PIECE(RA,U,4)+1),";",1)_" ")
+2 IF +$PIECE(RA,U,5)
SET RT=$PIECE(^DD(665.01,4,0),U,3)
DO WRITECTL^RMPVIO("?41")
DO WRITE^RMPVIO($PIECE($PIECE(RT,":",$PIECE(RA,U,5)+1),";",1))
+3 IF +$PIECE(RA,U,10)
DO WRITECTL^RMPVIO("?65")
DO WRITE^RMPVIO("Deleted...")
+4 QUIT
SDR SET DR=".01;5///1;2;3;S $P(^RMPR(665,DA(1),1,DA,0),U,8)=DUZ;1///^S X=DT;10///@;I $P(^RMPR(665,DA(1),1,DA,0),U,4)'=4 S Y="""";4"
QUIT
CHK SET RDA=$PIECE(^RMPR(665,DA(1),1,DA,0),U)
Begin DoDot:1
+1 FOR RI=0:0
SET RI=$ORDER(^RMPR(665,DA(1),1,"B",RDA,RI))
if RI'>0
QUIT
SET RV=$PIECE(^RMPR(665,DA(1),1,RI,0),U,3)
IF (X=RV)
IF (DA'=RI)
KILL X
QUIT
End DoDot:1
KILL RDA
