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 Dec 13, 2024@02:36:58 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)
