Routine: RMPRPIY6

RMPRPIY6 ;HINES OIFO/ODJ - EI - Edit Locations and Items ;10/7/02  14:46

 ;;3.0;PROSTHETICS;**61,145**;Feb 09, 1996;Build 6

 ;***** EI - Edit Inventory ITEM

 ;           option RMPR INV EDIT

 ;           Replaces EI option in old PIP (cf ^RMPR5NEE)

 ;           no inputs required

 ;           other than standard VISTA vars. (DUZ, etc)

EI N RMPRERR,RMPRSTN,RMPREXC,RMPR5,RMPR1,RMPR11,RMPRVEND,RMPRTVAL,RMPR9M

 N RMPRQTY,RMPRREO,RMPR4,RMPR6,RMPR7,RMPR7M,RMPR6M,RMPR4M,RMPRGLAM

 N RMPR69,RMPR6I,RMPRGLQ,RMPRLCN,RMPRUCST,RMPROVAL,RMPRHCPC,RMPR5P

 N RMPR11M,RMPR11I,RMPR441,RMPRUNI

 ;***** STN - call prompt for Site/Station

STN S RMPROVAL=$G(RMPRSTN("IEN"))

 W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)

 I RMPRERR G EIX

 I RMPREXC'="" G EIX

 I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11,RMPR5,RMPRLCN

 ;***** HCPCS - call prompts for selecting HCPCS and Item

HCPCS W !!,"Editing Inventory Items.",!

 S RMPROVAL=$G(RMPR1("IEN"))

 K RMPR1,RMPR11,RMPR5,RMPRLCN,RMPREXC,RMPRERR,RMPRUNI

 D HCPCS^RMPRPIY7(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC)

 I RMPREXC="T" G EIX

 I RMPREXC="P" G STN

 I RMPREXC="^" D  G EIX

 . W !,"** No HCPCS selected." H 1

. Q

 I $G(RMPR11("IEN"))'="" G HCPCS4

HCPCS3 D ITEM^RMPRPIYP(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR11,.RMPREXC)

 I RMPREXC="T" G EIX

 I RMPREXC="P" G HCPCS

 I RMPREXC="^" G HCPCS

 ; display selected HCPCS and item and continue

HCPCS4 W !!,"HCPCS: "_RMPR1("HCPCS")_" "_RMPR1("SHORT DESC")

 K RMPR11I S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I)

HCPCS4A K RMPR441,RMHCC

 S RMPR441("IEN")=RMPR11I("ITEM MASTER IEN")

 S:RMPR11I("ITEM MASTER IEN")'="" RMPRERR=$$GET^RMPRPIXD(.RMPR441)

 D MASIT^RMPRPIY1(.RMPR441,.RMPREXC)

 I RMPREXC="T" G EIX

 I RMPREXC="P" G HCPCS

 I RMPREXC="^" G HCPCS

 I RMPR441("IEN")'=RMPR11I("ITEM MASTER IEN") D

 . K RMPR11M

 . S RMPR11M("IEN")=RMPR11("IEN")

 . S RMPR11M("ITEM MASTER IEN")=RMPR441("IEN")

 . S RMPRERR=$$UPD^RMPRPIX1(.RMPR11M)

 . K RMPR11

 . S RMPR11("IEN")=RMPR11M("IEN")

 . S RMPRERR=$$GET^RMPRPIX1(.RMPR11)

 . S RMPR11I("ITEM MASTER IEN")=RMPR441("IEN")

 . K RMPR441,RMPR11M

. Q

 ; edit PIP Item desc.

HCPCS5 D ITED^RMPRPIY1(.RMPR11,.RMPREXC)

 I RMPREXC="T" G EIX

 I RMPREXC="^" G HCPCS

 I RMPREXC="P" G HCPCS4A

 ; Lock the current stock 661.7 file at HCPCS Item level as we may be

 ; reducing or increasing the quantity on hand

CURSTL L +^RMPR(661.7,"XSHIDS",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")):5 E  W !,"PROSTHETIC CURRENT STOCK record for HCPCS item open by someone else" G LOCN

 ;***** CURST - call prompt for current stock record

CURST S RMPRLCN="" K RMPR5

 D PVEN^RMPRPIYR(RMPRSTN("IEN"),.RMPRLCN,RMPR11("HCPCS"),RMPR11("ITEM"),.RMPR6,.RMPR7,.RMPREXC)

 I RMPREXC="T" G EIU

 I RMPREXC="P" D UNLOCK G HCPCS5

 I RMPREXC="^" K RMPR6,RMPR7 G RLOC

 I $G(RMPR7("IEN"))="" G RLOC

 S RMPRQTY=RMPR7("QUANTITY")

 S RMPRTVAL=RMPR7("VALUE")

 I RMPR7("QUANTITY")<1 S RMPRUCST=0

 E  S RMPRUCST=+$J(RMPR7("VALUE")/RMPR7("QUANTITY"),0,6)

 S:$D(RMPR7("UNIT")) RMPRUNI("IEN")=RMPR7("UNIT")

 S:$D(RMPR7("UNIT NAME")) RMPRUNI("NAME")=RMPR7("UNIT NAME")

 S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)

 S RMPRVEND("IEN")=RMPR6("VENDOR IEN")

 S RMPRVEND("NAME")=RMPR6("VENDOR")

 S RMPR5("IEN")=RMPRLCN

 S RMPRERR=$$GET^RMPRPIX5(.RMPR5)

 G LOCN

 ;***** RLOC - if no receipt selected get def. loc. from reorder file

RLOC D LOCN^RMPRPIYQ(RMPRSTN("IEN"),.RMPR11,.RMPR5,.RMPREXC)

 I RMPREXC="T" G EIU

 G LOCN

 ;***** LOCN - call prompt for Location

LOCN K RMPR5P M RMPR5P=RMPR5

 S RMPRLCN=$$LOC1^RMPRPIYB(RMPRSTN("IEN"))

 I RMPRLCN D  G REO

 . I $G(RMPR5("IEN"))="" D

 .. S RMPR5("IEN")=RMPRLCN

 .. S RMPRERR=$$GET^RMPRPIX5(.RMPR5)

 .. Q

 . W !,"Location: "_RMPR5("NAME")

. Q

LOCN1 W ! D LOCNM^RMPRPIY7(RMPRSTN("IEN"),.RMPR5,.RMPREXC)

 I RMPREXC="P" D UNLOCK G HCPCS5

 I RMPREXC="^" G EIU

 I RMPREXC="T" G EIU

 S RMPRLCN=RMPR5("IEN")

 ;***** REO - call prompt for Re-Order Quantity (661.4)

REO K RMPR4

 S RMPR4("IEN")=$O(^RMPR(661.4,"ASLHI",RMPRSTN("IEN"),RMPRLCN,RMPR11("HCPCS"),RMPR11("ITEM"),""))

 I RMPR4("IEN")="" D

 . S RMPR4("IEN")=$O(^RMPR(661.4,"ASLHI",RMPRSTN("IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),""))

. Q

 I RMPR4("IEN")="" D

 . S RMPR4("RE-ORDER QTY")=0

. Q

 E  D

 . S RMPRERR=$$GET^RMPRPIX4(.RMPR4)

. Q

 S RMPRREO=RMPR4("RE-ORDER QTY")

REO1 ;

 I '$D(RMPR5P) K RMPR5P M RMPR5P=RMPR5

 D REO^RMPRPIY5(.RMPRREO,.RMPREXC)

 I RMPREXC="P" D UNLOCK G HCPCS5

 I RMPREXC="^" G EIU

 I RMPREXC="T" G EIU

 I RMPRREO'=RMPR4("RE-ORDER QTY")!(RMPR4("IEN")="")!(RMPR5("IEN")'=RMPR5P("IEN")) D

 . K RMPR4M

 . S RMPR4M("RE-ORDER QTY")=RMPRREO

 . I RMPR4("IEN")="" D

 .. S RMPRERR=$$CRE^RMPRPIX4(.RMPR4M,.RMPR11,.RMPR5)

 .. Q

 . E  D

 .. S RMPR4M("IEN")=RMPR4("IEN")

 .. S RMPRERR=$$UPD^RMPRPIX4(.RMPR4M,,)

 .. Q

. Q

 I '$D(RMPR6) G TRANSX ;only editing reorder level

 ;***** SRC - call prompt for SOURCE.

SRC S (RMPRBCK,RMPRSRC)=$P(^RMPR(661.11,RMPR11("IEN"),0),U,5)

 D SRC^RMPRPIY5(.RMPRSRC,.RMPREXC)

 I RMPREXC="P" G SRC

 I RMPREXC="^" D UNLOCK G HCPCS

 I RMPREXC="T" G EIU

 I RMPRSRC'=RMPRBCK S $P(^RMPR(661.11,RMPR11("IEN"),0),U,5)=RMPRSRC

 ;***** QTY - call prompt for Quantity

QTY D QTY^RMPRPIY5(.RMPRQTY,.RMPREXC)

 I RMPREXC="P" G REO

 I RMPREXC="^" D UNLOCK G HCPCS

 I RMPREXC="T" G EIU

 S RMPRQTY=+$G(RMPRQTY)

 ;***** UCST - call prompt for Unit Cost

UCST D UCST^RMPRPIY5(.RMPRUCST,.RMPREXC)

 I RMPREXC="P" G QTY

 I RMPREXC="^" D UNLOCK G HCPCS

 I RMPREXC="T" G EIU

 S RMPRUCST=$J(RMPRUCST,0,2)

 ;***** TVAL - Total Value - use if Unit Cost not used

TVAL I RMPRUCST D  G VEND

 . S RMPRTVAL=$J(RMPRQTY*RMPRUCST,0,2)

 . W !,"TOTAL COST OF QUANTITY: "_RMPRTVAL

. Q

 D TVAL^RMPRPIY5(.RMPRTVAL,.RMPREXC)

 I RMPREXC="P" G UCST

 I RMPREXC="^" D UNLOCK G HCPCS

 I RMPREXC="T" G EIU

 ;***** VEND - call prompt for Vendor

 ;VENDOR edit removed 3/1/08 per Karen Blum

VEND ;D VEND^RMPRPIY5(.RMPRVEND,.RMPREXC)

 ;I RMPREXC="P" G UCST

 ;I RMPREXC="^" D UNLOCK G HCPCS

 ;I RMPREXC="T" G EIU

 ;***** UNIT - call prompt for UNIT OF ISSUE

UNIT D UNIT^RMPRPIY5(.RMPRUNI,.RMPREXC)

 I RMPREXC="P" G UCST

 I RMPREXC="^" D UNLOCK G HCPCS

 I RMPREXC="T" G EIU

 S RMPRUNI("UNIT")=RMPRUNI("IEN")

 ;***** TRANS - Modify current stock record

TRANS K RMPR7M,RMPR6M

 I $G(RMHCC) D TRANS^RMPRPIXF G HAL

 K RMPR6I

 S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I)

 ;if unit of issue changed

 I RMPRUNI("UNIT")'=RMPR7("UNIT") S RMPR7M("UNIT")=RMPRUNI("UNIT") D

 . S RMPR7M("IEN")=RMPR7("IEN")

 . S RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)

 ; Modify Location in 661.6 and 661.7 if changed

 I RMPR6I("LOCATION")'=RMPR5("IEN") D

 . S RMPR6M("LOCATION")=RMPR5("IEN")

 . S RMPR6M("IEN")=RMPR6("IEN")

 . S RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,)

 . S RMPR7M("LOCATION")=RMPR5("IEN")

 . S RMPR7M("IEN")=RMPR7("IEN")

 . S RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)

 . K RMPR6M,RMPR7M

. Q

 ; Modify Quantity or Value in current stock 661.7 record, the

 ; transaction record 661.6 and running balance 661.9, if changed

 I +RMPRQTY'=+RMPR7("QUANTITY")!(+RMPRTVAL'=+RMPR7("VALUE")) D

 . K RMPR69,RMPR9M

 . I RMPR6I("TRAN TYPE")=9 D

 .. S RMPR69("TRANS IEN")=RMPR6("IEN")

 .. S RMPRERR=$$GET^RMPRPIXB(.RMPR69)

 .. Q

 . S (RMPR9M("TQTY"),RMPR9M("TCST"),RMPRGLQ,RMPRGLAM)=0

 . I +RMPRQTY'=+RMPR7("QUANTITY") D  Q:RMPR7M("QUANTITY")<0

 .. S RMPR6M("QUANTITY")=RMPRQTY

 .. S RMPRGLQ=RMPRQTY-RMPR7("QUANTITY")

 ..; S RMPR7M("QUANTITY")=RMPR7("QUANTITY")+RMPRGLQ

 .. S RMPR7M("QUANTITY")=RMPRQTY

 .. S RMPR9M("TQTY")=RMPRGLQ

 .. S:$D(RMPR69) RMPR69("GAIN/LOSS")=RMPR69("GAIN/LOSS")+RMPRGLQ

 .. Q

 . I +RMPRTVAL'=+RMPR7("VALUE") D

 .. S RMPR6M("VALUE")=RMPRTVAL

 .. S RMPRGLAM=RMPRTVAL-RMPR7("VALUE")

 .. S RMPR7M("VALUE")=RMPR7("VALUE")+RMPRGLAM,RMPR7M("VALUE")=$J(RMPR7M("VALUE"),0,2)

 .. S RMPR9M("TCST")=RMPRGLAM

 .. S:$D(RMPR69) RMPR69("GAIN/LOSS VALUE")=RMPR69("GAIN/LOSS VALUE")+RMPRGLAM

 .. Q

 . S RMPR7M("IEN")=RMPR7("IEN")

 . S RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)

 . S RMPR6M("IEN")=RMPR6("IEN")

 . S RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,)

 . I $D(RMPR69) S RMPRERR=$$UPD^RMPRPIXB(.RMPR69)

 . S RMPR9M("STA")=RMPRSTN("IEN")

 . S RMPR9M("HCP")=RMPR11("HCPCS")

 . S RMPR9M("ITE")=RMPR11("ITEM")

 . S RMPRERR=$$DTIEN^RMPRPIX6(.RMPR6)

 . S RMPR9M("RDT")=$P(RMPR6("DATE&TIME"),".",1)

 . S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9M)

 . K RMPR7M,RMPR6M,RMPR9M

. Q

 I $D(RMPR7M("QUANTITY")),RMPR7M("QUANTITY")<1 D  G QTY

 . W !,"The quantity cannot be allowed because it would cause a",!

 . W "negative on hand quantity.",!

 . W "Please check your inventory and use the reconciliation option",!

 . W "as needed.",!

. Q

TRANSX I 'RMPRERR D

 . W !!,"** Item "

 . W RMPR11("HCPCS-ITEM")

 . W " was "

 . W "Edited by "

 . W $$GETUSR^RMPRPIU0(DUZ)

 . W:$D(RMPRGLQ) ": ("_$S(RMPRGLQ>0:"+",1:"")_RMPRGLQ_")"

 . W " @ Location ",RMPR5("NAME")

. Q

 E  D

 . W !!,"** The Item could not be modified due to a problem - please contact support"

. Q

 D UNLOCK

HAL H 2

 K RMPRTVAL,RMPRUCST,RMPR6,RMPR7,RMPRVEND,RMPRQTY,RMPRREO,RMPRGLQ,RMPRGLAM

 G HCPCS

 ;***** exit points

EIU D UNLOCK

EIX D KILL^XUSCLEAN

UNLOCK L -^RMPR(661.7,"XSHIDS",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIY6   9332     printed  Mar 13, 2025@21:41:48                                                                                                                                                                                                    Page 2

RMPRPIY6  ;HINES OIFO/ODJ - EI - Edit Locations and Items ;10/7/02  14:46

 +1       ;;3.0;PROSTHETICS;**61,145**;Feb 09, 1996;Build 6

 +2        QUIT

 +3       ;

 +4       ;***** EI - Edit Inventory ITEM

 +5       ;           option RMPR INV EDIT

 +6       ;           Replaces EI option in old PIP (cf ^RMPR5NEE)

 +7       ;           no inputs required

 +8       ;           other than standard VISTA vars. (DUZ, etc)

 +9       ;

EI         NEW RMPRERR,RMPRSTN,RMPREXC,RMPR5,RMPR1,RMPR11,RMPRVEND,RMPRTVAL,RMPR9M

 +1        NEW RMPRQTY,RMPRREO,RMPR4,RMPR6,RMPR7,RMPR7M,RMPR6M,RMPR4M,RMPRGLAM

 +2        NEW RMPR69,RMPR6I,RMPRGLQ,RMPRLCN,RMPRUCST,RMPROVAL,RMPRHCPC,RMPR5P

 +3        NEW RMPR11M,RMPR11I,RMPR441,RMPRUNI

 +4       ;

 +5       ;***** STN - call prompt for Site/Station

STN        SET RMPROVAL=$GET(RMPRSTN("IEN"))

 +1        WRITE @IOF

           SET RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)

 +2        IF RMPRERR

               GOTO EIX

 +3        IF RMPREXC'=""

               GOTO EIX

 +4        IF RMPROVAL'=RMPRSTN("IEN")

               KILL RMPR1,RMPR11,RMPR5,RMPRLCN

 +5       ;

 +6       ;***** HCPCS - call prompts for selecting HCPCS and Item

HCPCS      WRITE !!,"Editing Inventory Items.",!

 +1        SET RMPROVAL=$GET(RMPR1("IEN"))

 +2        KILL RMPR1,RMPR11,RMPR5,RMPRLCN,RMPREXC,RMPRERR,RMPRUNI

 +3        DO HCPCS^RMPRPIY7(RMPRSTN("IEN"),$GET(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC)

 +4        IF RMPREXC="T"

               GOTO EIX

 +5        IF RMPREXC="P"

               GOTO STN

 +6        IF RMPREXC="^"

               Begin DoDot:1

 +7                WRITE !,"** No HCPCS selected."

                   HANG 1

 +8                QUIT

               End DoDot:1

               GOTO EIX

 +9        IF $GET(RMPR11("IEN"))'=""

               GOTO HCPCS4

HCPCS3     DO ITEM^RMPRPIYP(RMPRSTN("IEN"),$GET(RMPR1("HCPCS")),.RMPR11,.RMPREXC)

 +1        IF RMPREXC="T"

               GOTO EIX

 +2        IF RMPREXC="P"

               GOTO HCPCS

 +3        IF RMPREXC="^"

               GOTO HCPCS

 +4       ;

 +5       ; display selected HCPCS and item and continue

HCPCS4     WRITE !!,"HCPCS: "_RMPR1("HCPCS")_" "_RMPR1("SHORT DESC")

 +1        KILL RMPR11I

           SET RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I)

HCPCS4A    KILL RMPR441,RMHCC

 +1        SET RMPR441("IEN")=RMPR11I("ITEM MASTER IEN")

 +2        if RMPR11I("ITEM MASTER IEN")'=""

               SET RMPRERR=$$GET^RMPRPIXD(.RMPR441)

 +3        DO MASIT^RMPRPIY1(.RMPR441,.RMPREXC)

 +4        IF RMPREXC="T"

               GOTO EIX

 +5        IF RMPREXC="P"

               GOTO HCPCS

 +6        IF RMPREXC="^"

               GOTO HCPCS

 +7        IF RMPR441("IEN")'=RMPR11I("ITEM MASTER IEN")

               Begin DoDot:1

 +8                KILL RMPR11M

 +9                SET RMPR11M("IEN")=RMPR11("IEN")

 +10               SET RMPR11M("ITEM MASTER IEN")=RMPR441("IEN")

 +11               SET RMPRERR=$$UPD^RMPRPIX1(.RMPR11M)

 +12               KILL RMPR11

 +13               SET RMPR11("IEN")=RMPR11M("IEN")

 +14               SET RMPRERR=$$GET^RMPRPIX1(.RMPR11)

 +15               SET RMPR11I("ITEM MASTER IEN")=RMPR441("IEN")

 +16               KILL RMPR441,RMPR11M

 +17               QUIT

               End DoDot:1

 +18      ;

 +19      ; edit PIP Item desc.

HCPCS5     DO ITED^RMPRPIY1(.RMPR11,.RMPREXC)

 +1        IF RMPREXC="T"

               GOTO EIX

 +2        IF RMPREXC="^"

               GOTO HCPCS

 +3        IF RMPREXC="P"

               GOTO HCPCS4A

 +4       ;

 +5       ; Lock the current stock 661.7 file at HCPCS Item level as we may be

 +6       ; reducing or increasing the quantity on hand

CURSTL     LOCK +^RMPR(661.7,"XSHIDS",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")):5

          IF '$TEST

               WRITE !,"PROSTHETIC CURRENT STOCK record for HCPCS item open by someone else"

               GOTO LOCN

 +1       ;

 +2       ;***** CURST - call prompt for current stock record

CURST      SET RMPRLCN=""

           KILL RMPR5

 +1        DO PVEN^RMPRPIYR(RMPRSTN("IEN"),.RMPRLCN,RMPR11("HCPCS"),RMPR11("ITEM"),.RMPR6,.RMPR7,.RMPREXC)

 +2        IF RMPREXC="T"

               GOTO EIU

 +3        IF RMPREXC="P"

               DO UNLOCK

               GOTO HCPCS5

 +4        IF RMPREXC="^"

               KILL RMPR6,RMPR7

               GOTO RLOC

 +5        IF $GET(RMPR7("IEN"))=""

               GOTO RLOC

 +6        SET RMPRQTY=RMPR7("QUANTITY")

 +7        SET RMPRTVAL=RMPR7("VALUE")

 +8        IF RMPR7("QUANTITY")<1

               SET RMPRUCST=0

 +9       IF '$TEST

               SET RMPRUCST=+$JUSTIFY(RMPR7("VALUE")/RMPR7("QUANTITY"),0,6)

 +10       if $DATA(RMPR7("UNIT"))

               SET RMPRUNI("IEN")=RMPR7("UNIT")

 +11       if $DATA(RMPR7("UNIT NAME"))

               SET RMPRUNI("NAME")=RMPR7("UNIT NAME")

 +12       SET RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)

 +13       SET RMPRVEND("IEN")=RMPR6("VENDOR IEN")

 +14       SET RMPRVEND("NAME")=RMPR6("VENDOR")

 +15       SET RMPR5("IEN")=RMPRLCN

 +16       SET RMPRERR=$$GET^RMPRPIX5(.RMPR5)

 +17       GOTO LOCN

 +18      ;

 +19      ;***** RLOC - if no receipt selected get def. loc. from reorder file

RLOC       DO LOCN^RMPRPIYQ(RMPRSTN("IEN"),.RMPR11,.RMPR5,.RMPREXC)

 +1        IF RMPREXC="T"

               GOTO EIU

 +2        GOTO LOCN

 +3       ;

 +4       ;***** LOCN - call prompt for Location

LOCN       KILL RMPR5P

           MERGE RMPR5P=RMPR5

 +1        SET RMPRLCN=$$LOC1^RMPRPIYB(RMPRSTN("IEN"))

 +2        IF RMPRLCN

               Begin DoDot:1

 +3                IF $GET(RMPR5("IEN"))=""

                       Begin DoDot:2

 +4                        SET RMPR5("IEN")=RMPRLCN

 +5                        SET RMPRERR=$$GET^RMPRPIX5(.RMPR5)

 +6                        QUIT

                       End DoDot:2

 +7                WRITE !,"Location: "_RMPR5("NAME")

 +8                QUIT

               End DoDot:1

               GOTO REO

LOCN1      WRITE !

           DO LOCNM^RMPRPIY7(RMPRSTN("IEN"),.RMPR5,.RMPREXC)

 +1        IF RMPREXC="P"

               DO UNLOCK

               GOTO HCPCS5

 +2        IF RMPREXC="^"

               GOTO EIU

 +3        IF RMPREXC="T"

               GOTO EIU

 +4        SET RMPRLCN=RMPR5("IEN")

 +5       ;

 +6       ;***** REO - call prompt for Re-Order Quantity (661.4)

REO        KILL RMPR4

 +1        SET RMPR4("IEN")=$ORDER(^RMPR(661.4,"ASLHI",RMPRSTN("IEN"),RMPRLCN,RMPR11("HCPCS"),RMPR11("ITEM"),""))

 +2        IF RMPR4("IEN")=""

               Begin DoDot:1

 +3                SET RMPR4("IEN")=$ORDER(^RMPR(661.4,"ASLHI",RMPRSTN("IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),""))

 +4                QUIT

               End DoDot:1

 +5        IF RMPR4("IEN")=""

               Begin DoDot:1

 +6                SET RMPR4("RE-ORDER QTY")=0

 +7                QUIT

               End DoDot:1

 +8       IF '$TEST

               Begin DoDot:1

 +9                SET RMPRERR=$$GET^RMPRPIX4(.RMPR4)

 +10               QUIT

               End DoDot:1

 +11       SET RMPRREO=RMPR4("RE-ORDER QTY")

REO1      ;

 +1        IF '$DATA(RMPR5P)

               KILL RMPR5P

               MERGE RMPR5P=RMPR5

 +2        DO REO^RMPRPIY5(.RMPRREO,.RMPREXC)

 +3        IF RMPREXC="P"

               DO UNLOCK

               GOTO HCPCS5

 +4        IF RMPREXC="^"

               GOTO EIU

 +5        IF RMPREXC="T"

               GOTO EIU

 +6        IF RMPRREO'=RMPR4("RE-ORDER QTY")!(RMPR4("IEN")="")!(RMPR5("IEN")'=RMPR5P("IEN"))

               Begin DoDot:1

 +7                KILL RMPR4M

 +8                SET RMPR4M("RE-ORDER QTY")=RMPRREO

 +9                IF RMPR4("IEN")=""

                       Begin DoDot:2

 +10                       SET RMPRERR=$$CRE^RMPRPIX4(.RMPR4M,.RMPR11,.RMPR5)

 +11                       QUIT

                       End DoDot:2

 +12              IF '$TEST

                       Begin DoDot:2

 +13                       SET RMPR4M("IEN")=RMPR4("IEN")

 +14                       SET RMPRERR=$$UPD^RMPRPIX4(.RMPR4M,,)

 +15                       QUIT

                       End DoDot:2

 +16               QUIT

               End DoDot:1

 +17      ;only editing reorder level

           IF '$DATA(RMPR6)

               GOTO TRANSX

 +18      ;

 +19      ;***** SRC - call prompt for SOURCE.

SRC        SET (RMPRBCK,RMPRSRC)=$PIECE(^RMPR(661.11,RMPR11("IEN"),0),U,5)

 +1        DO SRC^RMPRPIY5(.RMPRSRC,.RMPREXC)

 +2        IF RMPREXC="P"

               GOTO SRC

 +3        IF RMPREXC="^"

               DO UNLOCK

               GOTO HCPCS

 +4        IF RMPREXC="T"

               GOTO EIU

 +5        IF RMPRSRC'=RMPRBCK

               SET $PIECE(^RMPR(661.11,RMPR11("IEN"),0),U,5)=RMPRSRC

 +6       ;***** QTY - call prompt for Quantity

QTY        DO QTY^RMPRPIY5(.RMPRQTY,.RMPREXC)

 +1        IF RMPREXC="P"

               GOTO REO

 +2        IF RMPREXC="^"

               DO UNLOCK

               GOTO HCPCS

 +3        IF RMPREXC="T"

               GOTO EIU

 +4        SET RMPRQTY=+$GET(RMPRQTY)

 +5       ;

 +6       ;***** UCST - call prompt for Unit Cost

UCST       DO UCST^RMPRPIY5(.RMPRUCST,.RMPREXC)

 +1        IF RMPREXC="P"

               GOTO QTY

 +2        IF RMPREXC="^"

               DO UNLOCK

               GOTO HCPCS

 +3        IF RMPREXC="T"

               GOTO EIU

 +4        SET RMPRUCST=$JUSTIFY(RMPRUCST,0,2)

 +5       ;

 +6       ;***** TVAL - Total Value - use if Unit Cost not used

TVAL       IF RMPRUCST

               Begin DoDot:1

 +1                SET RMPRTVAL=$JUSTIFY(RMPRQTY*RMPRUCST,0,2)

 +2                WRITE !,"TOTAL COST OF QUANTITY: "_RMPRTVAL

 +3                QUIT

               End DoDot:1

               GOTO VEND

 +4        DO TVAL^RMPRPIY5(.RMPRTVAL,.RMPREXC)

 +5        IF RMPREXC="P"

               GOTO UCST

 +6        IF RMPREXC="^"

               DO UNLOCK

               GOTO HCPCS

 +7        IF RMPREXC="T"

               GOTO EIU

 +8       ;

 +9       ;***** VEND - call prompt for Vendor

 +10      ;VENDOR edit removed 3/1/08 per Karen Blum

VEND      ;D VEND^RMPRPIY5(.RMPRVEND,.RMPREXC)

 +1       ;I RMPREXC="P" G UCST

 +2       ;I RMPREXC="^" D UNLOCK G HCPCS

 +3       ;I RMPREXC="T" G EIU

 +4       ;

 +5       ;

 +6       ;***** UNIT - call prompt for UNIT OF ISSUE

UNIT       DO UNIT^RMPRPIY5(.RMPRUNI,.RMPREXC)

 +1        IF RMPREXC="P"

               GOTO UCST

 +2        IF RMPREXC="^"

               DO UNLOCK

               GOTO HCPCS

 +3        IF RMPREXC="T"

               GOTO EIU

 +4        SET RMPRUNI("UNIT")=RMPRUNI("IEN")

 +5       ;

 +6       ;***** TRANS - Modify current stock record

TRANS      KILL RMPR7M,RMPR6M

 +1       ;

 +2        IF $GET(RMHCC)

               DO TRANS^RMPRPIXF

               GOTO HAL

 +3       ;

 +4        KILL RMPR6I

 +5        SET RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I)

 +6       ;

 +7       ;if unit of issue changed

 +8        IF RMPRUNI("UNIT")'=RMPR7("UNIT")

               SET RMPR7M("UNIT")=RMPRUNI("UNIT")

               Begin DoDot:1

 +9                SET RMPR7M("IEN")=RMPR7("IEN")

 +10               SET RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)

               End DoDot:1

 +11      ; Modify Location in 661.6 and 661.7 if changed

 +12       IF RMPR6I("LOCATION")'=RMPR5("IEN")

               Begin DoDot:1

 +13               SET RMPR6M("LOCATION")=RMPR5("IEN")

 +14               SET RMPR6M("IEN")=RMPR6("IEN")

 +15               SET RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,)

 +16               SET RMPR7M("LOCATION")=RMPR5("IEN")

 +17               SET RMPR7M("IEN")=RMPR7("IEN")

 +18               SET RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)

 +19               KILL RMPR6M,RMPR7M

 +20               QUIT

               End DoDot:1

 +21      ;

 +22      ; Modify Quantity or Value in current stock 661.7 record, the

 +23      ; transaction record 661.6 and running balance 661.9, if changed

 +24       IF +RMPRQTY'=+RMPR7("QUANTITY")!(+RMPRTVAL'=+RMPR7("VALUE"))

               Begin DoDot:1

 +25               KILL RMPR69,RMPR9M

 +26               IF RMPR6I("TRAN TYPE")=9

                       Begin DoDot:2

 +27                       SET RMPR69("TRANS IEN")=RMPR6("IEN")

 +28                       SET RMPRERR=$$GET^RMPRPIXB(.RMPR69)

 +29                       QUIT

                       End DoDot:2

 +30               SET (RMPR9M("TQTY"),RMPR9M("TCST"),RMPRGLQ,RMPRGLAM)=0

 +31               IF +RMPRQTY'=+RMPR7("QUANTITY")

                       Begin DoDot:2

 +32                       SET RMPR6M("QUANTITY")=RMPRQTY

 +33                       SET RMPRGLQ=RMPRQTY-RMPR7("QUANTITY")

 +34      ; S RMPR7M("QUANTITY")=RMPR7("QUANTITY")+RMPRGLQ

 +35                       SET RMPR7M("QUANTITY")=RMPRQTY

 +36                       SET RMPR9M("TQTY")=RMPRGLQ

 +37                       if $DATA(RMPR69)

                               SET RMPR69("GAIN/LOSS")=RMPR69("GAIN/LOSS")+RMPRGLQ

 +38                       QUIT

                       End DoDot:2

                       if RMPR7M("QUANTITY")<0

                           QUIT

 +39               IF +RMPRTVAL'=+RMPR7("VALUE")

                       Begin DoDot:2

 +40                       SET RMPR6M("VALUE")=RMPRTVAL

 +41                       SET RMPRGLAM=RMPRTVAL-RMPR7("VALUE")

 +42                       SET RMPR7M("VALUE")=RMPR7("VALUE")+RMPRGLAM

                           SET RMPR7M("VALUE")=$JUSTIFY(RMPR7M("VALUE"),0,2)

 +43                       SET RMPR9M("TCST")=RMPRGLAM

 +44                       if $DATA(RMPR69)

                               SET RMPR69("GAIN/LOSS VALUE")=RMPR69("GAIN/LOSS VALUE")+RMPRGLAM

 +45                       QUIT

                       End DoDot:2

 +46               SET RMPR7M("IEN")=RMPR7("IEN")

 +47               SET RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)

 +48               SET RMPR6M("IEN")=RMPR6("IEN")

 +49               SET RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,)

 +50               IF $DATA(RMPR69)

                       SET RMPRERR=$$UPD^RMPRPIXB(.RMPR69)

 +51               SET RMPR9M("STA")=RMPRSTN("IEN")

 +52               SET RMPR9M("HCP")=RMPR11("HCPCS")

 +53               SET RMPR9M("ITE")=RMPR11("ITEM")

 +54               SET RMPRERR=$$DTIEN^RMPRPIX6(.RMPR6)

 +55               SET RMPR9M("RDT")=$PIECE(RMPR6("DATE&TIME"),".",1)

 +56               SET RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9M)

 +57               KILL RMPR7M,RMPR6M,RMPR9M

 +58               QUIT

               End DoDot:1

 +59       IF $DATA(RMPR7M("QUANTITY"))

               IF RMPR7M("QUANTITY")<1

                   Begin DoDot:1

 +60                   WRITE !,"The quantity cannot be allowed because it would cause a",!

 +61                   WRITE "negative on hand quantity.",!

 +62                   WRITE "Please check your inventory and use the reconciliation option",!

 +63                   WRITE "as needed.",!

 +64                   QUIT

                   End DoDot:1

                   GOTO QTY

TRANSX     IF 'RMPRERR

               Begin DoDot:1

 +1                WRITE !!,"** Item "

 +2                WRITE RMPR11("HCPCS-ITEM")

 +3                WRITE " was "

 +4                WRITE "Edited by "

 +5                WRITE $$GETUSR^RMPRPIU0(DUZ)

 +6                if $DATA(RMPRGLQ)

                       WRITE ": ("_$SELECT(RMPRGLQ>0:"+",1:"")_RMPRGLQ_")"

 +7                WRITE " @ Location ",RMPR5("NAME")

 +8                QUIT

               End DoDot:1

 +9       IF '$TEST

               Begin DoDot:1

 +10               WRITE !!,"** The Item could not be modified due to a problem - please contact support"

 +11               QUIT

               End DoDot:1

 +12       DO UNLOCK

HAL        HANG 2

 +1        KILL RMPRTVAL,RMPRUCST,RMPR6,RMPR7,RMPRVEND,RMPRQTY,RMPRREO,RMPRGLQ,RMPRGLAM

 +2        GOTO HCPCS

 +3       ;

 +4       ;***** exit points

EIU        DO UNLOCK

EIX        DO KILL^XUSCLEAN

 +1        QUIT

UNLOCK     LOCK -^RMPR(661.7,"XSHIDS",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))

 +1        QUIT

RMPRPIY6.m