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