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