RMPREO23 ;HINES/HNC ;suspense processing display protocols ;10/9/2003
;;3.0;PROSTHETICS;**45,55,62,77,80**;Feb 09, 1996
; RVD 1/16/01 #62 -added a selected range for linked suspense
; for initial, post other and complete action only.
;RVD patch #77 - check for ^tmp global and XRMPRDFN variable
Q
DIS ;display 2319 action
S RMPRBAC1=1
D FULL^VALM1
S XRMPRDFN=RMPRDFN
D ^RMPRPAT
K RMPRBAC1,RMPRBACK
S VALMBCK="R"
Q:'$D(XRMPRDFN)
S (RMPRDFN,DFN)=XRMPRDFN D DEM^VADPT
S RMPRNAM=$P(VADM(1),U,1)
S RMPRDOB=$P(VADM(3),U,1)
S RMPRSSN=$P(VADM(2),U,1)
K VADM,XRMPRDFN
Q
;
CHG ;change patient
D FULL^VALM1
S XRMPRDFN=RMPRDFN
D GETPAT^RMPRUTIL
I '$D(RMPRDFN) S RMPRDFN=XRMPRDFN
D INIT^RMPREO
S VALMBCK="R"
Q
CANCEL ;cancel suspense
D FULL^VALM1
D NUM^RMPREOU
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D CANCEL^RMPREOS
K RMPREOY,XDA,DA,DUOUT
D INIT^RMPREO
S VALMBCK="R"
Q
VIEW ;view consult request
N YY,DA,FLDS,DIC
D FULL^VALM1
D NUM^RMPREOU
I Y="" S VALMBCK="R"
;
S RN=1,XDA=""
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 D VIEWP
K RMPREOY,DUOUT
S VALMBCK="R"
Q
VIEWP ;
;
Q:'$D(^TMP($J,"RMPREOEE",XDA,0))
S DA=^TMP($J,"RMPREOEE",XDA,0)
S L=0
S DIC="^RMPR(668,",FLDS="[RMPR VIEW REQUEST]"
S BY="@NUMBER",(FR,TO)=DA
;prompt for device
;S IOP="HOME"
D EN1^DIP
N DIR S DIR(0)="E" D ^DIR
W @IOF
S DA=^TMP($J,"RMPREOEE",XDA,0)
D VALL^RMPREO24(DA,.L) Q:L="^"
Q
;
PDISP ;print consultaton sheet
D NUM^RMPREOU
D FULL^VALM1
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D PDISPA
K RMPREOY,XDA,DA,DUOUT
D INIT^RMPREO
S VALMBCK="R"
Q
PDISPA ;call consult api
;pass DA ien to 668
D ENP^RMPREPDT
Q
DDISP ;detail display
D NUM^RMPREOU
D FULL^VALM1
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D DDISPA
K RMPREOY,XDA,DA,DUOUT
D INIT^RMPREO
S VALMBCK="R"
Q
DDISPA ;call list template from listmanager
;pass DA ien to file 668
D EN^RMPREPDT
Q
VIEWIA ;view initial action note
N YY,DIC,BY,FLDS,FR,TO,DA
D NUM^RMPREOU
D FULL^VALM1
;
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D VIEWIAP
K RMPREOY,XDA,DA,DUOUT
S VALMBCK="R"
Q
VIEWIAP ;loop
S L=0
S DIC="^RMPR(668,",FLDS="[RMPR VIEW INITIAL ACTION]"
S BY="@NUMBER",(FR,TO)=DA
S IOP="HOME"
W @IOF
D EN1^DIP
N DIR S DIR(0)="E" D ^DIR
Q
;
VIEWC ;view complete note
;
N YY,DIC,BY,FLDS,FR,TO,DA
D NUM^RMPREOU
D FULL^VALM1
;
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D VIEWCP
K RMPREOY,XDA,DA,DUOUT
S VALMBCK="R"
Q
VIEWCP ;loop
S L=0
S DIC="^RMPR(668,",FLDS="[RMPR VIEW COMP NOTE]"
S BY="@NUMBER",(FR,TO)=DA
;should we ask device?
;S IOP="HOME"
W @IOF
D EN1^DIP
N DIR S DIR(0)="E" D ^DIR
Q
;
;
VIEWO ;view other action notes
N YY,DIC,BY,FLDS,FR,TO,DA
D NUM^RMPREOU
D FULL^VALM1
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D VIEWOP
K RMPREOY,XDA,DA,DUOUT
S VALMBCK="R"
Q
VIEWOP ;loop
S L=0
S DIC="^RMPR(668,",FLDS="[RMPR OACT NOTE]"
S BY="@NUMBER",(FR,TO)=DA
S IOP="HOME"
W @IOF
D EN1^DIP
N DIR S DIR(0)="E" D ^DIR
S VALMBCK="R"
Q
;
IACT ;take initial action
;
N YY,DIC,BY,FLDS,FR,TO,DA
D NUM^RMPREOU
D FULL^VALM1
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D ENIA^RMPREOS
K RMPREOY,XDA,DA,DUOUT
I $G(RMSUCLFG) D INIT^RMPREOL
I '$G(RMSUCLFG) D INIT^RMPREO
S VALMBCK="R"
Q
;
OACT ;other notes
N YY,DIC,BY,FLDS,FR,TO,DA
D NUM^RMPREOU
D FULL^VALM1
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D OACT^RMPREOS
K RMPREOY,XDA,DA,DUOUT
I $G(RMSUCLFG) D INIT^RMPREOL
I '$G(RMSUCLFG) D INIT^RMPREO
S VALMBCK="R"
Q
;
CACT ;complete note
N YY,DIC,BY,FLDS,FR,TO,DA
D NUM^RMPREOU
D FULL^VALM1
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D CLNT^RMPREOS
K RMPREOY,XDA,DA,DUOUT
I $G(RMSUCLFG) D INIT^RMPREOL
I '$G(RMSUCLFG) D INIT^RMPREO
S VALMBCK="R"
Q
;
FORW ;forward consult
N YY,DIC,BY,FLDS,FR,TO,DA
D NUM^RMPREOU
D FULL^VALM1
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D FORW^RMPREOS
K RMPREOY,XDA,DA,DUOUT
D INIT^RMPREO
S VALMBCK="R"
Q
AMAN ;add manual suspense
D FULL^VALM1
D EN^RMPREOS
D INIT^RMPREO
S VALMBCK="R"
Q
;
AAUTO ;add AUTO ADAPTIVE suspense
D FULL^VALM1
D EN^RMPREOSA
D INIT^RMPREO
S VALMBCK="R"
Q
;
ACLO ;add CLOTHING ALLOWANCE suspense
D FULL^VALM1
D EN1^RMPREOSA
D INIT^RMPREO
S VALMBCK="R"
Q
;
CLONE ;Create Clone CPRS Suspense
;new vars here
D NUM^RMPREOU
D FULL^VALM1
S RMPREOY=Y
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D CLONEP
K RMPREOY,XDA,DA,DUOUT
D INIT^RMPREO
S VALMBCK="R"
Q
;
CLONEP ;Create Clone CPRS from loop
D EN2^RMPREOSA
Q
;
EMAN ;edit manual suspense
D FULL^VALM1
D NUM^RMPREOU
S RMPREOY=Y
S RN=""
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D EMANP
K RMPREOY,XDA,DA,DUOUT,RN
Q
EMANP ;edit manual supsense loop
D EN2^RMPREOS
D INIT^RMPREO
S VALMBCK="R"
Q
;
;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPREO23 6081 printed Dec 13, 2024@02:34:24 Page 2
RMPREO23 ;HINES/HNC ;suspense processing display protocols ;10/9/2003
+1 ;;3.0;PROSTHETICS;**45,55,62,77,80**;Feb 09, 1996
+2 ; RVD 1/16/01 #62 -added a selected range for linked suspense
+3 ; for initial, post other and complete action only.
+4 ;RVD patch #77 - check for ^tmp global and XRMPRDFN variable
+5 QUIT
DIS ;display 2319 action
+1 SET RMPRBAC1=1
+2 DO FULL^VALM1
+3 SET XRMPRDFN=RMPRDFN
+4 DO ^RMPRPAT
+5 KILL RMPRBAC1,RMPRBACK
+6 SET VALMBCK="R"
+7 if '$DATA(XRMPRDFN)
QUIT
+8 SET (RMPRDFN,DFN)=XRMPRDFN
DO DEM^VADPT
+9 SET RMPRNAM=$PIECE(VADM(1),U,1)
+10 SET RMPRDOB=$PIECE(VADM(3),U,1)
+11 SET RMPRSSN=$PIECE(VADM(2),U,1)
+12 KILL VADM,XRMPRDFN
+13 QUIT
+14 ;
CHG ;change patient
+1 DO FULL^VALM1
+2 SET XRMPRDFN=RMPRDFN
+3 DO GETPAT^RMPRUTIL
+4 IF '$DATA(RMPRDFN)
SET RMPRDFN=XRMPRDFN
+5 DO INIT^RMPREO
+6 SET VALMBCK="R"
+7 QUIT
CANCEL ;cancel suspense
+1 DO FULL^VALM1
+2 DO NUM^RMPREOU
+3 SET RMPREOY=Y
+4 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO CANCEL^RMPREOS
+5 KILL RMPREOY,XDA,DA,DUOUT
+6 DO INIT^RMPREO
+7 SET VALMBCK="R"
+8 QUIT
VIEW ;view consult request
+1 NEW YY,DA,FLDS,DIC
+2 DO FULL^VALM1
+3 DO NUM^RMPREOU
+4 IF Y=""
SET VALMBCK="R"
+5 ;
+6 SET RN=1
SET XDA=""
+7 SET RMPREOY=Y
+8 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
DO VIEWP
+9 KILL RMPREOY,DUOUT
+10 SET VALMBCK="R"
+11 QUIT
VIEWP ;
+1 ;
+2 if '$DATA(^TMP($JOB,"RMPREOEE",XDA,0))
QUIT
+3 SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
+4 SET L=0
+5 SET DIC="^RMPR(668,"
SET FLDS="[RMPR VIEW REQUEST]"
+6 SET BY="@NUMBER"
SET (FR,TO)=DA
+7 ;prompt for device
+8 ;S IOP="HOME"
+9 DO EN1^DIP
+10 NEW DIR
SET DIR(0)="E"
DO ^DIR
+11 WRITE @IOF
+12 SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
+13 DO VALL^RMPREO24(DA,.L)
if L="^"
QUIT
+14 QUIT
+15 ;
PDISP ;print consultaton sheet
+1 DO NUM^RMPREOU
+2 DO FULL^VALM1
+3 SET RMPREOY=Y
+4 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO PDISPA
+5 KILL RMPREOY,XDA,DA,DUOUT
+6 DO INIT^RMPREO
+7 SET VALMBCK="R"
+8 QUIT
PDISPA ;call consult api
+1 ;pass DA ien to 668
+2 DO ENP^RMPREPDT
+3 QUIT
DDISP ;detail display
+1 DO NUM^RMPREOU
+2 DO FULL^VALM1
+3 SET RMPREOY=Y
+4 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO DDISPA
+5 KILL RMPREOY,XDA,DA,DUOUT
+6 DO INIT^RMPREO
+7 SET VALMBCK="R"
+8 QUIT
DDISPA ;call list template from listmanager
+1 ;pass DA ien to file 668
+2 DO EN^RMPREPDT
+3 QUIT
VIEWIA ;view initial action note
+1 NEW YY,DIC,BY,FLDS,FR,TO,DA
+2 DO NUM^RMPREOU
+3 DO FULL^VALM1
+4 ;
+5 SET RMPREOY=Y
+6 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO VIEWIAP
+7 KILL RMPREOY,XDA,DA,DUOUT
+8 SET VALMBCK="R"
+9 QUIT
VIEWIAP ;loop
+1 SET L=0
+2 SET DIC="^RMPR(668,"
SET FLDS="[RMPR VIEW INITIAL ACTION]"
+3 SET BY="@NUMBER"
SET (FR,TO)=DA
+4 SET IOP="HOME"
+5 WRITE @IOF
+6 DO EN1^DIP
+7 NEW DIR
SET DIR(0)="E"
DO ^DIR
+8 QUIT
+9 ;
VIEWC ;view complete note
+1 ;
+2 NEW YY,DIC,BY,FLDS,FR,TO,DA
+3 DO NUM^RMPREOU
+4 DO FULL^VALM1
+5 ;
+6 SET RMPREOY=Y
+7 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO VIEWCP
+8 KILL RMPREOY,XDA,DA,DUOUT
+9 SET VALMBCK="R"
+10 QUIT
VIEWCP ;loop
+1 SET L=0
+2 SET DIC="^RMPR(668,"
SET FLDS="[RMPR VIEW COMP NOTE]"
+3 SET BY="@NUMBER"
SET (FR,TO)=DA
+4 ;should we ask device?
+5 ;S IOP="HOME"
+6 WRITE @IOF
+7 DO EN1^DIP
+8 NEW DIR
SET DIR(0)="E"
DO ^DIR
+9 QUIT
+10 ;
+11 ;
VIEWO ;view other action notes
+1 NEW YY,DIC,BY,FLDS,FR,TO,DA
+2 DO NUM^RMPREOU
+3 DO FULL^VALM1
+4 SET RMPREOY=Y
+5 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO VIEWOP
+6 KILL RMPREOY,XDA,DA,DUOUT
+7 SET VALMBCK="R"
+8 QUIT
VIEWOP ;loop
+1 SET L=0
+2 SET DIC="^RMPR(668,"
SET FLDS="[RMPR OACT NOTE]"
+3 SET BY="@NUMBER"
SET (FR,TO)=DA
+4 SET IOP="HOME"
+5 WRITE @IOF
+6 DO EN1^DIP
+7 NEW DIR
SET DIR(0)="E"
DO ^DIR
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
IACT ;take initial action
+1 ;
+2 NEW YY,DIC,BY,FLDS,FR,TO,DA
+3 DO NUM^RMPREOU
+4 DO FULL^VALM1
+5 SET RMPREOY=Y
+6 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO ENIA^RMPREOS
+7 KILL RMPREOY,XDA,DA,DUOUT
+8 IF $GET(RMSUCLFG)
DO INIT^RMPREOL
+9 IF '$GET(RMSUCLFG)
DO INIT^RMPREO
+10 SET VALMBCK="R"
+11 QUIT
+12 ;
OACT ;other notes
+1 NEW YY,DIC,BY,FLDS,FR,TO,DA
+2 DO NUM^RMPREOU
+3 DO FULL^VALM1
+4 SET RMPREOY=Y
+5 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO OACT^RMPREOS
+6 KILL RMPREOY,XDA,DA,DUOUT
+7 IF $GET(RMSUCLFG)
DO INIT^RMPREOL
+8 IF '$GET(RMSUCLFG)
DO INIT^RMPREO
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
CACT ;complete note
+1 NEW YY,DIC,BY,FLDS,FR,TO,DA
+2 DO NUM^RMPREOU
+3 DO FULL^VALM1
+4 SET RMPREOY=Y
+5 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO CLNT^RMPREOS
+6 KILL RMPREOY,XDA,DA,DUOUT
+7 IF $GET(RMSUCLFG)
DO INIT^RMPREOL
+8 IF '$GET(RMSUCLFG)
DO INIT^RMPREO
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
FORW ;forward consult
+1 NEW YY,DIC,BY,FLDS,FR,TO,DA
+2 DO NUM^RMPREOU
+3 DO FULL^VALM1
+4 SET RMPREOY=Y
+5 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO FORW^RMPREOS
+6 KILL RMPREOY,XDA,DA,DUOUT
+7 DO INIT^RMPREO
+8 SET VALMBCK="R"
+9 QUIT
AMAN ;add manual suspense
+1 DO FULL^VALM1
+2 DO EN^RMPREOS
+3 DO INIT^RMPREO
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
AAUTO ;add AUTO ADAPTIVE suspense
+1 DO FULL^VALM1
+2 DO EN^RMPREOSA
+3 DO INIT^RMPREO
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
ACLO ;add CLOTHING ALLOWANCE suspense
+1 DO FULL^VALM1
+2 DO EN1^RMPREOSA
+3 DO INIT^RMPREO
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
CLONE ;Create Clone CPRS Suspense
+1 ;new vars here
+2 DO NUM^RMPREOU
+3 DO FULL^VALM1
+4 SET RMPREOY=Y
+5 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO CLONEP
+6 KILL RMPREOY,XDA,DA,DUOUT
+7 DO INIT^RMPREO
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
CLONEP ;Create Clone CPRS from loop
+1 DO EN2^RMPREOSA
+2 QUIT
+3 ;
EMAN ;edit manual suspense
+1 DO FULL^VALM1
+2 DO NUM^RMPREOU
+3 SET RMPREOY=Y
+4 SET RN=""
+5 FOR RN=1:1
SET XDA=$PIECE(RMPREOY,",",RN)
if XDA=""
QUIT
if $GET(DUOUT)=1
QUIT
IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
DO EMANP
+6 KILL RMPREOY,XDA,DA,DUOUT,RN
+7 QUIT
EMANP ;edit manual supsense loop
+1 DO EN2^RMPREOS
+2 DO INIT^RMPREO
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
+6 ;END
