- 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 Jan 18, 2025@03:38:06 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