215 lines
6.9 KiB
Mathematica
215 lines
6.9 KiB
Mathematica
RMPRPIYG ;HINCIO/ODJ - RC - PIP Receive Stock ;3/8/01
|
|
;;3.0;PROSTHETICS;**61,132**;Feb 09, 1996;Build 13
|
|
Q
|
|
;
|
|
;***** RC - Replaces RC option in old PIP
|
|
; RMPR INV RECEIVE
|
|
; cf. REC^RMPR5NOR
|
|
; Callable from VISTA menu, no vars required other than
|
|
; global VISTA vars (DUZ, etc)
|
|
;
|
|
RC N RMPRERR,RMPRSTN,RMPRLCN,RMPREXC,RMPR5,RMPR1,RMPR11,RMPROVAL
|
|
N RMPRVEND,RMPRQTY,RMPRTVAL,RMPR4,RMPRUCST,RMPRQ,RMPRIOP,RMPRNLAB
|
|
N RMPRBARC,RMPRITXT,RMPRBCP,RMPR41,RMPR41N,RMPRYN
|
|
;
|
|
;***** STN - prompt for Site/Station
|
|
STN S RMPROVAL=$G(RMPRSTN("IEN"))
|
|
W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
|
|
I RMPRERR G RCX
|
|
I RMPREXC'="" G RCX
|
|
I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11
|
|
S RMPR("NAME")=RMPRSTN("SITE NAME")
|
|
;
|
|
;***** HCPCS - prompt for HCPCS
|
|
HCPCS W !!,"Receive an Item from Supply, Vendor or Veteran.",!
|
|
K RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST,RMPRBCP,RMPRQ,RMPRIOP,RMPRNLAB
|
|
K RMPRBARC,RMPRITXT,RMPR41N,RMPR41,RMPRVEND,RMPR1,RMPR11,RMPRUNI
|
|
HCPCS2 D HCPCS^RMPRPIY7(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC)
|
|
I RMPREXC="T" G RCX
|
|
I RMPREXC="P"!(RMPREXC="^") D G RCX
|
|
. W !,"** No HCPCS selected." H 1
|
|
. Q
|
|
I $G(RMPR11("IEN"))'="" G HCPCS4
|
|
HCPCS3 D ITEM^RMPRPIYP(RMPRSTN("IEN"),RMPR1("HCPCS"),.RMPR11,.RMPREXC)
|
|
I RMPREXC="T" G RCX
|
|
I RMPREXC="P"!(RMPREXC="^") G HCPCS
|
|
S RMPR11("STATION")=RMPRSTN("IEN")
|
|
S RMPR11("STATION IEN")=RMPRSTN("IEN")
|
|
;
|
|
; display selected HCPCS and item and continue
|
|
HCPCS4 W !!,"HCPCS: "_$G(RMPR1("HCPCS"))_" "_$G(RMPR1("SHORT DESC"))
|
|
W !!,"IFCAP Item: ",$G(RMPR11("ITEM MASTER"))
|
|
W !!,"PIP Item desc.: ",$G(RMPR11("DESCRIPTION"))
|
|
;
|
|
; call module to display and select orders
|
|
PORD D PORD^RMPRPIYY(RMPRSTN("IEN"),RMPR1("HCPCS"),RMPR11("ITEM"),.RMPR41,.RMPREXC)
|
|
I RMPREXC="P" G HCPCS
|
|
I RMPREXC="T" G RCX
|
|
I RMPREXC="",+$G(RMPR41("IEN")) D
|
|
. S RMPRQTY=RMPR41("BALANCE QTY")
|
|
. K RMPRVEND
|
|
. S RMPRVEND("IEN")=RMPR41("VENDOR IEN")
|
|
. Q
|
|
;
|
|
;***** QTY - call prompt for Quantity
|
|
QTY K RMPR41N("ORDER QTY")
|
|
W ! D QTY^RMPRPIY5(.RMPRQTY,.RMPREXC)
|
|
I RMPREXC="T" G RCX
|
|
I RMPREXC="^" D MESS G HCPCS
|
|
I RMPREXC="P" G HCPCS
|
|
S RMPRQTY=+$G(RMPRQTY)
|
|
I 'RMPRQTY D G HCPCS
|
|
. W !,"No quantity entered!"
|
|
. H 3
|
|
. Q
|
|
I +$G(RMPR41("IEN")),RMPRQTY>RMPR41("BALANCE QTY") G QTYA
|
|
G UCST
|
|
;
|
|
; If receive quantity is greater than o/s order balance ask if
|
|
; changing the order qty
|
|
QTYA D YNQTY(.RMPRYN,.RMPREXC)
|
|
I RMPREXC="T" G RCX
|
|
I RMPREXC="^" D MESS G HCPCS
|
|
I RMPREXC="P" G QTY
|
|
I RMPRYN="N" G QTY
|
|
S RMPR41N("ORDER QTY")=RMPR41("ORDER QTY")+(RMPRQTY-RMPR41("BALANCE QTY"))
|
|
;
|
|
;***** UCST - call prompt for Unit Cost
|
|
UCST D UCST^RMPRPIY5(.RMPRUCST,.RMPREXC)
|
|
I RMPREXC="P" G QTY
|
|
I RMPREXC="^" D MESS G HCPCS
|
|
I RMPREXC="T" G RCX
|
|
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="^" D MESS G HCPCS
|
|
I RMPREXC="T" G RCX
|
|
;
|
|
;***** VEND - prompt for Vendor
|
|
VEND K RMPR41N("VENDOR IEN")
|
|
D VEND^RMPRPIY5(.RMPRVEND,.RMPREXC)
|
|
I RMPREXC="T" G RCX
|
|
I RMPREXC="^" D MESS G HCPCS
|
|
I RMPREXC="P" G UCST
|
|
I RMPRVEND("IEN")=$G(RMPR41("VENDOR IEN")) G UNIT
|
|
;
|
|
;***** VENDA - vendor not same as order vendor so asK if changing
|
|
D YNVND(.RMPRYN,.RMPREXC)
|
|
I RMPREXC="T" G RCX
|
|
I RMPREXC="^" D MESS G HCPCS
|
|
I RMPREXC="P" G VEND
|
|
I RMPRYN="N" G UNIT
|
|
S RMPR41N("VENDOR IEN")=RMPRVEND("IEN")
|
|
;
|
|
;***** UNIT - call prompt for UNIT OF ISSUE
|
|
UNIT D UNIT^RMPRPIY5(.RMPRUNI,.RMPREXC)
|
|
I RMPREXC="P" G UCST
|
|
I RMPREXC="^" D MESS G HCPCS
|
|
I RMPREXC="T" G RCX
|
|
S RMPRUNI("UNIT")=RMPRUNI("IEN")
|
|
;
|
|
;***** LOCN - prompt for location (if more than 1)
|
|
LOCN S RMPRLCN=$$LOC1^RMPRPIYB(RMPRSTN("IEN"))
|
|
I RMPRLCN D G TRANS
|
|
. 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 RCX
|
|
I RMPREXC="^" D MESS G HCPCS
|
|
I RMPREXC="P" G UCST
|
|
;
|
|
;***** TRANS - Now create receipt transaction
|
|
TRANS S RMPR11("STATION")=RMPRSTN("IEN")
|
|
S RMPR11("STATION IEN")=RMPRSTN("IEN")
|
|
I '$D(^RMPR(661.4,"ASLHI",RMPRSTN("IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))) D
|
|
. S RMPR4("RE-ORDER QTY")=0
|
|
. S RMPRERR=$$CRE^RMPRPIX4(.RMPR4,.RMPR11,.RMPR5)
|
|
. Q
|
|
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("UNIT")
|
|
I $D(RMPR41N("ORDER QTY")) S RMPR41("ORDER QTY")=RMPR41N("ORDER QTY")
|
|
I $D(RMPR41N("VENDOR IEN")) S RMPR41("VENDOR IEN")=RMPR41N("VENDOR IEN")
|
|
S RMPRERR=$$REC^RMPRPIU8(.RMPR6,.RMPR11,.RMPR5,1,.RMPR41) ;receipt API
|
|
I RMPRERR D G RCX
|
|
. W !!,"** Item could not be received, please contact support."
|
|
. H 3
|
|
. Q
|
|
E D
|
|
. W !!,"** Item has been received and inventory updated."
|
|
. W !," If you are using barcoding you should now print labels"
|
|
. W !," for the items received.",!
|
|
. Q
|
|
;
|
|
;***** NLAB - call prompt for number of labels to print
|
|
NLAB S RMPRNLAB=RMPR6("QUANTITY")
|
|
W ! D NLABP^RMPRPIYS(.RMPRNLAB,RMPR6("QUANTITY"),.RMPREXC)
|
|
I RMPREXC="T" G RCX
|
|
I RMPREXC="P" G RCNX
|
|
I RMPREXC="^" G RCNX
|
|
I RMPRNLAB=0 G RCNX
|
|
;
|
|
;***** SELP - call prompt for barcode print device
|
|
SELP ;W ! D SELP^RMPRPI11(.RMPRBCP,.RMPREXC,.RMPRQ,.RMPRIOP)
|
|
;I RMPREXC'="" G NLAB
|
|
S RMPRBARC=RMPR11("HCPCS")_"-"_$P(RMPR6("DATE&TIME"),".",1)_$P(RMPR6("DATE&TIME"),".",2)
|
|
S RMPRITXT("DATE")=$E(RMPR6("DATE&TIME"),4,5)_"/"_$E(RMPR6("DATE&TIME"),6,7)_"/"_(1700+$E(RMPR6("DATE&TIME"),1,3))
|
|
S RMPRITXT("ITEM")=RMPR11("HCPCS-ITEM")
|
|
S RMPRITXT("ITEM DESC")=RMPR11("DESCRIPTION")
|
|
S RMPRITXT("MASTER DESC")=RMPR11("ITEM MASTER")
|
|
S RMPRITXT("UNIT PRICE")=RMPRUCST
|
|
S RMPRITXT("VENDOR")=RMPRVEND("NAME")
|
|
S RMPRITXT("LOCATION")=RMPR5("NAME")
|
|
D PRINT^RMPRPIYS
|
|
RCNX K RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST,RMPRBCP,RMPRQ,RMPRIOP,RMPRNLAB
|
|
K RMPRBARC,RMPRITXT,RMPR41N,RMPR41,RMPRVEND
|
|
G HCPCS
|
|
RCX D KILL^XUSCLEAN
|
|
Q
|
|
;
|
|
MESS W !!,"*** NOTHING RECEIVE !!!",!
|
|
Q
|
|
;
|
|
; Y/N Prompt to confirm change of order qty
|
|
YNQTY(RMPRYN,RMPREXC) ;
|
|
N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
|
|
S RMPRYN="N"
|
|
S RMPREXC=""
|
|
S DIR(0)="Y"
|
|
S DIR("A",1)="The entered quantity is greater than the outstanding balance ("_RMPR41("BALANCE QTY")_")"
|
|
S DIR("A",2)="still on order."
|
|
S DIR("A")="Do you want to increase the original order quantity"
|
|
D ^DIR
|
|
I $D(DTOUT) S RMPREXC="T" G YNQTYX
|
|
I $D(DIROUT) S RMPREXC="P" G YNQTYX
|
|
I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G YNQTYX
|
|
S:Y RMPRYN="Y"
|
|
YNQTYX Q
|
|
;
|
|
; Y/N Prompt to confirm change of order Vendor
|
|
YNVND(RMPRYN,RMPREXC) ;
|
|
N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
|
|
S RMPRYN="N"
|
|
S RMPREXC=""
|
|
S DIR(0)="Y"
|
|
S DIR("A",1)="The entered Vendor is not the same as on the original order"
|
|
S DIR("A")="Do you want to change the Vendor on the order"
|
|
D ^DIR
|
|
I $D(DTOUT) S RMPREXC="T" G YNVNDX
|
|
I $D(DIROUT) S RMPREXC="P" G YNVNDX
|
|
I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G YNVNDX
|
|
S:Y RMPRYN="Y"
|
|
YNVNDX Q
|