RMPRPIY6 ;HINES OIFO/ODJ - EI - Edit Locations and Items ;10/7/02 14:46
;;3.0;PROSTHETICS;**61,145**;Feb 09, 1996;Build 6
Q
;
;***** 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
Q
UNLOCK L -^RMPR(661.7,"XSHIDS",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIY6 9332 printed Dec 13, 2024@02:36:54 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
