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