RMPRPIX4 ;HINCIO/ODJ - PIP RE-ORDER FILE 661.4 APIs ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;***** CRE - Create HCPCS Item re-order record
CRE(RMPR4,RMPR11,RMPR5) ;
N RMPRCRE,RMPRFDA,RMPRIEN,RMPRFME
S RMPRCRE=0
I $G(RMPR11("HCPCS"))="" S RMPRCRE=1 G CREX
I $G(RMPR11("ITEM"))="" S RMPRCRE=2 G CREX
I $G(RMPR11("STATION IEN"))="" S RMPRCRE=3 G CREX
I $G(RMPR5("IEN"))="" S RMPRCRE=4 G CREX
L +^RMPR(661.4)
S RMPRFDA(661.4,"+1,",.01)=RMPR11("HCPCS")
S RMPRFDA(661.4,"+1,",2)=RMPR11("ITEM")
S RMPRFDA(661.4,"+1,",3)=RMPR11("STATION IEN")
S RMPRFDA(661.4,"+1,",4)=RMPR4("RE-ORDER QTY")
S RMPRFDA(661.4,"+1,",7)=RMPR5("IEN")
D UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
L -^RMPR(661.4)
I $D(RMPRFME) S RMPRCRE=5 G CREX
S RMPR4("IEN")=RMPRIEN(1)
CREX Q RMPRCRE
;
;***** GET - read prosthetic re-order record
GET(RMPR4,RMPR11,RMPR5) ;
N RMPRERR,RMPRIEN,X,Y,DA,RMPROUP,RMPRFME
S RMPRERR=0
I $G(RMPR4("IEN"))="" S RMPRERR=1 G GETX
S RMPRIEN=RMPR4("IEN")_","
D GETS^DIQ(661.4,RMPRIEN,"*","","RMPROUP","RMPRFME")
I $D(RMPRFME) S RMPRERR=99 G GETX
S RMPR11("HCPCS")=RMPROUP(661.4,RMPRIEN,.01)
S RMPR11("ITEM")=RMPROUP(661.4,RMPRIEN,2)
S RMPR11("STATION")=RMPROUP(661.4,RMPRIEN,3)
S RMPR4("RE-ORDER QTY")=RMPROUP(661.4,RMPRIEN,4)
S RMPR5("LOCATION")=RMPROUP(661.4,RMPRIEN,7)
GETX Q RMPRERR
;
;***** UPD - update prosthetic re-order record
UPD(RMPR4,RMPR11,RMPR5) ;
N RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
S RMPRERR=0
I $G(RMPR4("IEN"))="" S RMPRERR=1 G UPDX
S RMPRIEN=RMPR4("IEN")_","
S:$D(RMPRSTN("IEN")) RMPRFDA(661.4,RMPRIEN,3)=RMPRSTN("IEN")
S:$D(RMPR11("HCPCS")) RMPRFDA(661.4,RMPRIEN,.01)=RMPR11("HCPCS")
S:$D(RMPR11("ITEM")) RMPRFDA(661.4,RMPRIEN,2)=RMPR11("ITEM")
S:$D(RMPR5("IEN")) RMPRFDA(661.4,RMPRIEN,7)=RMPR5("IEN")
S:$D(RMPR4("RE-ORDER QTY")) RMPRFDA(661.4,RMPRIEN,4)=RMPR4("RE-ORDER QTY")
D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME")
I $D(RMPRFME) S RMPRERR=2
UPDX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIX4 1991 printed Dec 13, 2024@02:36:35 Page 2
RMPRPIX4 ;HINCIO/ODJ - PIP RE-ORDER FILE 661.4 APIs ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** CRE - Create HCPCS Item re-order record
CRE(RMPR4,RMPR11,RMPR5) ;
+1 NEW RMPRCRE,RMPRFDA,RMPRIEN,RMPRFME
+2 SET RMPRCRE=0
+3 IF $GET(RMPR11("HCPCS"))=""
SET RMPRCRE=1
GOTO CREX
+4 IF $GET(RMPR11("ITEM"))=""
SET RMPRCRE=2
GOTO CREX
+5 IF $GET(RMPR11("STATION IEN"))=""
SET RMPRCRE=3
GOTO CREX
+6 IF $GET(RMPR5("IEN"))=""
SET RMPRCRE=4
GOTO CREX
+7 LOCK +^RMPR(661.4)
+8 SET RMPRFDA(661.4,"+1,",.01)=RMPR11("HCPCS")
+9 SET RMPRFDA(661.4,"+1,",2)=RMPR11("ITEM")
+10 SET RMPRFDA(661.4,"+1,",3)=RMPR11("STATION IEN")
+11 SET RMPRFDA(661.4,"+1,",4)=RMPR4("RE-ORDER QTY")
+12 SET RMPRFDA(661.4,"+1,",7)=RMPR5("IEN")
+13 DO UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
+14 LOCK -^RMPR(661.4)
+15 IF $DATA(RMPRFME)
SET RMPRCRE=5
GOTO CREX
+16 SET RMPR4("IEN")=RMPRIEN(1)
CREX QUIT RMPRCRE
+1 ;
+2 ;***** GET - read prosthetic re-order record
GET(RMPR4,RMPR11,RMPR5) ;
+1 NEW RMPRERR,RMPRIEN,X,Y,DA,RMPROUP,RMPRFME
+2 SET RMPRERR=0
+3 IF $GET(RMPR4("IEN"))=""
SET RMPRERR=1
GOTO GETX
+4 SET RMPRIEN=RMPR4("IEN")_","
+5 DO GETS^DIQ(661.4,RMPRIEN,"*","","RMPROUP","RMPRFME")
+6 IF $DATA(RMPRFME)
SET RMPRERR=99
GOTO GETX
+7 SET RMPR11("HCPCS")=RMPROUP(661.4,RMPRIEN,.01)
+8 SET RMPR11("ITEM")=RMPROUP(661.4,RMPRIEN,2)
+9 SET RMPR11("STATION")=RMPROUP(661.4,RMPRIEN,3)
+10 SET RMPR4("RE-ORDER QTY")=RMPROUP(661.4,RMPRIEN,4)
+11 SET RMPR5("LOCATION")=RMPROUP(661.4,RMPRIEN,7)
GETX QUIT RMPRERR
+1 ;
+2 ;***** UPD - update prosthetic re-order record
UPD(RMPR4,RMPR11,RMPR5) ;
+1 NEW RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
+2 SET RMPRERR=0
+3 IF $GET(RMPR4("IEN"))=""
SET RMPRERR=1
GOTO UPDX
+4 SET RMPRIEN=RMPR4("IEN")_","
+5 if $DATA(RMPRSTN("IEN"))
SET RMPRFDA(661.4,RMPRIEN,3)=RMPRSTN("IEN")
+6 if $DATA(RMPR11("HCPCS"))
SET RMPRFDA(661.4,RMPRIEN,.01)=RMPR11("HCPCS")
+7 if $DATA(RMPR11("ITEM"))
SET RMPRFDA(661.4,RMPRIEN,2)=RMPR11("ITEM")
+8 if $DATA(RMPR5("IEN"))
SET RMPRFDA(661.4,RMPRIEN,7)=RMPR5("IEN")
+9 if $DATA(RMPR4("RE-ORDER QTY"))
SET RMPRFDA(661.4,RMPRIEN,4)=RMPR4("RE-ORDER QTY")
+10 if $DATA(RMPRFDA)
DO FILE^DIE("","RMPRFDA","RMPRFME")
+11 IF $DATA(RMPRFME)
SET RMPRERR=2
UPDX QUIT RMPRERR
