Routine: RMPRPIYG

RMPRPIYG ;HINCIO/ODJ - RC - PIP Receive Stock ;3/8/01

 ;;3.0;PROSTHETICS;**61,132**;Feb 09, 1996;Build 13

 ;***** 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

MESS W !!,"*** NOTHING RECEIVE !!!",!

 ; 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  Mar 13, 2025@21:41:58                                                                                                                                                                                                    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

RMPRPIYG.m