RMPRPIX1 ;HINCIO/ODJ - PIP HCPCS ITEM FILE 661.11 APIs ;3/8/01
;;3.0;PROSTHETICS;**61,201**;Feb 09, 1996;Build 4
Q
;
;***** IEN - get the ien for a HCPCS item
;
; Inputs:
; RMPR("STATION") - Station ien
; RMPR("HCPCS") - HCPCS code
; RMPR("ITEM") - HCPCS Item
;
; Outputs:
; RMPR("IEN") - ien for HCPCS Item rec.
; RMPRERR - exit code returned by function
; 0 - no problems
; 1,2,3 - null inputs
IEN(RMPR) ;
N RMPRIEN,RMPRERR
S RMPRERR=0
I $G(RMPR("STATION"))="" S RMPRERR=1 G IENX
I $G(RMPR("HCPCS"))="" S RMPRERR=2 G IENX
I $G(RMPR("ITEM"))="" S RMPRERR=3 G IENX
S RMPRIEN=$O(^RMPR(661.11,"ASHI",RMPR("STATION"),RMPR("HCPCS"),RMPR("ITEM"),""))
S RMPR("IEN")=RMPRIEN
IENX Q RMPRERR
;
;***** CRE - Create a new HCPCS Item (661.11) record
;
; Inputs
CRE(RMPR) ;
N RMPRCRE,RMPRFDA,RMPRFME,RMPRIEN,X,Y,DA
S RMPRCRE=0
L +^RMPR(661.11)
;
; Get new seq. number for Item
I $G(RMPR("ITEM"))="" D
. S RMPR("ITEM")=1+$O(^RMPR(661.11,"ASHI",RMPR("STATION"),RMPR("HCPCS"),""),-1)
. Q
;
; Update 661.11
S RMPRFDA(661.11,"+1,",.01)=RMPR("HCPCS")
S RMPRFDA(661.11,"+1,",1)=RMPR("ITEM")
S RMPRFDA(661.11,"+1,",2)=RMPR("DESCRIPTION")
S RMPRFDA(661.11,"+1,",3)=RMPR("STATION")
S RMPRFDA(661.11,"+1,",4)=RMPR("SOURCE")
S RMPRFDA(661.11,"+1,",5)=$G(RMPR("UNIT"))
S RMPRFDA(661.11,"+1,",6)=RMPR("HCPCS")_"-"_RMPR("ITEM")
S RMPRFDA(661.11,"+1,",7)=RMPR("ITEM MASTER IEN")
D UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
L -^RMPR(661.11)
I $D(RMPRFME) S RMPRCRE=1 G CREX
S RMPR("IEN")=RMPRIEN(1)
;
; Update Inventory Flag
; RMPR*3.0*201 Removes Inventory Flag update
K RMPRFDA,RMPRFME
;S RMPRIEN=$O(^RMPR(661.1,"B",RMPR("HCPCS"),""))_","
;S RMPRFDA(661.1,RMPRIEN,10)=1
;D FILE^DIE("","RMPRFDA","RMPRFME")
CREX Q RMPRCRE
;
;***** UPD - Update HCPCS Item record (661.11)
UPD(RMPR11) ;
N RMPRFDA,RMPRFME,X,Y,DA,RMPRIEN,RMPRERR
S RMPRERR=0
S RMPRIEN=RMPR11("IEN")_","
I $D(RMPR11("HCPCS")) D
. S RMPRFDA(661.11,RMPRIEN,.01)=RMPR11("HCPCS")
. Q
I $D(RMPR11("ITEM")) D
. S RMPRFDA(661.11,RMPRIEN,1)=RMPR11("ITEM")
. Q
S:$D(RMPR11("DESCRIPTION")) RMPRFDA(661.11,RMPRIEN,2)=RMPR11("DESCRIPTION")
S:$D(RMPR11("SOURCE")) RMPRFDA(661.11,RMPRIEN,4)=RMPR11("SOURCE")
S:$D(RMPR11("UNIT")) RMPRFDA(661.11,RMPRIEN,5)=RMPR11("UNIT")
S:$D(RMPR11("HCPCS-ITEM")) RMPRFDA(661.11,RMPRIEN,6)=RMPR11("HCPCS-ITEM")
S:$D(RMPR11("ITEM MASTER IEN")) RMPRFDA(661.11,RMPRIEN,7)=RMPR11("ITEM MASTER IEN")
D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME")
I $D(RMPRFME) S RMPRERR=1 G UPDX
UPDX Q RMPRERR
;
;***** DUP - Check that a HCPCS Item does not have a different
; source on the same code
DUP(RMPR,RMPRDUP) ;
N RMPRS,RMPRERR,RMPR1,RMPR1I
S RMPRERR=0,RMPRDUP=0
S RMPRERR=$$IEN(.RMPR) G:RMPRERR DUPX
I RMPR("IEN")="" G DUPX
S RMPR1("IEN")=RMPR("IEN")
S RMPRERR=$$GET(.RMPR1) G:RMPRERR DUPX
S RMPRERR=$$ETOI(.RMPR1,.RMPR1I) G:RMPRERR DUPX
I RMPR1I("SOURCE")=RMPR("SOURCE") D
. S RMPRDUP=0
. Q
E D
. S RMPRDUP=1
. Q
DUPX Q RMPRERR
;
;***** GET - read HCPCS Item 661.11 record
GET(RMPR) ;
N RMPRCRE,RMPRFME,RMPROUP,RMPRIEN
S RMPRCRE=0
I $G(RMPR("IEN"))="" D
. S RMPRCRE=$$IEN(.RMPR)
. Q
I RMPRCRE G GETX
S RMPRIEN=RMPR("IEN")_","
D GETS^DIQ(661.11,RMPRIEN,"*","","RMPROUP","RMPRFME")
I $D(RMPRFME) S RMPRCRE=1 G GETX
S RMPR("HCPCS")=RMPROUP(661.11,RMPRIEN,.01)
S RMPR("ITEM")=RMPROUP(661.11,RMPRIEN,1)
S RMPR("DESCRIPTION")=RMPROUP(661.11,RMPRIEN,2)
S RMPR("STATION")=RMPROUP(661.11,RMPRIEN,3)
S RMPR("SOURCE")=RMPROUP(661.11,RMPRIEN,4)
S RMPR("UNIT")=RMPROUP(661.11,RMPRIEN,5)
S RMPR("HCPCS-ITEM")=RMPROUP(661.11,RMPRIEN,6)
S RMPR("ITEM MASTER")=RMPROUP(661.11,RMPRIEN,7)
S RMPR("STATUS")=RMPROUP(661.11,RMPRIEN,8)
GETX Q RMPRCRE
;
; Given HCPCS code get 1st active HCPCS record in 661.1 file
; If none are active then use 1st ien (should never occur)
HPACT(RMPR) ;
N RMPRCRE,RMPRFME,RMPROUP,RMPRIEN,RMPRE,RMPRI
S RMPRCRE=0
I $G(RMPR("HCPCS"))="" S RMPRCRE=1 G HPACTX
S RMPRI=""
F S RMPRI=$O(^RMPR(661.1,"B",RMPR("HCPCS"),RMPRI)) Q:RMPRI="" D Q:RMPRE("STATUS")="ACTIVE"
. K RMPRE S RMPRE("IEN")=RMPRI
. S RMPRCRE=$$HPGET(.RMPRE)
. Q
I $G(RMPRE("IEN"))'="" M RMPR=RMPRE
HPACTX Q RMPRCRE
;
;***** HPGET - Get a HCPCS record
HPGET(RMPR) ;
N RMPRCRE,RMPRFME,RMPROUP,RMPRIEN
S RMPRCRE=0
I $G(RMPR("IEN"))="" S RMPRCRE=1 G HPGETX
S RMPRIEN=RMPR("IEN")_","
D GETS^DIQ(661.1,RMPRIEN,"*","","RMPROUP","RMPRFME")
I $D(RMPRFME) S RMPRCRE=2 G HPGETX
S RMPR("HCPCS")=RMPROUP(661.1,RMPRIEN,.01)
S RMPR("SHORT DESC")=RMPROUP(661.1,RMPRIEN,.02)
S RMPR("NEW HCPC IEN")=RMPROUP(661.1,RMPRIEN,1)
S RMPR("CPT CODE")=RMPROUP(661.1,RMPRIEN,2)
S RMPR("STATUS")=RMPROUP(661.1,RMPRIEN,3)
S RMPR("NPPD REPAIR CODE")=RMPROUP(661.1,RMPRIEN,5)
S RMPR("NPPD NEW CODE")=RMPROUP(661.1,RMPRIEN,6)
S RMPR("CALC FLAG")=RMPROUP(661.1,RMPRIEN,9)
S RMPR("INV FLAG")=RMPROUP(661.1,RMPRIEN,10)
S RMPR("LAB TIME")=RMPROUP(661.1,RMPRIEN,11)
HPGETX Q RMPRCRE
;
;***** HPETOI - Convert external to internal form for HCPCS rec.
HPETOI(RMPRE,RMPRI) ;
N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
S RMPRERR=0
S RMPRIEN=RMPRE("IEN")_","
D GETS^DIQ(661.1,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
I $D(RMPRFME) S RMPRERR=1 G HPETOIX
S RMPRI("IEN")=RMPRE("IEN")
S RMPRI("NEW HCPC IEN")=RMPRFDI(661.1,RMPRIEN,1,"I")
S RMPRI("CPT CODE")=RMPRFDI(661.1,RMPRIEN,2,"I")
S RMPRI("STATUS")=RMPRFDI(661.1,RMPRIEN,3,"I")
S RMPRI("NPPD REPAIR CODE")=RMPRFDI(661.1,RMPRIEN,5,"I")
S RMPRI("NPPD NEW CODE")=RMPRFDI(661.1,RMPRIEN,6,"I")
S RMPRI("CALC FLAG")=RMPRFDI(661.1,RMPRIEN,9,"I")
S RMPRI("INV FLAG")=RMPRFDI(661.1,RMPRIEN,10,"I")
S RMPRI("LAB TIME")=RMPRFDI(661.1,RMPRIEN,11,"I")
HPETOIX Q RMPRERR
;
;***** ETOI - Convert external to internal form
ETOI(RMPRE,RMPRI) ;
N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
S RMPRERR=0
S RMPRIEN=RMPRE("IEN")_","
D GETS^DIQ(661.11,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
I $D(RMPRFME) S RMPRERR=1 G ETOIX
S RMPRI("IEN")=RMPRE("IEN")
S RMPRI("HCPCS")=RMPRFDI(661.11,RMPRIEN,.01,"I")
S RMPRI("ITEM")=RMPRFDI(661.11,RMPRIEN,1,"I")
S RMPRI("DESCRIPTION")=RMPRFDI(661.11,RMPRIEN,2,"I")
S RMPRI("STATION")=RMPRFDI(661.11,RMPRIEN,3,"I")
S RMPRI("SOURCE")=RMPRFDI(661.11,RMPRIEN,4,"I")
S RMPRI("UNIT")=RMPRFDI(661.11,RMPRIEN,5,"I")
S RMPRI("ITEM MASTER IEN")=RMPRFDI(661.11,RMPRIEN,7,"I")
ETOIX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIX1 6541 printed Apr 09, 2024@21:35:25 Page 2
RMPRPIX1 ;HINCIO/ODJ - PIP HCPCS ITEM FILE 661.11 APIs ;3/8/01
+1 ;;3.0;PROSTHETICS;**61,201**;Feb 09, 1996;Build 4
+2 QUIT
+3 ;
+4 ;***** IEN - get the ien for a HCPCS item
+5 ;
+6 ; Inputs:
+7 ; RMPR("STATION") - Station ien
+8 ; RMPR("HCPCS") - HCPCS code
+9 ; RMPR("ITEM") - HCPCS Item
+10 ;
+11 ; Outputs:
+12 ; RMPR("IEN") - ien for HCPCS Item rec.
+13 ; RMPRERR - exit code returned by function
+14 ; 0 - no problems
+15 ; 1,2,3 - null inputs
IEN(RMPR) ;
+1 NEW RMPRIEN,RMPRERR
+2 SET RMPRERR=0
+3 IF $GET(RMPR("STATION"))=""
SET RMPRERR=1
GOTO IENX
+4 IF $GET(RMPR("HCPCS"))=""
SET RMPRERR=2
GOTO IENX
+5 IF $GET(RMPR("ITEM"))=""
SET RMPRERR=3
GOTO IENX
+6 SET RMPRIEN=$ORDER(^RMPR(661.11,"ASHI",RMPR("STATION"),RMPR("HCPCS"),RMPR("ITEM"),""))
+7 SET RMPR("IEN")=RMPRIEN
IENX QUIT RMPRERR
+1 ;
+2 ;***** CRE - Create a new HCPCS Item (661.11) record
+3 ;
+4 ; Inputs
CRE(RMPR) ;
+1 NEW RMPRCRE,RMPRFDA,RMPRFME,RMPRIEN,X,Y,DA
+2 SET RMPRCRE=0
+3 LOCK +^RMPR(661.11)
+4 ;
+5 ; Get new seq. number for Item
+6 IF $GET(RMPR("ITEM"))=""
Begin DoDot:1
+7 SET RMPR("ITEM")=1+$ORDER(^RMPR(661.11,"ASHI",RMPR("STATION"),RMPR("HCPCS"),""),-1)
+8 QUIT
End DoDot:1
+9 ;
+10 ; Update 661.11
+11 SET RMPRFDA(661.11,"+1,",.01)=RMPR("HCPCS")
+12 SET RMPRFDA(661.11,"+1,",1)=RMPR("ITEM")
+13 SET RMPRFDA(661.11,"+1,",2)=RMPR("DESCRIPTION")
+14 SET RMPRFDA(661.11,"+1,",3)=RMPR("STATION")
+15 SET RMPRFDA(661.11,"+1,",4)=RMPR("SOURCE")
+16 SET RMPRFDA(661.11,"+1,",5)=$GET(RMPR("UNIT"))
+17 SET RMPRFDA(661.11,"+1,",6)=RMPR("HCPCS")_"-"_RMPR("ITEM")
+18 SET RMPRFDA(661.11,"+1,",7)=RMPR("ITEM MASTER IEN")
+19 DO UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
+20 LOCK -^RMPR(661.11)
+21 IF $DATA(RMPRFME)
SET RMPRCRE=1
GOTO CREX
+22 SET RMPR("IEN")=RMPRIEN(1)
+23 ;
+24 ; Update Inventory Flag
+25 ; RMPR*3.0*201 Removes Inventory Flag update
+26 KILL RMPRFDA,RMPRFME
+27 ;S RMPRIEN=$O(^RMPR(661.1,"B",RMPR("HCPCS"),""))_","
+28 ;S RMPRFDA(661.1,RMPRIEN,10)=1
+29 ;D FILE^DIE("","RMPRFDA","RMPRFME")
CREX QUIT RMPRCRE
+1 ;
+2 ;***** UPD - Update HCPCS Item record (661.11)
UPD(RMPR11) ;
+1 NEW RMPRFDA,RMPRFME,X,Y,DA,RMPRIEN,RMPRERR
+2 SET RMPRERR=0
+3 SET RMPRIEN=RMPR11("IEN")_","
+4 IF $DATA(RMPR11("HCPCS"))
Begin DoDot:1
+5 SET RMPRFDA(661.11,RMPRIEN,.01)=RMPR11("HCPCS")
+6 QUIT
End DoDot:1
+7 IF $DATA(RMPR11("ITEM"))
Begin DoDot:1
+8 SET RMPRFDA(661.11,RMPRIEN,1)=RMPR11("ITEM")
+9 QUIT
End DoDot:1
+10 if $DATA(RMPR11("DESCRIPTION"))
SET RMPRFDA(661.11,RMPRIEN,2)=RMPR11("DESCRIPTION")
+11 if $DATA(RMPR11("SOURCE"))
SET RMPRFDA(661.11,RMPRIEN,4)=RMPR11("SOURCE")
+12 if $DATA(RMPR11("UNIT"))
SET RMPRFDA(661.11,RMPRIEN,5)=RMPR11("UNIT")
+13 if $DATA(RMPR11("HCPCS-ITEM"))
SET RMPRFDA(661.11,RMPRIEN,6)=RMPR11("HCPCS-ITEM")
+14 if $DATA(RMPR11("ITEM MASTER IEN"))
SET RMPRFDA(661.11,RMPRIEN,7)=RMPR11("ITEM MASTER IEN")
+15 if $DATA(RMPRFDA)
DO FILE^DIE("","RMPRFDA","RMPRFME")
+16 IF $DATA(RMPRFME)
SET RMPRERR=1
GOTO UPDX
UPDX QUIT RMPRERR
+1 ;
+2 ;***** DUP - Check that a HCPCS Item does not have a different
+3 ; source on the same code
DUP(RMPR,RMPRDUP) ;
+1 NEW RMPRS,RMPRERR,RMPR1,RMPR1I
+2 SET RMPRERR=0
SET RMPRDUP=0
+3 SET RMPRERR=$$IEN(.RMPR)
if RMPRERR
GOTO DUPX
+4 IF RMPR("IEN")=""
GOTO DUPX
+5 SET RMPR1("IEN")=RMPR("IEN")
+6 SET RMPRERR=$$GET(.RMPR1)
if RMPRERR
GOTO DUPX
+7 SET RMPRERR=$$ETOI(.RMPR1,.RMPR1I)
if RMPRERR
GOTO DUPX
+8 IF RMPR1I("SOURCE")=RMPR("SOURCE")
Begin DoDot:1
+9 SET RMPRDUP=0
+10 QUIT
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET RMPRDUP=1
+13 QUIT
End DoDot:1
DUPX QUIT RMPRERR
+1 ;
+2 ;***** GET - read HCPCS Item 661.11 record
GET(RMPR) ;
+1 NEW RMPRCRE,RMPRFME,RMPROUP,RMPRIEN
+2 SET RMPRCRE=0
+3 IF $GET(RMPR("IEN"))=""
Begin DoDot:1
+4 SET RMPRCRE=$$IEN(.RMPR)
+5 QUIT
End DoDot:1
+6 IF RMPRCRE
GOTO GETX
+7 SET RMPRIEN=RMPR("IEN")_","
+8 DO GETS^DIQ(661.11,RMPRIEN,"*","","RMPROUP","RMPRFME")
+9 IF $DATA(RMPRFME)
SET RMPRCRE=1
GOTO GETX
+10 SET RMPR("HCPCS")=RMPROUP(661.11,RMPRIEN,.01)
+11 SET RMPR("ITEM")=RMPROUP(661.11,RMPRIEN,1)
+12 SET RMPR("DESCRIPTION")=RMPROUP(661.11,RMPRIEN,2)
+13 SET RMPR("STATION")=RMPROUP(661.11,RMPRIEN,3)
+14 SET RMPR("SOURCE")=RMPROUP(661.11,RMPRIEN,4)
+15 SET RMPR("UNIT")=RMPROUP(661.11,RMPRIEN,5)
+16 SET RMPR("HCPCS-ITEM")=RMPROUP(661.11,RMPRIEN,6)
+17 SET RMPR("ITEM MASTER")=RMPROUP(661.11,RMPRIEN,7)
+18 SET RMPR("STATUS")=RMPROUP(661.11,RMPRIEN,8)
GETX QUIT RMPRCRE
+1 ;
+2 ; Given HCPCS code get 1st active HCPCS record in 661.1 file
+3 ; If none are active then use 1st ien (should never occur)
HPACT(RMPR) ;
+1 NEW RMPRCRE,RMPRFME,RMPROUP,RMPRIEN,RMPRE,RMPRI
+2 SET RMPRCRE=0
+3 IF $GET(RMPR("HCPCS"))=""
SET RMPRCRE=1
GOTO HPACTX
+4 SET RMPRI=""
+5 FOR
SET RMPRI=$ORDER(^RMPR(661.1,"B",RMPR("HCPCS"),RMPRI))
if RMPRI=""
QUIT
Begin DoDot:1
+6 KILL RMPRE
SET RMPRE("IEN")=RMPRI
+7 SET RMPRCRE=$$HPGET(.RMPRE)
+8 QUIT
End DoDot:1
if RMPRE("STATUS")="ACTIVE"
QUIT
+9 IF $GET(RMPRE("IEN"))'=""
MERGE RMPR=RMPRE
HPACTX QUIT RMPRCRE
+1 ;
+2 ;***** HPGET - Get a HCPCS record
HPGET(RMPR) ;
+1 NEW RMPRCRE,RMPRFME,RMPROUP,RMPRIEN
+2 SET RMPRCRE=0
+3 IF $GET(RMPR("IEN"))=""
SET RMPRCRE=1
GOTO HPGETX
+4 SET RMPRIEN=RMPR("IEN")_","
+5 DO GETS^DIQ(661.1,RMPRIEN,"*","","RMPROUP","RMPRFME")
+6 IF $DATA(RMPRFME)
SET RMPRCRE=2
GOTO HPGETX
+7 SET RMPR("HCPCS")=RMPROUP(661.1,RMPRIEN,.01)
+8 SET RMPR("SHORT DESC")=RMPROUP(661.1,RMPRIEN,.02)
+9 SET RMPR("NEW HCPC IEN")=RMPROUP(661.1,RMPRIEN,1)
+10 SET RMPR("CPT CODE")=RMPROUP(661.1,RMPRIEN,2)
+11 SET RMPR("STATUS")=RMPROUP(661.1,RMPRIEN,3)
+12 SET RMPR("NPPD REPAIR CODE")=RMPROUP(661.1,RMPRIEN,5)
+13 SET RMPR("NPPD NEW CODE")=RMPROUP(661.1,RMPRIEN,6)
+14 SET RMPR("CALC FLAG")=RMPROUP(661.1,RMPRIEN,9)
+15 SET RMPR("INV FLAG")=RMPROUP(661.1,RMPRIEN,10)
+16 SET RMPR("LAB TIME")=RMPROUP(661.1,RMPRIEN,11)
HPGETX QUIT RMPRCRE
+1 ;
+2 ;***** HPETOI - Convert external to internal form for HCPCS rec.
HPETOI(RMPRE,RMPRI) ;
+1 NEW RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
+2 SET RMPRERR=0
+3 SET RMPRIEN=RMPRE("IEN")_","
+4 DO GETS^DIQ(661.1,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
+5 IF $DATA(RMPRFME)
SET RMPRERR=1
GOTO HPETOIX
+6 SET RMPRI("IEN")=RMPRE("IEN")
+7 SET RMPRI("NEW HCPC IEN")=RMPRFDI(661.1,RMPRIEN,1,"I")
+8 SET RMPRI("CPT CODE")=RMPRFDI(661.1,RMPRIEN,2,"I")
+9 SET RMPRI("STATUS")=RMPRFDI(661.1,RMPRIEN,3,"I")
+10 SET RMPRI("NPPD REPAIR CODE")=RMPRFDI(661.1,RMPRIEN,5,"I")
+11 SET RMPRI("NPPD NEW CODE")=RMPRFDI(661.1,RMPRIEN,6,"I")
+12 SET RMPRI("CALC FLAG")=RMPRFDI(661.1,RMPRIEN,9,"I")
+13 SET RMPRI("INV FLAG")=RMPRFDI(661.1,RMPRIEN,10,"I")
+14 SET RMPRI("LAB TIME")=RMPRFDI(661.1,RMPRIEN,11,"I")
HPETOIX QUIT RMPRERR
+1 ;
+2 ;***** ETOI - Convert external to internal form
ETOI(RMPRE,RMPRI) ;
+1 NEW RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
+2 SET RMPRERR=0
+3 SET RMPRIEN=RMPRE("IEN")_","
+4 DO GETS^DIQ(661.11,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
+5 IF $DATA(RMPRFME)
SET RMPRERR=1
GOTO ETOIX
+6 SET RMPRI("IEN")=RMPRE("IEN")
+7 SET RMPRI("HCPCS")=RMPRFDI(661.11,RMPRIEN,.01,"I")
+8 SET RMPRI("ITEM")=RMPRFDI(661.11,RMPRIEN,1,"I")
+9 SET RMPRI("DESCRIPTION")=RMPRFDI(661.11,RMPRIEN,2,"I")
+10 SET RMPRI("STATION")=RMPRFDI(661.11,RMPRIEN,3,"I")
+11 SET RMPRI("SOURCE")=RMPRFDI(661.11,RMPRIEN,4,"I")
+12 SET RMPRI("UNIT")=RMPRFDI(661.11,RMPRIEN,5,"I")
+13 SET RMPRI("ITEM MASTER IEN")=RMPRFDI(661.11,RMPRIEN,7,"I")
ETOIX QUIT RMPRERR
