Routine: RMPRPIY5

RMPRPIY5 ;HINCIO/ODJ - PIP Data fields - Prompts ;3/8/01

 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996

 ;SRC - Prompt for Source - V for VA (used), C for Commercial

SRC(RMPRSRC,RMPREXC) ;

 N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 S RMPRSRC=$G(RMPRSRC)

 S RMPRERR=0

 S DIR(0)="661.11,4"

 S DIR("A")="SOURCE"

 S DIR("B")=$S(RMPRSRC="":"C",1:RMPRSRC)

 S DIR("?")="^D SRCH^RMPRPIY5"

RESRC D ^DIR

 I $D(DTOUT) S RMPREXC="T" G SRCX

 I $D(DIROUT) S RMPREXC="P" G SRCX

 I X="" G RESRC

 I (X["^")!($D(DUOUT)) S RMPREXC="^" G SRCX

 S RMPRSRC=Y

 S RMPREXC=""

SRCX Q

SRCH W "If the item is USED, type in 'V' for VA."

 W !,"If the item is NEW, type in 'C' for COMMERCIAL."

 ;***** QTY - Prompt for Quantity (Invoice not on hand)

QTY(RMPRQTY,RMPREXC) ;

 N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 S RMPRQTY=$G(RMPRQTY)

 S RMPRERR=0

 S DIR(0)="NAO^0:99999:0"

 S DIR("A")="INVOICE QUANTITY: "

 S:RMPRQTY'="" DIR("B")=RMPRQTY

 S DIR("??")="^D QTYHH^RMPRPIY5"

REQTY D ^DIR

 I $D(DTOUT) S RMPREXC="T" G QTYX

 I $D(DIROUT) S RMPREXC="P" G QTYX

 I X="" G REQTY

 I (X["^")!($D(DUOUT)) S RMPREXC="^" G QTYX

 S RMPREXC=""

 S RMPRQTY=+Y

QTYX Q

QTYHH W "Type in the item quantity you are receiving into stock.",!

 W "This quantity should match that on the paper record of the receipt",!

 W "such as an invoice or delivery note, it is not the same as the",!

 W "quantity on hand. To correct on hand quantities you should use the",!

 W "reconciliation option.",!

 W "Please make sure you create separate receipts if you are receiving",!

 W "the same item from different vendors or at different costs."

 ;***** UCST - prompt for Unit Cost

UCST(RMPRUCST,RMPREXC) ;

 N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 S RMPRUCST=$G(RMPRUCST)

 S RMPRERR=0

 S RMPREXC=""

 S DIR(0)="NOA^0:99999:6"

 S DIR("A")="UNIT COST: "

 S DIR("??")="^D UCSTHH^RMPRPIY5"

 S:RMPRUCST'="" DIR("B")=RMPRUCST

REUCST D ^DIR

 I $D(DTOUT) S RMPREXC="T" G SRCX

 I $D(DIROUT) S RMPREXC="P" G SRCX

 I X="" G REUCST

 I X["^"!($D(DUOUT)) S RMPREXC="^" G SRCX

 S RMPRUCST=+Y

UCSTX Q

UCSTHH W "Type in the dollar cost per item."

 W !,"If you would prefer to enter the total dollar value for the"

 W !,"item quantity you have just typed in, then type in 0 here."

 ;***** TVAL - Prompt for total $ value

TVAL(RMPRTVAL,RMPREXC) ;

 N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 S RMPRTVAL=$G(RMPRTVAL)

 S RMPRERR=0

 S RMPREXC=""

 S DIR(0)="NOA^0:999999:2"

 S DIR("A")="TOTAL COST OF QUANTITY: "

 S:RMPRTVAL'="" DIR("B")=RMPRTVAL

 S DIR("??")="^D TVALHH^RMPRPIY5"

RETVAL D ^DIR

 I $D(DTOUT) S RMPREXC="T" G TVALX

 I $D(DIROUT) S RMPREXC="P" G TVALX

 I X["^" S RMPREXC="^" G TVALX

 I X="" G RETVAL

 S RMPRTVAL=+Y

TVALX Q

TVALHH W "Type in the total dollar value or cost (excluding freight)"

 W !,"of the item quantity you have entered above."

 ;***** REO - Prompt for Re-Order Level

REO(RMPRREO,RMPREXC) ;

 N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 S RMPRREO=$G(RMPRREO)

 S RMPRERR=0

 S RMPREXC=""

 S DIR(0)="NOA^0:99999:0"

 S DIR("A")="RE-ORDER LEVEL: "

 S:RMPRREO'="" DIR("B")=RMPRREO

 S DIR("??")="^D REOHH^RMPRPIY5"

REREO D ^DIR

 I $D(DTOUT) S RMPREXC="T" G REOX

 I $D(DIROUT) S RMPREXC="P" G REOX

 I X="" G REREO

 I (X["^")!($D(DUOUT)) S RMPREXC="^" G REOX

 S RMPRREO=+Y

REOX Q

REOHH W "Type in a number that signifies the quantity on hand of an item,"

 W !,"at a particular location, below which the item should be ordered."

 ;***** VEND - prompt for Vendor

VEND(RMPRVEND,RMPREXC) ;

 N RMPRERR,DIC,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 S RMPRVEND=$G(RMPRVEND("IEN"))

 S RMPRERR=0

 S DIC=440

 S DIC(0)="AEQM"

 S DIC("A")="VENDOR: "

 I RMPRVEND'="" S DIC("B")=RMPRVEND

REVEND D ^DIC

 I $D(DTOUT) S RMPREXC="T" G VENDX

 I $D(DIROUT)!(X["^^") S RMPREXC="P" G VENDX

 I X="" G REVEND

 I (X["^")!($D(DUOUT))!(+Y=-1) S RMPREXC="^" G VENDX

 S RMPREXC=""

 S RMPRVEND("IEN")=$P(Y,"^",1)

 S RMPRVEND("NAME")=$P(Y,"^",2)

VENDX Q

 ;***** UNIT - prompt for unit of issue

UNIT(RMPRUNI,RMPREXC) ;

 N RMPRERR,DIC,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 S RMPRUNI=$G(RMPRUNI("IEN"))

 S RMPRERR=0

 S DIC=420.5

 S DIC(0)="AEQM"

 S DIC("A")="UNIT OF ISSUE: "

 I RMPRUNI'="" S DIC("B")=RMPRUNI

UNITD D ^DIC

 I $D(DTOUT) S RMPREXC="T" G UNITX

 I $D(DIROUT)!(X["^^") S RMPREXC="P" G UNITX

 I X="" G UNITD

 I (X["^")!($D(DUOUT))!(+Y=-1) S RMPREXC="^" G UNITX

 S RMPREXC=""

 S RMPRUNI("IEN")=$P(Y,"^",1)

 S RMPRUNI("NAME")=$P(Y,"^",2)

UNITX Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIY5   4539     printed  Apr 23, 2025@18:51:23                                                                                                                                                                                                    Page 2

RMPRPIY5  ;HINCIO/ODJ - PIP Data fields - Prompts ;3/8/01

 +1       ;;3.0;PROSTHETICS;**61**;Feb 09, 1996

 +2        QUIT

 +3       ;

 +4       ;SRC - Prompt for Source - V for VA (used), C for Commercial

SRC(RMPRSRC,RMPREXC) ;

 +1        NEW RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 +2        SET RMPRSRC=$GET(RMPRSRC)

 +3        SET RMPRERR=0

 +4        SET DIR(0)="661.11,4"

 +5        SET DIR("A")="SOURCE"

 +6        SET DIR("B")=$SELECT(RMPRSRC="":"C",1:RMPRSRC)

 +7        SET DIR("?")="^D SRCH^RMPRPIY5"

RESRC      DO ^DIR

 +1        IF $DATA(DTOUT)

               SET RMPREXC="T"

               GOTO SRCX

 +2        IF $DATA(DIROUT)

               SET RMPREXC="P"

               GOTO SRCX

 +3        IF X=""

               GOTO RESRC

 +4        IF (X["^")!($DATA(DUOUT))

               SET RMPREXC="^"

               GOTO SRCX

 +5        SET RMPRSRC=Y

 +6        SET RMPREXC=""

SRCX       QUIT

SRCH       WRITE "If the item is USED, type in 'V' for VA."

 +1        WRITE !,"If the item is NEW, type in 'C' for COMMERCIAL."

 +2        QUIT

 +3       ;

 +4       ;***** QTY - Prompt for Quantity (Invoice not on hand)

QTY(RMPRQTY,RMPREXC) ;

 +1        NEW RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 +2        SET RMPRQTY=$GET(RMPRQTY)

 +3        SET RMPRERR=0

 +4        SET DIR(0)="NAO^0:99999:0"

 +5        SET DIR("A")="INVOICE QUANTITY: "

 +6        if RMPRQTY'=""

               SET DIR("B")=RMPRQTY

 +7        SET DIR("??")="^D QTYHH^RMPRPIY5"

REQTY      DO ^DIR

 +1        IF $DATA(DTOUT)

               SET RMPREXC="T"

               GOTO QTYX

 +2        IF $DATA(DIROUT)

               SET RMPREXC="P"

               GOTO QTYX

 +3        IF X=""

               GOTO REQTY

 +4        IF (X["^")!($DATA(DUOUT))

               SET RMPREXC="^"

               GOTO QTYX

 +5        SET RMPREXC=""

 +6        SET RMPRQTY=+Y

QTYX       QUIT

QTYHH      WRITE "Type in the item quantity you are receiving into stock.",!

 +1        WRITE "This quantity should match that on the paper record of the receipt",!

 +2        WRITE "such as an invoice or delivery note, it is not the same as the",!

 +3        WRITE "quantity on hand. To correct on hand quantities you should use the",!

 +4        WRITE "reconciliation option.",!

 +5        WRITE "Please make sure you create separate receipts if you are receiving",!

 +6        WRITE "the same item from different vendors or at different costs."

 +7        QUIT

 +8       ;

 +9       ;***** UCST - prompt for Unit Cost

UCST(RMPRUCST,RMPREXC) ;

 +1        NEW RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 +2        SET RMPRUCST=$GET(RMPRUCST)

 +3        SET RMPRERR=0

 +4        SET RMPREXC=""

 +5        SET DIR(0)="NOA^0:99999:6"

 +6        SET DIR("A")="UNIT COST: "

 +7        SET DIR("??")="^D UCSTHH^RMPRPIY5"

 +8        if RMPRUCST'=""

               SET DIR("B")=RMPRUCST

REUCST     DO ^DIR

 +1        IF $DATA(DTOUT)

               SET RMPREXC="T"

               GOTO SRCX

 +2        IF $DATA(DIROUT)

               SET RMPREXC="P"

               GOTO SRCX

 +3        IF X=""

               GOTO REUCST

 +4        IF X["^"!($DATA(DUOUT))

               SET RMPREXC="^"

               GOTO SRCX

 +5        SET RMPRUCST=+Y

UCSTX      QUIT

UCSTHH     WRITE "Type in the dollar cost per item."

 +1        WRITE !,"If you would prefer to enter the total dollar value for the"

 +2        WRITE !,"item quantity you have just typed in, then type in 0 here."

 +3        QUIT

 +4       ;

 +5       ;***** TVAL - Prompt for total $ value

TVAL(RMPRTVAL,RMPREXC) ;

 +1        NEW RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 +2        SET RMPRTVAL=$GET(RMPRTVAL)

 +3        SET RMPRERR=0

 +4        SET RMPREXC=""

 +5        SET DIR(0)="NOA^0:999999:2"

 +6        SET DIR("A")="TOTAL COST OF QUANTITY: "

 +7        if RMPRTVAL'=""

               SET DIR("B")=RMPRTVAL

 +8        SET DIR("??")="^D TVALHH^RMPRPIY5"

RETVAL     DO ^DIR

 +1        IF $DATA(DTOUT)

               SET RMPREXC="T"

               GOTO TVALX

 +2        IF $DATA(DIROUT)

               SET RMPREXC="P"

               GOTO TVALX

 +3        IF X["^"

               SET RMPREXC="^"

               GOTO TVALX

 +4        IF X=""

               GOTO RETVAL

 +5        SET RMPRTVAL=+Y

TVALX      QUIT

TVALHH     WRITE "Type in the total dollar value or cost (excluding freight)"

 +1        WRITE !,"of the item quantity you have entered above."

 +2        QUIT

 +3       ;

 +4       ;***** REO - Prompt for Re-Order Level

REO(RMPRREO,RMPREXC) ;

 +1        NEW RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 +2        SET RMPRREO=$GET(RMPRREO)

 +3        SET RMPRERR=0

 +4        SET RMPREXC=""

 +5        SET DIR(0)="NOA^0:99999:0"

 +6        SET DIR("A")="RE-ORDER LEVEL: "

 +7        if RMPRREO'=""

               SET DIR("B")=RMPRREO

 +8        SET DIR("??")="^D REOHH^RMPRPIY5"

REREO      DO ^DIR

 +1        IF $DATA(DTOUT)

               SET RMPREXC="T"

               GOTO REOX

 +2        IF $DATA(DIROUT)

               SET RMPREXC="P"

               GOTO REOX

 +3        IF X=""

               GOTO REREO

 +4        IF (X["^")!($DATA(DUOUT))

               SET RMPREXC="^"

               GOTO REOX

 +5        SET RMPRREO=+Y

REOX       QUIT

REOHH      WRITE "Type in a number that signifies the quantity on hand of an item,"

 +1        WRITE !,"at a particular location, below which the item should be ordered."

 +2        QUIT

 +3       ;

 +4       ;***** VEND - prompt for Vendor

VEND(RMPRVEND,RMPREXC) ;

 +1        NEW RMPRERR,DIC,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 +2        SET RMPRVEND=$GET(RMPRVEND("IEN"))

 +3        SET RMPRERR=0

 +4        SET DIC=440

 +5        SET DIC(0)="AEQM"

 +6        SET DIC("A")="VENDOR: "

 +7        IF RMPRVEND'=""

               SET DIC("B")=RMPRVEND

REVEND     DO ^DIC

 +1        IF $DATA(DTOUT)

               SET RMPREXC="T"

               GOTO VENDX

 +2        IF $DATA(DIROUT)!(X["^^")

               SET RMPREXC="P"

               GOTO VENDX

 +3        IF X=""

               GOTO REVEND

 +4        IF (X["^")!($DATA(DUOUT))!(+Y=-1)

               SET RMPREXC="^"

               GOTO VENDX

 +5        SET RMPREXC=""

 +6        SET RMPRVEND("IEN")=$PIECE(Y,"^",1)

 +7        SET RMPRVEND("NAME")=$PIECE(Y,"^",2)

VENDX      QUIT

 +1       ;

 +2       ;***** UNIT - prompt for unit of issue

UNIT(RMPRUNI,RMPREXC) ;

 +1        NEW RMPRERR,DIC,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA

 +2        SET RMPRUNI=$GET(RMPRUNI("IEN"))

 +3        SET RMPRERR=0

 +4        SET DIC=420.5

 +5        SET DIC(0)="AEQM"

 +6        SET DIC("A")="UNIT OF ISSUE: "

 +7        IF RMPRUNI'=""

               SET DIC("B")=RMPRUNI

UNITD      DO ^DIC

 +1        IF $DATA(DTOUT)

               SET RMPREXC="T"

               GOTO UNITX

 +2        IF $DATA(DIROUT)!(X["^^")

               SET RMPREXC="P"

               GOTO UNITX

 +3        IF X=""

               GOTO UNITD

 +4        IF (X["^")!($DATA(DUOUT))!(+Y=-1)

               SET RMPREXC="^"

               GOTO UNITX

 +5        SET RMPREXC=""

 +6        SET RMPRUNI("IEN")=$PIECE(Y,"^",1)

 +7        SET RMPRUNI("NAME")=$PIECE(Y,"^",2)

UNITX      QUIT

RMPRPIY5.m