- 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 Mar 13, 2025@20:59:14 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
