PRCNREQQ ;SSI/ALA-Line Item Quantity Edit ;[ 08/05/96 5:51 PM ]
;;1.0;Equipment/Turn-In Request;**5**;Sep 13, 1996
I +X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) K X Q
S PRVQTY=$P($G(^PRCN(413,DA(1),1,DA,0)),U,5)
I $P(^PRCN(413,DA(1),0),U,9)'="R" G EXIT
I PRVQTY="" G EXIT
S RDI=DA,RDA=DA(1),TDA=$P(^PRCN(413,RDA,0),U,11),PRCNCMR=$P(^(0),U,16)
S NQTY=X I $G(NEW)'="" G EXIT
I NQTY>PRVQTY D GRT G EXIT
I NQTY<PRVQTY D LES
EXIT K PRVQTY,NUM,TTDA,TDA,RDA,RDI,NN,NQTY,NM,QTY
Q
GRT ; If the quantity increased and type is replacement
W !!,"You have increased your requested quantity. This request type is "
W !,"a 'REPLACEMENT'. You must have a selected replacement item from the"
W !,"Inventory file for each individual quantity of a line item."
W !,"You must ADD a replacement item for each additional quantity requested."
W !!,"Do you wish to continue" D YN^DICN I %<0!(%=2) K X Q
I %=0 G GRT
; Go add replacement items
S NM=$P($G(^PRCN(413.1,TDA,1,0)),U,3)
I NM="" S ^PRCN(413.1,TDA,1,0)="^413.11IPA^^"
D CT I NQTY=NUM W !,"Equal quantity to replacement items already!" Q
S QTY=NQTY,PRCNTYP=$P(^PRCN(413,RDA,1,RDI,0),U,12) D RP2^PRCNREQN D CT I NUM<NQTY W !,"Not enough replacement items" G GRT
S X=NQTY
Q
LES ; If the quantity decreased and type is replacement
N DV
W !!,"You have decreased your requested quantity. This request type is "
W !,"a 'REPLACEMENT'. You must have a selected replacement item from the"
W !,"Inventory file for each individual quantity of a line item."
W !,"You must DELETE a replacement item for each decremented quantity requested."
W !!,"Do you wish to continue" D YN^DICN I %<0!(%=2) K X Q
I %=0 G LES
; Go to edit and prompt for '@'
S QTY=NQTY D CT S TTDA=TDA D EN1^PRCNREQE S TDA=TTDA D CT S $P(^PRCN(413.1,TDA,1,0),U,3,4)=NUM_U_NUM
I NUM>NQTY W !!,"You didn't delete any items. Please try again." G LES
Q
CT S NUM=0,NN="" F S NN=$O(^PRCN(413.1,TDA,1,"AC",RDI,NN)) Q:NN="" S NUM=NUM+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNREQQ 1996 printed Nov 22, 2024@17:04:45 Page 2
PRCNREQQ ;SSI/ALA-Line Item Quantity Edit ;[ 08/05/96 5:51 PM ]
+1 ;;1.0;Equipment/Turn-In Request;**5**;Sep 13, 1996
+2 IF +X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N)
KILL X
QUIT
+3 SET PRVQTY=$PIECE($GET(^PRCN(413,DA(1),1,DA,0)),U,5)
+4 IF $PIECE(^PRCN(413,DA(1),0),U,9)'="R"
GOTO EXIT
+5 IF PRVQTY=""
GOTO EXIT
+6 SET RDI=DA
SET RDA=DA(1)
SET TDA=$PIECE(^PRCN(413,RDA,0),U,11)
SET PRCNCMR=$PIECE(^(0),U,16)
+7 SET NQTY=X
IF $GET(NEW)'=""
GOTO EXIT
+8 IF NQTY>PRVQTY
DO GRT
GOTO EXIT
+9 IF NQTY<PRVQTY
DO LES
EXIT KILL PRVQTY,NUM,TTDA,TDA,RDA,RDI,NN,NQTY,NM,QTY
+1 QUIT
GRT ; If the quantity increased and type is replacement
+1 WRITE !!,"You have increased your requested quantity. This request type is "
+2 WRITE !,"a 'REPLACEMENT'. You must have a selected replacement item from the"
+3 WRITE !,"Inventory file for each individual quantity of a line item."
+4 WRITE !,"You must ADD a replacement item for each additional quantity requested."
+5 WRITE !!,"Do you wish to continue"
DO YN^DICN
IF %<0!(%=2)
KILL X
QUIT
+6 IF %=0
GOTO GRT
+7 ; Go add replacement items
+8 SET NM=$PIECE($GET(^PRCN(413.1,TDA,1,0)),U,3)
+9 IF NM=""
SET ^PRCN(413.1,TDA,1,0)="^413.11IPA^^"
+10 DO CT
IF NQTY=NUM
WRITE !,"Equal quantity to replacement items already!"
QUIT
+11 SET QTY=NQTY
SET PRCNTYP=$PIECE(^PRCN(413,RDA,1,RDI,0),U,12)
DO RP2^PRCNREQN
DO CT
IF NUM<NQTY
WRITE !,"Not enough replacement items"
GOTO GRT
+12 SET X=NQTY
+13 QUIT
LES ; If the quantity decreased and type is replacement
+1 NEW DV
+2 WRITE !!,"You have decreased your requested quantity. This request type is "
+3 WRITE !,"a 'REPLACEMENT'. You must have a selected replacement item from the"
+4 WRITE !,"Inventory file for each individual quantity of a line item."
+5 WRITE !,"You must DELETE a replacement item for each decremented quantity requested."
+6 WRITE !!,"Do you wish to continue"
DO YN^DICN
IF %<0!(%=2)
KILL X
QUIT
+7 IF %=0
GOTO LES
+8 ; Go to edit and prompt for '@'
+9 SET QTY=NQTY
DO CT
SET TTDA=TDA
DO EN1^PRCNREQE
SET TDA=TTDA
DO CT
SET $PIECE(^PRCN(413.1,TDA,1,0),U,3,4)=NUM_U_NUM
+10 IF NUM>NQTY
WRITE !!,"You didn't delete any items. Please try again."
GOTO LES
+11 QUIT
CT SET NUM=0
SET NN=""
FOR
SET NN=$ORDER(^PRCN(413.1,TDA,1,"AC",RDI,NN))
if NN=""
QUIT
SET NUM=NUM+1
+1 QUIT