RMPRPIY9 ;HINCIO/ODJ - AE - Add/Edit Locations and Items ;3/8/01
;;3.0;PROSTHETICS;**61,108**;Feb 09, 1996
Q
;
;***** AE - Add Inventory LOCATIONS and ITEMS
; option RMPR INV ADD
; Replaces AE option in old PIP (cf ^RMPR5NAE)
; no inputs required
; other than standard VISTA vars. (DUZ, etc)
;
AE N RMPRERR,RMPRSTN,RMPREXC,RMPR5,RMPR1,RMPR11,RMPRVEND,RMPRTVAL,RMPRDUP
N RMPRQTY,RMPRREO,RMPR61,RMPRUCST,RMPROVAL,RMPRI,RMPRUPDF
;
;***** STN - call prompt for Site/Station
STN S RMPROVAL=$G(RMPRSTN("IEN"))
W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
I RMPRERR G AEX
I RMPREXC'="" G AEX
I RMPROVAL'=RMPRSTN("IEN") K RMPR5
;
;***** LOCN - call prompt for Location
LOCN W !!,"Adding Item to a Location.",!
S RMPROVAL=$G(RMPR5("IEN"))
S RMPRERR=$$LOCNM^RMPRPIY2(RMPRSTN("IEN"),.RMPR5,.RMPREXC)
I RMPREXC="T"!(RMPREXC="^") G AEX
I RMPREXC="P" G STN
I RMPROVAL'=RMPR5("IEN") K RMPR1
I $P($G(^RMPR(661.5,RMPR5("IEN"),0)),U,4)="I" W !!,"LOCATION IS INACTIVE AND CANNOT BE EDITED, OR ASSOCIATED ITEMS!!" K RMPR5 G LOCN
LOCN2 S RMPR5("STATION")=RMPRSTN("IEN")
S RMPR5("STATION IEN")=RMPRSTN("IEN")
;
;***** HCPCS - call prompt for HCPCS code
HCPCS S RMPROVAL=$G(RMPR1("HCPCS"))
S RMPR1("HCPCS")=""
W ! S RMPRERR=$$HCPCS^RMPRPIY3(.RMPR5,.RMPR1,.RMPREXC)
I RMPREXC="T"!(RMPREXC="^") G AEX
I RMPREXC="P" G LOCN
I RMPROVAL'=RMPR1("HCPCS") D
. K RMPR11,RMPR61
. S RMPR11("HCPCS")=RMPR1("HCPCS")
. Q
S RMPR11("STATION")=RMPRSTN("IEN")
S RMPR11("STATION IEN")=RMPRSTN("IEN")
;
;***** MASIT - call prompt for master item (in 661->441)
MASIT S RMPROVAL=$G(RMPR61("IEN"))
D MASIT^RMPRPIY1(.RMPR61,.RMPREXC)
I RMPREXC="T" G AEX
I RMPREXC="P" G HCPCS
I RMPREXC="^" G AEX
I RMPROVAL'=RMPR61("IEN") D
. S RMPRERR=$$GET^RMPRPIXD(.RMPR61)
. K RMPRSRC,RMPRREO,RMPR4
. S RMPR11("ITEM MASTER IEN")=RMPR61("IEN")
. S RMPR11("DESCRIPTION")=RMPR61("ITEM MASTER")
. S RMPR11("ITEM MASTER")=RMPR61("ITEM MASTER")
. Q
;
;***** IDESC - call prompt for Item Description edit
IDESC S RMPROVAL=$G(RMPR11("DESCRIPTION"))
D ITED^RMPRPIY4(.RMPR11,.RMPREXC)
I RMPREXC="T" G AEX
I RMPREXC="P" G MASIT
I RMPREXC="^" G HCPCS
I $G(RMPR11("DESCRIPTION"))="" D
. S RMPR11("DESCRIPTION")=RMPR61("ITEM MASTER")
. S RMPR11("ITEM MASTER")=RMPR61("ITEM MASTER")
. Q
I RMPROVAL'=RMPR11("DESCRIPTION") D
. K RMPRSRC,RMPRREO
. Q
;
;***** SRC - call prompt for Source (Commercial or VA)
SRC S RMPROVAL=$G(RMPRSRC)
D SRC^RMPRPIY5(.RMPRSRC,.RMPREXC)
I RMPREXC="P" G IDESC
I RMPREXC="^" G HCPCS
I RMPREXC="T" G AEX
I RMPROVAL'=RMPRSRC K RMPRREO
;
; Update the inventory file (661.11)
S RMPR11("SOURCE")=RMPRSRC
S RMPR11("UNIT")=""
S RMPRERR=0
S RMPRUPDF=1 ;update flag
;
; Only create new record if one doesn't already exist
I $D(^RMPR(661.11,"ASHMDI",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR61("IEN"),RMPR11("DESCRIPTION"))) D
. S RMPRI=""
. F S RMPRI=$O(^RMPR(661.11,"ASHMDI",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR61("IEN"),RMPR11("DESCRIPTION"),RMPRI)) Q:RMPRI="" D Q:'RMPRUPDF
.. S RMPR11("ITEM")=RMPRI
.. S RMPR11("IEN")=""
.. S RMPRERR=$$DUP^RMPRPIX1(.RMPR11,.RMPRDUP)
.. I RMPRERR S RMPRUPDF=0 Q
.. I 'RMPRDUP S RMPRUPDF=0 Q
.. Q
. Q
I RMPRUPDF D
. S RMPR11("ITEM")=""
. K RMPR11("IEN")
. S RMPRERR=$$CRE^RMPRPIX1(.RMPR11)
. S RMPR4("RE-ORDER QTY")=0
. S RMPRERR=$$CRE^RMPRPIX4(.RMPR4,.RMPR11,.RMPR5)
. Q
I RMPRERR D G AEX
. W !,"Problem updating inventory item file, please contact support."
. H 3
. Q
;
;***** REO - call prompt for Re-Order Quantity
REO S RMPROVAL=$G(RMPRREO)
D REO^RMPRPIY5(.RMPRREO,.RMPREXC)
I RMPREXC="P" G SRC
I RMPREXC="^" G HCPCS
I RMPREXC="T" G AEX
;
; Update the reorder file (661.4)
I RMPROVAL=RMPRREO G QTY
S RMPR4("RE-ORDER QTY")=RMPRREO
S RMPRERR=$$UPD^RMPRPIX4(.RMPR4,,)
;
; At this point the item has been added to inventory (661.11) and
; the re-order file (661.4)
; The following prompts are for receipting in a quantity of the item
;
;***** QTY - call prompt for Quantity
QTY D QTY^RMPRPIY5(.RMPRQTY,.RMPREXC)
I RMPREXC="P" G REO
I RMPREXC="^" G HCPCS
I RMPREXC="T" G AEX
S RMPRQTY=+$G(RMPRQTY)
I 'RMPRQTY G QTY
;
;***** UCST - call prompt for Unit Cost
UCST D UCST^RMPRPIY5(.RMPRUCST,.RMPREXC)
I RMPREXC="P" G QTY
I RMPREXC="^" G HCPCS
I RMPREXC="T" G AEX
S RMPRUCST=+$G(RMPRUCST)
;
;***** 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="^" G HCPCS
I RMPREXC="T" G AEX
;
;***** VEND - call prompt for Vendor
VEND D VEND^RMPRPIY5(.RMPRVEND,.RMPREXC)
I RMPREXC="P" G UCST
I RMPREXC="^" G HCPCS
I RMPREXC="T" G AEX
;
;
;***** UNIT - call prompt for UNIT OF ISSUE
UNIT D UNIT^RMPRPIY5(.RMPRUNI,.RMPREXC)
I RMPREXC="P" G UCST
I RMPREXC="^" G HCPCS
I RMPREXC="T" G AEX
;
;***** TRANS - Create receipt record for adding an item
TRANS S RMPR11("STATION")=RMPRSTN("IEN")
S RMPR11("STATION IEN")=RMPRSTN("IEN")
S RMPR6("QUANTITY")=RMPRQTY
S RMPR6("VALUE")=RMPRTVAL
S RMPR6("VENDOR")=RMPRVEND("IEN")
S RMPR6("UNIT")=RMPRUNI("IEN")
S RMPRERR=$$REC^RMPRPIU8(.RMPR6,.RMPR11,.RMPR5,1) ;receipt API
TRANSX I RMPRERR D
. W !!,"** Inventory could not be updated, please contact support",!
. Q
E D
. W !!,"** Inventory updated.",!
.;ask for number of labels and print barcode.
. S RMPR11("HCPCS-ITEM")=RMPR11("HCPCS")_"-"_RMPR11("ITEM")
. D NLAB^RMPRPIYY
. Q
K RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST
G HCPCS
;
;***** exit
AEX D KILL^XUSCLEAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIY9 5774 printed Apr 09, 2024@21:36:35 Page 2
RMPRPIY9 ;HINCIO/ODJ - AE - Add/Edit Locations and Items ;3/8/01
+1 ;;3.0;PROSTHETICS;**61,108**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** AE - Add Inventory LOCATIONS and ITEMS
+5 ; option RMPR INV ADD
+6 ; Replaces AE option in old PIP (cf ^RMPR5NAE)
+7 ; no inputs required
+8 ; other than standard VISTA vars. (DUZ, etc)
+9 ;
AE NEW RMPRERR,RMPRSTN,RMPREXC,RMPR5,RMPR1,RMPR11,RMPRVEND,RMPRTVAL,RMPRDUP
+1 NEW RMPRQTY,RMPRREO,RMPR61,RMPRUCST,RMPROVAL,RMPRI,RMPRUPDF
+2 ;
+3 ;***** 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 AEX
+3 IF RMPREXC'=""
GOTO AEX
+4 IF RMPROVAL'=RMPRSTN("IEN")
KILL RMPR5
+5 ;
+6 ;***** LOCN - call prompt for Location
LOCN WRITE !!,"Adding Item to a Location.",!
+1 SET RMPROVAL=$GET(RMPR5("IEN"))
+2 SET RMPRERR=$$LOCNM^RMPRPIY2(RMPRSTN("IEN"),.RMPR5,.RMPREXC)
+3 IF RMPREXC="T"!(RMPREXC="^")
GOTO AEX
+4 IF RMPREXC="P"
GOTO STN
+5 IF RMPROVAL'=RMPR5("IEN")
KILL RMPR1
+6 IF $PIECE($GET(^RMPR(661.5,RMPR5("IEN"),0)),U,4)="I"
WRITE !!,"LOCATION IS INACTIVE AND CANNOT BE EDITED, OR ASSOCIATED ITEMS!!"
KILL RMPR5
GOTO LOCN
LOCN2 SET RMPR5("STATION")=RMPRSTN("IEN")
+1 SET RMPR5("STATION IEN")=RMPRSTN("IEN")
+2 ;
+3 ;***** HCPCS - call prompt for HCPCS code
HCPCS SET RMPROVAL=$GET(RMPR1("HCPCS"))
+1 SET RMPR1("HCPCS")=""
+2 WRITE !
SET RMPRERR=$$HCPCS^RMPRPIY3(.RMPR5,.RMPR1,.RMPREXC)
+3 IF RMPREXC="T"!(RMPREXC="^")
GOTO AEX
+4 IF RMPREXC="P"
GOTO LOCN
+5 IF RMPROVAL'=RMPR1("HCPCS")
Begin DoDot:1
+6 KILL RMPR11,RMPR61
+7 SET RMPR11("HCPCS")=RMPR1("HCPCS")
+8 QUIT
End DoDot:1
+9 SET RMPR11("STATION")=RMPRSTN("IEN")
+10 SET RMPR11("STATION IEN")=RMPRSTN("IEN")
+11 ;
+12 ;***** MASIT - call prompt for master item (in 661->441)
MASIT SET RMPROVAL=$GET(RMPR61("IEN"))
+1 DO MASIT^RMPRPIY1(.RMPR61,.RMPREXC)
+2 IF RMPREXC="T"
GOTO AEX
+3 IF RMPREXC="P"
GOTO HCPCS
+4 IF RMPREXC="^"
GOTO AEX
+5 IF RMPROVAL'=RMPR61("IEN")
Begin DoDot:1
+6 SET RMPRERR=$$GET^RMPRPIXD(.RMPR61)
+7 KILL RMPRSRC,RMPRREO,RMPR4
+8 SET RMPR11("ITEM MASTER IEN")=RMPR61("IEN")
+9 SET RMPR11("DESCRIPTION")=RMPR61("ITEM MASTER")
+10 SET RMPR11("ITEM MASTER")=RMPR61("ITEM MASTER")
+11 QUIT
End DoDot:1
+12 ;
+13 ;***** IDESC - call prompt for Item Description edit
IDESC SET RMPROVAL=$GET(RMPR11("DESCRIPTION"))
+1 DO ITED^RMPRPIY4(.RMPR11,.RMPREXC)
+2 IF RMPREXC="T"
GOTO AEX
+3 IF RMPREXC="P"
GOTO MASIT
+4 IF RMPREXC="^"
GOTO HCPCS
+5 IF $GET(RMPR11("DESCRIPTION"))=""
Begin DoDot:1
+6 SET RMPR11("DESCRIPTION")=RMPR61("ITEM MASTER")
+7 SET RMPR11("ITEM MASTER")=RMPR61("ITEM MASTER")
+8 QUIT
End DoDot:1
+9 IF RMPROVAL'=RMPR11("DESCRIPTION")
Begin DoDot:1
+10 KILL RMPRSRC,RMPRREO
+11 QUIT
End DoDot:1
+12 ;
+13 ;***** SRC - call prompt for Source (Commercial or VA)
SRC SET RMPROVAL=$GET(RMPRSRC)
+1 DO SRC^RMPRPIY5(.RMPRSRC,.RMPREXC)
+2 IF RMPREXC="P"
GOTO IDESC
+3 IF RMPREXC="^"
GOTO HCPCS
+4 IF RMPREXC="T"
GOTO AEX
+5 IF RMPROVAL'=RMPRSRC
KILL RMPRREO
+6 ;
+7 ; Update the inventory file (661.11)
+8 SET RMPR11("SOURCE")=RMPRSRC
+9 SET RMPR11("UNIT")=""
+10 SET RMPRERR=0
+11 ;update flag
SET RMPRUPDF=1
+12 ;
+13 ; Only create new record if one doesn't already exist
+14 IF $DATA(^RMPR(661.11,"ASHMDI",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR61("IEN"),RMPR11("DESCRIPTION")))
Begin DoDot:1
+15 SET RMPRI=""
+16 FOR
SET RMPRI=$ORDER(^RMPR(661.11,"ASHMDI",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR61("IEN"),RMPR11("DESCRIPTION"),RMPRI))
if RMPRI=""
QUIT
Begin DoDot:2
+17 SET RMPR11("ITEM")=RMPRI
+18 SET RMPR11("IEN")=""
+19 SET RMPRERR=$$DUP^RMPRPIX1(.RMPR11,.RMPRDUP)
+20 IF RMPRERR
SET RMPRUPDF=0
QUIT
+21 IF 'RMPRDUP
SET RMPRUPDF=0
QUIT
+22 QUIT
End DoDot:2
if 'RMPRUPDF
QUIT
+23 QUIT
End DoDot:1
+24 IF RMPRUPDF
Begin DoDot:1
+25 SET RMPR11("ITEM")=""
+26 KILL RMPR11("IEN")
+27 SET RMPRERR=$$CRE^RMPRPIX1(.RMPR11)
+28 SET RMPR4("RE-ORDER QTY")=0
+29 SET RMPRERR=$$CRE^RMPRPIX4(.RMPR4,.RMPR11,.RMPR5)
+30 QUIT
End DoDot:1
+31 IF RMPRERR
Begin DoDot:1
+32 WRITE !,"Problem updating inventory item file, please contact support."
+33 HANG 3
+34 QUIT
End DoDot:1
GOTO AEX
+35 ;
+36 ;***** REO - call prompt for Re-Order Quantity
REO SET RMPROVAL=$GET(RMPRREO)
+1 DO REO^RMPRPIY5(.RMPRREO,.RMPREXC)
+2 IF RMPREXC="P"
GOTO SRC
+3 IF RMPREXC="^"
GOTO HCPCS
+4 IF RMPREXC="T"
GOTO AEX
+5 ;
+6 ; Update the reorder file (661.4)
+7 IF RMPROVAL=RMPRREO
GOTO QTY
+8 SET RMPR4("RE-ORDER QTY")=RMPRREO
+9 SET RMPRERR=$$UPD^RMPRPIX4(.RMPR4,,)
+10 ;
+11 ; At this point the item has been added to inventory (661.11) and
+12 ; the re-order file (661.4)
+13 ; The following prompts are for receipting in a quantity of the item
+14 ;
+15 ;***** QTY - call prompt for Quantity
QTY DO QTY^RMPRPIY5(.RMPRQTY,.RMPREXC)
+1 IF RMPREXC="P"
GOTO REO
+2 IF RMPREXC="^"
GOTO HCPCS
+3 IF RMPREXC="T"
GOTO AEX
+4 SET RMPRQTY=+$GET(RMPRQTY)
+5 IF 'RMPRQTY
GOTO QTY
+6 ;
+7 ;***** UCST - call prompt for Unit Cost
UCST DO UCST^RMPRPIY5(.RMPRUCST,.RMPREXC)
+1 IF RMPREXC="P"
GOTO QTY
+2 IF RMPREXC="^"
GOTO HCPCS
+3 IF RMPREXC="T"
GOTO AEX
+4 SET RMPRUCST=+$GET(RMPRUCST)
+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="^"
GOTO HCPCS
+7 IF RMPREXC="T"
GOTO AEX
+8 ;
+9 ;***** VEND - call prompt for Vendor
VEND DO VEND^RMPRPIY5(.RMPRVEND,.RMPREXC)
+1 IF RMPREXC="P"
GOTO UCST
+2 IF RMPREXC="^"
GOTO HCPCS
+3 IF RMPREXC="T"
GOTO AEX
+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="^"
GOTO HCPCS
+3 IF RMPREXC="T"
GOTO AEX
+4 ;
+5 ;***** TRANS - Create receipt record for adding an item
TRANS SET RMPR11("STATION")=RMPRSTN("IEN")
+1 SET RMPR11("STATION IEN")=RMPRSTN("IEN")
+2 SET RMPR6("QUANTITY")=RMPRQTY
+3 SET RMPR6("VALUE")=RMPRTVAL
+4 SET RMPR6("VENDOR")=RMPRVEND("IEN")
+5 SET RMPR6("UNIT")=RMPRUNI("IEN")
+6 ;receipt API
SET RMPRERR=$$REC^RMPRPIU8(.RMPR6,.RMPR11,.RMPR5,1)
TRANSX IF RMPRERR
Begin DoDot:1
+1 WRITE !!,"** Inventory could not be updated, please contact support",!
+2 QUIT
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 WRITE !!,"** Inventory updated.",!
+5 ;ask for number of labels and print barcode.
+6 SET RMPR11("HCPCS-ITEM")=RMPR11("HCPCS")_"-"_RMPR11("ITEM")
+7 DO NLAB^RMPRPIYY
+8 QUIT
End DoDot:1
+9 KILL RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST
+10 GOTO HCPCS
+11 ;
+12 ;***** exit
AEX DO KILL^XUSCLEAN
+1 QUIT
