- RMPFEM ;DDC/KAW-INACTIVATE A LINE ITEM [ 06/16/95 3:06 PM ]
- ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
- RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
- I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
- W @IOF,!!,"INACTIVATE A LINE ITEM"
- W !!,"Inactivating a line item will make that item unavailable for selection in the"
- W !,"ordering of new products. This option should be used to disallow items no"
- W !,"longer under contract."
- SEL W !! S DIC=791811,DIC(0)="AEQM" D ^DIC G END:Y=-1 S LI=+Y
- S MK=$P(^RMPF(791811,LI,0),U,2),CS=$P(^(0),U,4)
- W !!,"Item",?22,"Make",?40,"Price"
- W !,"--------------------",?22,"----------------",?40,"-------"
- W !,$E($P(Y,U,2),1,20),?22,$E(MK,1,16),?40,"$",$J(CS,6,2)
- G A2:$D(^RMPF(791811,LI,"I"))
- A1 W !!,"Are you sure you wish to inactivate this item? NO// "
- D READ G END:$D(RMPFOUT)
- A11 I $D(RMPFQUT) W !!,"Type <Y>es to prevent the item from being ordered or <N>o to exit." G A1
- S:Y="" Y="N" S Y=$E(Y,1) I "NnYs"'[Y S RMPFQUT="" G A11
- G SEL:"Nn"[Y S $P(^RMPF(791811,LI,"I"),U)=1
- W !!,"*** ITEM INACTIVATED ***"
- G SEL
- A2 W !!,"This item has already been inactivated. Do you wish to re-activate? NO// "
- D READ G END:$D(RMPFOUT)
- A21 I $D(RMPFQUT) W !!,"Type <Y>es to re-activate the item. If the item is no longer",!,"under contract, any orders will be rejected from the DDC.",!,"Enter <N>o or <RETURN> to exit without change." G A2
- S:Y="" Y="N" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G A21
- G SEL:"Nn"[Y K ^RMPF(791811,LI,"I")
- W !!,"*** ITEM RE-ACTIVATED ***" G SEL:"Nn"[Y K ^RMPF(791811,LI,"I") G SEL
- END K %,CS,LI,MK,DIC,DISYS,X,Y,RMPFOUT,RMPFQUT Q
- READ K RMPFOUT,RMPFQUT
- R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
- I Y?1"^".E S (RMPFOUT,Y)="" Q
- S:Y?1"?".E (RMPFQUT,Y)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFEM 1911 printed Feb 19, 2025@00:02:39 Page 2
- RMPFEM ;DDC/KAW-INACTIVATE A LINE ITEM [ 06/16/95 3:06 PM ]
- +1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
- RMPFSET ;;RMPFMENU must be defined
- IF '$DATA(RMPFMENU)
- DO MENU^RMPFUTL
- IF '$DATA(RMPFMENU)
- WRITE !!,$CHAR(7),"*** A MENU SELECTION MUST BE MADE ***"
- QUIT
- +1 IF '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
- DO ^RMPFUTL
- if '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
- QUIT
- +2 WRITE @IOF,!!,"INACTIVATE A LINE ITEM"
- +3 WRITE !!,"Inactivating a line item will make that item unavailable for selection in the"
- +4 WRITE !,"ordering of new products. This option should be used to disallow items no"
- +5 WRITE !,"longer under contract."
- SEL WRITE !!
- SET DIC=791811
- SET DIC(0)="AEQM"
- DO ^DIC
- if Y=-1
- GOTO END
- SET LI=+Y
- +1 SET MK=$PIECE(^RMPF(791811,LI,0),U,2)
- SET CS=$PIECE(^(0),U,4)
- +2 WRITE !!,"Item",?22,"Make",?40,"Price"
- +3 WRITE !,"--------------------",?22,"----------------",?40,"-------"
- +4 WRITE !,$EXTRACT($PIECE(Y,U,2),1,20),?22,$EXTRACT(MK,1,16),?40,"$",$JUSTIFY(CS,6,2)
- +5 if $DATA(^RMPF(791811,LI,"I"))
- GOTO A2
- A1 WRITE !!,"Are you sure you wish to inactivate this item? NO// "
- +1 DO READ
- if $DATA(RMPFOUT)
- GOTO END
- A11 IF $DATA(RMPFQUT)
- WRITE !!,"Type <Y>es to prevent the item from being ordered or <N>o to exit."
- GOTO A1
- +1 if Y=""
- SET Y="N"
- SET Y=$EXTRACT(Y,1)
- IF "NnYs"'[Y
- SET RMPFQUT=""
- GOTO A11
- +2 if "Nn"[Y
- GOTO SEL
- SET $PIECE(^RMPF(791811,LI,"I"),U)=1
- +3 WRITE !!,"*** ITEM INACTIVATED ***"
- +4 GOTO SEL
- A2 WRITE !!,"This item has already been inactivated. Do you wish to re-activate? NO// "
- +1 DO READ
- if $DATA(RMPFOUT)
- GOTO END
- A21 IF $DATA(RMPFQUT)
- WRITE !!,"Type <Y>es to re-activate the item. If the item is no longer",!,"under contract, any orders will be rejected from the DDC.",!,"Enter <N>o or <RETURN> to exit without change."
- GOTO A2
- +1 if Y=""
- SET Y="N"
- SET Y=$EXTRACT(Y,1)
- IF "YyNn"'[Y
- SET RMPFQUT=""
- GOTO A21
- +2 if "Nn"[Y
- GOTO SEL
- KILL ^RMPF(791811,LI,"I")
- +3 WRITE !!,"*** ITEM RE-ACTIVATED ***"
- if "Nn"[Y
- GOTO SEL
- KILL ^RMPF(791811,LI,"I")
- GOTO SEL
- END KILL %,CS,LI,MK,DIC,DISYS,X,Y,RMPFOUT,RMPFQUT
- QUIT
- READ KILL RMPFOUT,RMPFQUT
- +1 READ Y:DTIME
- IF '$TEST
- WRITE $CHAR(7)
- READ Y:5
- if Y="."
- GOTO READ
- if '$TEST
- SET Y=U
- +2 IF Y?1"^".E
- SET (RMPFOUT,Y)=""
- QUIT
- +3 if Y?1"?".E
- SET (RMPFQUT,Y)=""
- +4 QUIT
