RMPRPIX4.m

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 ---RMPRPIX4   1991     printed  Apr 09, 2024@21:34:40                                                                                                                                                                                                    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