- RMPRPIYA ;HINCIO/ODJ - UP - Stock Reconciliation ;3/8/01
- ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
- Q
- ;
- ; Replaces UP option in old PIP (cf UPD^RMPR5NTU)
- UP N RMPRERR,RMPRSTN,RMPREXC,RMPR5,RMPR6,RMPR11,RMPRV,RMPR,RMPRI,RMPROVAL
- N RMPR1,RMPRLCN
- ;
- ; Station
- STN S RMPROVAL=$G(RMPRSTN("IEN"))
- W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
- I RMPRERR G UPX
- I RMPREXC'="" G UPX
- I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11
- ;
- ;***** HCPCS - prompt for HCPCS and Item
- HCPCS W !!,"Reconcile Inventory item quantities on hand...",!
- K RMPR11,RMPR6,RMPRVEND,RMPR5,RMPRQTY,RMPR1
- D HCPCS^RMPRPIY1(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC)
- I RMPREXC="P" G STN
- I RMPREXC="T" G UPX
- I RMPREXC="^" G UPX
- S (RMPR11("STATION"),RMPR11("STATION IEN"))=RMPRSTN("IEN")
- ;
- ;***** LOCN - prompt for location (if more than 1)
- LOCN W ! S RMPRLCN=$$LOC1^RMPRPIYB(RMPRSTN("IEN"))
- I RMPRLCN D G VEND0
- . K RMPR5
- . S RMPR5("IEN")=RMPRLCN
- . S RMPRERR=$$GET^RMPRPIX5(.RMPR5)
- . W !,"Location: "_RMPR5("NAME")
- . Q
- D LOCNM^RMPRPIY7(RMPRSTN("IEN"),.RMPR5,.RMPREXC)
- I RMPREXC="T" G UPX
- I RMPREXC="^" G HCPCS
- I RMPREXC="P" G HCPCS
- ;
- ; Vendor
- VEND0 K RMPR
- S RMPR("STATION IEN")=RMPRSTN("IEN")
- S RMPR("LOCATION IEN")=RMPR5("IEN")
- S RMPR("HCPCS")=RMPR11("HCPCS")
- S RMPR("ITEM")=RMPR11("ITEM")
- K RMPRV
- S RMPRERR=$$STOCK^RMPRPIUV(.RMPR,.RMPRV)
- I RMPRV=0 G VEND
- S RMPRVEND("IEN")=$O(RMPRV(""))
- S RMPRVEND("NAME")=$P(RMPRV(RMPRVEND("IEN")),"^",3)
- S RMPRQTY=$P(RMPRV(RMPRVEND("IEN")),"^",1)
- I RMPRV>1 D
- . W !,"The following Vendors of the selected Item exist in this location..."
- . S RMPRI=""
- . F S RMPRI=$O(RMPRV(RMPRI)) Q:RMPRI="" D
- .. W !,$E($$GETVEN(RMPRI),1,20)
- .. W ?22,$P(RMPRV(RMPRI),"^",1)_" units on hand"
- .. Q
- . Q
- VEND D VEND^RMPRPIY5(.RMPRVEND,.RMPREXC)
- I RMPREXC="T" G UPX
- I RMPREXC="^" G HCPCS
- I RMPREXC="P" G HCPCS
- ;
- ; Quantity
- QTY D QTY^RMPRPIY5(.RMPRQTY,.RMPREXC)
- I RMPREXC="T" G UPX
- I RMPREXC="^" G HCPCS
- I RMPREXC="P" G VEND
- ;
- ; Now create reconciliation record
- TRANS S RMPR11("STATION")=RMPRSTN("IEN")
- S RMPR11("STATION IEN")=RMPRSTN("IEN")
- S RMPR6("QUANTITY")=RMPRQTY
- S RMPR6("VENDOR")=RMPRVEND("IEN")
- S RMPR6("VENDOR IEN")=RMPRVEND("IEN")
- S RMPRERR=$$REC^RMPRPIU9(.RMPR6,.RMPR11,.RMPR5)
- I RMPRERR D
- . W !,"*** There were problems with the reconciliation, please contact support."
- . Q
- E D
- . W !,"*** Item was reconciled..."
- . Q
- H 1
- K RMPR11,RMPR6,RMPRVEND,RMPR5,RMPRQTY,RMPR1
- G HCPCS
- UPX D KILL^XUSCLEAN
- Q
- Q
- ;
- ; Return Vendor Name
- GETVEN(RMPRIEN) ;
- N RMPRFDA,RMPRI,RMPRO,X,Y,DA
- S RMPRI=RMPRIEN_","
- D GETS^DIQ(440,RMPRI,".01","","RMPRO")
- Q RMPRO(440,RMPRI,.01)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIYA 2725 printed Jan 18, 2025@03:38:07 Page 2
- RMPRPIYA ;HINCIO/ODJ - UP - Stock Reconciliation ;3/8/01
- +1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
- +2 QUIT
- +3 ;
- +4 ; Replaces UP option in old PIP (cf UPD^RMPR5NTU)
- UP NEW RMPRERR,RMPRSTN,RMPREXC,RMPR5,RMPR6,RMPR11,RMPRV,RMPR,RMPRI,RMPROVAL
- +1 NEW RMPR1,RMPRLCN
- +2 ;
- +3 ; Station
- STN SET RMPROVAL=$GET(RMPRSTN("IEN"))
- +1 WRITE @IOF
- SET RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
- +2 IF RMPRERR
- GOTO UPX
- +3 IF RMPREXC'=""
- GOTO UPX
- +4 IF RMPROVAL'=RMPRSTN("IEN")
- KILL RMPR1,RMPR11
- +5 ;
- +6 ;***** HCPCS - prompt for HCPCS and Item
- HCPCS WRITE !!,"Reconcile Inventory item quantities on hand...",!
- +1 KILL RMPR11,RMPR6,RMPRVEND,RMPR5,RMPRQTY,RMPR1
- +2 DO HCPCS^RMPRPIY1(RMPRSTN("IEN"),$GET(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC)
- +3 IF RMPREXC="P"
- GOTO STN
- +4 IF RMPREXC="T"
- GOTO UPX
- +5 IF RMPREXC="^"
- GOTO UPX
- +6 SET (RMPR11("STATION"),RMPR11("STATION IEN"))=RMPRSTN("IEN")
- +7 ;
- +8 ;***** LOCN - prompt for location (if more than 1)
- LOCN WRITE !
- SET RMPRLCN=$$LOC1^RMPRPIYB(RMPRSTN("IEN"))
- +1 IF RMPRLCN
- Begin DoDot:1
- +2 KILL RMPR5
- +3 SET RMPR5("IEN")=RMPRLCN
- +4 SET RMPRERR=$$GET^RMPRPIX5(.RMPR5)
- +5 WRITE !,"Location: "_RMPR5("NAME")
- +6 QUIT
- End DoDot:1
- GOTO VEND0
- +7 DO LOCNM^RMPRPIY7(RMPRSTN("IEN"),.RMPR5,.RMPREXC)
- +8 IF RMPREXC="T"
- GOTO UPX
- +9 IF RMPREXC="^"
- GOTO HCPCS
- +10 IF RMPREXC="P"
- GOTO HCPCS
- +11 ;
- +12 ; Vendor
- VEND0 KILL RMPR
- +1 SET RMPR("STATION IEN")=RMPRSTN("IEN")
- +2 SET RMPR("LOCATION IEN")=RMPR5("IEN")
- +3 SET RMPR("HCPCS")=RMPR11("HCPCS")
- +4 SET RMPR("ITEM")=RMPR11("ITEM")
- +5 KILL RMPRV
- +6 SET RMPRERR=$$STOCK^RMPRPIUV(.RMPR,.RMPRV)
- +7 IF RMPRV=0
- GOTO VEND
- +8 SET RMPRVEND("IEN")=$ORDER(RMPRV(""))
- +9 SET RMPRVEND("NAME")=$PIECE(RMPRV(RMPRVEND("IEN")),"^",3)
- +10 SET RMPRQTY=$PIECE(RMPRV(RMPRVEND("IEN")),"^",1)
- +11 IF RMPRV>1
- Begin DoDot:1
- +12 WRITE !,"The following Vendors of the selected Item exist in this location..."
- +13 SET RMPRI=""
- +14 FOR
- SET RMPRI=$ORDER(RMPRV(RMPRI))
- if RMPRI=""
- QUIT
- Begin DoDot:2
- +15 WRITE !,$EXTRACT($$GETVEN(RMPRI),1,20)
- +16 WRITE ?22,$PIECE(RMPRV(RMPRI),"^",1)_" units on hand"
- +17 QUIT
- End DoDot:2
- +18 QUIT
- End DoDot:1
- VEND DO VEND^RMPRPIY5(.RMPRVEND,.RMPREXC)
- +1 IF RMPREXC="T"
- GOTO UPX
- +2 IF RMPREXC="^"
- GOTO HCPCS
- +3 IF RMPREXC="P"
- GOTO HCPCS
- +4 ;
- +5 ; Quantity
- QTY DO QTY^RMPRPIY5(.RMPRQTY,.RMPREXC)
- +1 IF RMPREXC="T"
- GOTO UPX
- +2 IF RMPREXC="^"
- GOTO HCPCS
- +3 IF RMPREXC="P"
- GOTO VEND
- +4 ;
- +5 ; Now create reconciliation record
- TRANS SET RMPR11("STATION")=RMPRSTN("IEN")
- +1 SET RMPR11("STATION IEN")=RMPRSTN("IEN")
- +2 SET RMPR6("QUANTITY")=RMPRQTY
- +3 SET RMPR6("VENDOR")=RMPRVEND("IEN")
- +4 SET RMPR6("VENDOR IEN")=RMPRVEND("IEN")
- +5 SET RMPRERR=$$REC^RMPRPIU9(.RMPR6,.RMPR11,.RMPR5)
- +6 IF RMPRERR
- Begin DoDot:1
- +7 WRITE !,"*** There were problems with the reconciliation, please contact support."
- +8 QUIT
- End DoDot:1
- +9 IF '$TEST
- Begin DoDot:1
- +10 WRITE !,"*** Item was reconciled..."
- +11 QUIT
- End DoDot:1
- +12 HANG 1
- +13 KILL RMPR11,RMPR6,RMPRVEND,RMPR5,RMPRQTY,RMPR1
- +14 GOTO HCPCS
- UPX DO KILL^XUSCLEAN
- +1 QUIT
- +2 QUIT
- +3 ;
- +4 ; Return Vendor Name
- GETVEN(RMPRIEN) ;
- +1 NEW RMPRFDA,RMPRI,RMPRO,X,Y,DA
- +2 SET RMPRI=RMPRIEN_","
- +3 DO GETS^DIQ(440,RMPRI,".01","","RMPRO")
- +4 QUIT RMPRO(440,RMPRI,.01)