RMPFET82 ;DDC/KAW-CANCEL A LINE ITEM [ 06/16/95 3:06 PM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
;; input: RMPFX,RMPFHAT,RMPFTYP,RMPFST,RMPFTP,DFN
;;output: None
Q:'$D(RMPFX) Q:'RMPFX K RMPFY
START W @IOF,?35,"ACTIVE LINE ITEMS",! D ^RMPFDT2
D ARRAY^RMPFDT2 S CL=0 K RMPFRE,RMPFCAN
S X=0 F S X=$O(RMPFO(X)) Q:'X D
.S Y=RMPFO(X) Q:Y="" S Y=$P($G(^RMPF(791810.2,Y,0)),U,2)
.I RMPFHAT="C"!(RMPFHAT="I")!(RMPFHAT="X"),Y'="N" S CL=CL+1,RX=X
.I "BQZWJD"[RMPFHAT,Y="B" S CL=CL+1,RX=X
I '$D(RMPFO) W !!,"*** NO LINE ITEMS TO CANCEL ***" G EXIT
I 'CL W !!,$S(RMPFHAT="C"!(RMPFHAT="I")!(RMPFHAT="X"):"*** ALL LINE ITEMS HAVE ALREADY BEEN CANCELED ***",1:"*** NO ITEMS HAVE BEEN BACKORDERED ***") G EXIT
I CL=1 S RMPFY=RX D SET G EXECUTE
D ASK1 G END:$D(RMPFOUT),EXECUTE:$D(RMPFCAN)
D ASK2 G END:$D(RMPFOUT),END:'$D(RMPFCAN)
EXECUTE D APPROV G END:$D(RMPFOUT),END:'$D(RMPFCAN)
I "CI"[RMPFHAT D ^RMPFET83 G END
D CANCEL1 G END
EXIT F I=1:1 Q:$Y>21 W !
W !,"Type <RETURN> to continue." D READ
END K RMPFY,RMPFRE,RMPFCAN,SL,RMPFO,RMPFMD,CL,CX,C Q
ASK1 ;;Ask to cancel multiple items
;; input: CL,RMPFO,RMPFX,RMPFY
;;output: RMPFCAN
W !!,"Do you wish to cancel the orders for ",CL," line items? NO// " D READ G END:$D(RMPFOUT)
ASK11 I $D(RMPFQUT) W !!,"Enter a <Y> to cancel all line items",!?5,"an <N> or <RETURN> to select line items to cancel." G ASK1
S:Y="" Y="N" I "NnYy"'[Y S RMPFQUT="" G ASK11
G ASK1E:"Yy"'[Y S RMPFY=0
F S RMPFY=$O(RMPFO(RMPFY)) Q:'RMPFY S X=RMPFO(RMPFY) I X,$D(^RMPF(791810.2,X,0)),$P(^(0),U,2)'="N" D SET
K RMPFO
ASK1E K Y Q
ASK2 ;;Select items to cancel
;; input: RMPFMD,RMPFX,RMPFY,RMPFO
;;output: RMPFCAN
W !!,"Select the Number of the item you wish to cancel: "
D READ G END:$D(RMPFOUT)
ASK21 I $D(RMPFQUT) W !!,"Enter the number to the left of the item you wish to cancel." G ASK2
G ASK2E:Y="" I '$D(RMPFMD(Y)) S RMPFQUT="" G ASK21
S RMPFY=RMPFMD(Y) I $D(RMPFCAN(RMPFY)) W !!,"*** ITEM ALREADY SELECTED ***" G ASK2
S X=RMPFO(RMPFY) I X,$D(^RMPF(791810.2,X,0)),$P(^(0),U,2)="N" K RMPFY W !!,"*** ITEM ALREADY CANCELED ***" G ASK2
D SET
ASK22 W !!,"Select another? NO// " D READ Q:$D(RMPFOUT)
ASK221 I $D(RMPFQUT) W !!,"Enter a <Y> to select another item to cancel",!?5,"an <N> or <RETURN> to continue" G ASK22
S:Y="" Y="N" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G ASK221
G ASK2:"Yy"[Y
ASK2E K Y Q
APPROV ;;Display and ask if selection correct
;; input: RMPFCAN
;;output: None
S (CN,RMPFY)=0 F S RMPFY=$O(RMPFCAN(RMPFY)) Q:'RMPFY D
.S RMPFIT=$P(RMPFCAN(RMPFY),U,1),RMPFQTY=$P(RMPFCAN(RMPFY),U,2)
.W:CN=0 !!,"Item(s) to be canceled: " W:CN ! W ?25,RMPFIT," (",RMPFQTY,")" S CN=CN+1
APP1 W !!,"Are you sure you wish to cancel ",$S(CN>1:"these",1:"this")," item",$S(CN>1:"s",1:""),"? NO// "
D READ G APPROVE:$D(RMPFOUT)
APP11 I $D(RMPFQUT) W !!,"Enter a <Y> to cancel ",$S(CN>1:"these",1:"this")," item(s)",$S(CN>1:"s",1:""),"",!?5,"an <N> or <RETURN> to leave the item",$S(CN>1:"s",1:"")," active in the order." G APP1
S:Y="" Y="N" S Y=$E(Y,1) I "Yy"'[Y K RMPFCAN
APPROVE K RMPFIT,RMPFQTY,S0,CN,Y Q
CANCEL1 ;;Cancel a line item
;; input: RMPFCAN
;;output: None
S (C,DA)=0 F S DA=$O(RMPFCAN(DA)) G CANCEL1E:'DA D
.S C=C+1,%DT="T",X="NOW" D ^%DT S TD=Y
.S RMPFIT=$P(RMPFCAN(DA),U,1),RMPFQTY=$P(RMPFCAN(DA),U,2)
.W !!,"Item # ",C,": ",RMPFIT,?$X+5,"Quantity: ",RMPFQTY,!
.S DIE="^RMPF(791810,"_RMPFX_",101,",DA(1)=RMPFX
.S DR=".15////C;.17////"_TD_";.18///CANCELED;.19////C;.2////1;90.13////"_DUZ_";90.05"
.D ^DIE
CANCEL1E W !!,"Item",$S(C=1:"",1:"(s)")," CANCELED",!!
D APPROV1^RMPFEA2
K C,DA,C,%DT,TD,X,Y,DIE,RMPFIT,RMPFQTY,DR,%X,%Y Q
SET ;;Set up array of items to cancel
;; input: RMPFX,RMPFY
;;output: RMPFCAN
S X=$G(^RMPF(791810,RMPFX,101,RMPFY,0))
S RMPFIT=$P(X,U,1),RMPFQTY=$P(X,U,6) S:'RMPFQTY RMPFQTY=1
I RMPFIT,$D(^RMPF(791811,RMPFIT,0)) S RMPFIT=$P(^(0),U,1)
S RMPFCAN(RMPFY)=RMPFIT_U_RMPFQTY
K X,RMPFIT,RMPFQTY 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[HRMPFET82 4136 printed Sep 23, 2025@20:12:48 Page 2
RMPFET82 ;DDC/KAW-CANCEL A LINE ITEM [ 06/16/95 3:06 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
+2 ;; input: RMPFX,RMPFHAT,RMPFTYP,RMPFST,RMPFTP,DFN
+3 ;;output: None
+4 if '$DATA(RMPFX)
QUIT
if 'RMPFX
QUIT
KILL RMPFY
START WRITE @IOF,?35,"ACTIVE LINE ITEMS",!
DO ^RMPFDT2
+1 DO ARRAY^RMPFDT2
SET CL=0
KILL RMPFRE,RMPFCAN
+2 SET X=0
FOR
SET X=$ORDER(RMPFO(X))
if 'X
QUIT
Begin DoDot:1
+3 SET Y=RMPFO(X)
if Y=""
QUIT
SET Y=$PIECE($GET(^RMPF(791810.2,Y,0)),U,2)
+4 IF RMPFHAT="C"!(RMPFHAT="I")!(RMPFHAT="X")
IF Y'="N"
SET CL=CL+1
SET RX=X
+5 IF "BQZWJD"[RMPFHAT
IF Y="B"
SET CL=CL+1
SET RX=X
End DoDot:1
+6 IF '$DATA(RMPFO)
WRITE !!,"*** NO LINE ITEMS TO CANCEL ***"
GOTO EXIT
+7 IF 'CL
WRITE !!,$SELECT(RMPFHAT="C"!(RMPFHAT="I")!(RMPFHAT="X"):"*** ALL LINE ITEMS HAVE ALREADY BEEN CANCELED ***",1:"*** NO ITEMS HAVE BEEN BACKORDERED ***")
GOTO EXIT
+8 IF CL=1
SET RMPFY=RX
DO SET
GOTO EXECUTE
+9 DO ASK1
if $DATA(RMPFOUT)
GOTO END
if $DATA(RMPFCAN)
GOTO EXECUTE
+10 DO ASK2
if $DATA(RMPFOUT)
GOTO END
if '$DATA(RMPFCAN)
GOTO END
EXECUTE DO APPROV
if $DATA(RMPFOUT)
GOTO END
if '$DATA(RMPFCAN)
GOTO END
+1 IF "CI"[RMPFHAT
DO ^RMPFET83
GOTO END
+2 DO CANCEL1
GOTO END
EXIT FOR I=1:1
if $Y>21
QUIT
WRITE !
+1 WRITE !,"Type <RETURN> to continue."
DO READ
END KILL RMPFY,RMPFRE,RMPFCAN,SL,RMPFO,RMPFMD,CL,CX,C
QUIT
ASK1 ;;Ask to cancel multiple items
+1 ;; input: CL,RMPFO,RMPFX,RMPFY
+2 ;;output: RMPFCAN
+3 WRITE !!,"Do you wish to cancel the orders for ",CL," line items? NO// "
DO READ
if $DATA(RMPFOUT)
GOTO END
ASK11 IF $DATA(RMPFQUT)
WRITE !!,"Enter a <Y> to cancel all line items",!?5,"an <N> or <RETURN> to select line items to cancel."
GOTO ASK1
+1 if Y=""
SET Y="N"
IF "NnYy"'[Y
SET RMPFQUT=""
GOTO ASK11
+2 if "Yy"'[Y
GOTO ASK1E
SET RMPFY=0
+3 FOR
SET RMPFY=$ORDER(RMPFO(RMPFY))
if 'RMPFY
QUIT
SET X=RMPFO(RMPFY)
IF X
IF $DATA(^RMPF(791810.2,X,0))
IF $PIECE(^(0),U,2)'="N"
DO SET
+4 KILL RMPFO
ASK1E KILL Y
QUIT
ASK2 ;;Select items to cancel
+1 ;; input: RMPFMD,RMPFX,RMPFY,RMPFO
+2 ;;output: RMPFCAN
+3 WRITE !!,"Select the Number of the item you wish to cancel: "
+4 DO READ
if $DATA(RMPFOUT)
GOTO END
ASK21 IF $DATA(RMPFQUT)
WRITE !!,"Enter the number to the left of the item you wish to cancel."
GOTO ASK2
+1 if Y=""
GOTO ASK2E
IF '$DATA(RMPFMD(Y))
SET RMPFQUT=""
GOTO ASK21
+2 SET RMPFY=RMPFMD(Y)
IF $DATA(RMPFCAN(RMPFY))
WRITE !!,"*** ITEM ALREADY SELECTED ***"
GOTO ASK2
+3 SET X=RMPFO(RMPFY)
IF X
IF $DATA(^RMPF(791810.2,X,0))
IF $PIECE(^(0),U,2)="N"
KILL RMPFY
WRITE !!,"*** ITEM ALREADY CANCELED ***"
GOTO ASK2
+4 DO SET
ASK22 WRITE !!,"Select another? NO// "
DO READ
if $DATA(RMPFOUT)
QUIT
ASK221 IF $DATA(RMPFQUT)
WRITE !!,"Enter a <Y> to select another item to cancel",!?5,"an <N> or <RETURN> to continue"
GOTO ASK22
+1 if Y=""
SET Y="N"
SET Y=$EXTRACT(Y,1)
IF "YyNn"'[Y
SET RMPFQUT=""
GOTO ASK221
+2 if "Yy"[Y
GOTO ASK2
ASK2E KILL Y
QUIT
APPROV ;;Display and ask if selection correct
+1 ;; input: RMPFCAN
+2 ;;output: None
+3 SET (CN,RMPFY)=0
FOR
SET RMPFY=$ORDER(RMPFCAN(RMPFY))
if 'RMPFY
QUIT
Begin DoDot:1
+4 SET RMPFIT=$PIECE(RMPFCAN(RMPFY),U,1)
SET RMPFQTY=$PIECE(RMPFCAN(RMPFY),U,2)
+5 if CN=0
WRITE !!,"Item(s) to be canceled: "
if CN
WRITE !
WRITE ?25,RMPFIT," (",RMPFQTY,")"
SET CN=CN+1
End DoDot:1
APP1 WRITE !!,"Are you sure you wish to cancel ",$SELECT(CN>1:"these",1:"this")," item",$SELECT(CN>1:"s",1:""),"? NO// "
+1 DO READ
if $DATA(RMPFOUT)
GOTO APPROVE
APP11 IF $DATA(RMPFQUT)
WRITE !!,"Enter a <Y> to cancel ",$SELECT(CN>1:"these",1:"this")," item(s)",$SELECT(CN>1:"s",1:""),"",!?5,"an <N> or <RETURN> to leave the item",$SELECT(CN>1:"s",1:"")," active in the order."
GOTO APP1
+1 if Y=""
SET Y="N"
SET Y=$EXTRACT(Y,1)
IF "Yy"'[Y
KILL RMPFCAN
APPROVE KILL RMPFIT,RMPFQTY,S0,CN,Y
QUIT
CANCEL1 ;;Cancel a line item
+1 ;; input: RMPFCAN
+2 ;;output: None
+3 SET (C,DA)=0
FOR
SET DA=$ORDER(RMPFCAN(DA))
if 'DA
GOTO CANCEL1E
Begin DoDot:1
+4 SET C=C+1
SET %DT="T"
SET X="NOW"
DO ^%DT
SET TD=Y
+5 SET RMPFIT=$PIECE(RMPFCAN(DA),U,1)
SET RMPFQTY=$PIECE(RMPFCAN(DA),U,2)
+6 WRITE !!,"Item # ",C,": ",RMPFIT,?$X+5,"Quantity: ",RMPFQTY,!
+7 SET DIE="^RMPF(791810,"_RMPFX_",101,"
SET DA(1)=RMPFX
+8 SET DR=".15////C;.17////"_TD_";.18///CANCELED;.19////C;.2////1;90.13////"_DUZ_";90.05"
+9 DO ^DIE
End DoDot:1
CANCEL1E WRITE !!,"Item",$SELECT(C=1:"",1:"(s)")," CANCELED",!!
+1 DO APPROV1^RMPFEA2
+2 KILL C,DA,C,%DT,TD,X,Y,DIE,RMPFIT,RMPFQTY,DR,%X,%Y
QUIT
SET ;;Set up array of items to cancel
+1 ;; input: RMPFX,RMPFY
+2 ;;output: RMPFCAN
+3 SET X=$GET(^RMPF(791810,RMPFX,101,RMPFY,0))
+4 SET RMPFIT=$PIECE(X,U,1)
SET RMPFQTY=$PIECE(X,U,6)
if 'RMPFQTY
SET RMPFQTY=1
+5 IF RMPFIT
IF $DATA(^RMPF(791811,RMPFIT,0))
SET RMPFIT=$PIECE(^(0),U,1)
+6 SET RMPFCAN(RMPFY)=RMPFIT_U_RMPFQTY
+7 KILL X,RMPFIT,RMPFQTY
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
