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 Dec 13, 2024@02:36:08 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
