RMPRPIY5 ;HINCIO/ODJ - PIP Data fields - Prompts ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;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."
Q
;
;***** 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."
Q
;
;***** 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."
Q
;
;***** 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."
Q
;
;***** 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."
Q
;
;***** 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 Nov 22, 2024@17:46:53 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
