ACRFRR2 ;IHS/OIRM/DSD/THL,AEF - CANCEL ITEMS FROM RECEIVING REPORT; [ 09/23/2005 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
;;CONTINUATION OF ACRFRR
CANCEL ;EP;
N ACRCAN
S DIR(0)="YO"
S DIR("A")="Create PO for cancelled items"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
S:Y'=1 ACRNEWPO=""
S DIR(0)="LO^1:"_ACRSSMAX
S DIR("A")="Cancel which items(s)"
W !
D DIR^ACRFDIC
I 'Y!$D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
N ACRY
S ACRY=Y
F ACRJ=1:1 S ACRSSDA=$P(ACRY,",",ACRJ) Q:'ACRSSDA D Q:$D(ACRQUIT)
.I $D(^ACRRR("B",+ACRSS(ACRSSDA))) D Q
..W *7,*7
..W !!,"Receiving action on file for item ",ACRSSDA,"."
..W !,"It cannot be cancelled."
..H 2
..S ACRQUIT=""
.S ACRCAN($P(ACRSS(ACRSSDA),U))=""
.K ^ACRSS("C",ACRDOCDA,$P(ACRSS(ACRSSDA),U))
.K ^ACRSS("J",ACRDOCDA,$P(ACRSS(ACRSSDA),U))
.K ^ACRSS("E",ACRDOCDA,+$G(^ACRSS($P(ACRSS(ACRSSDA),U),0)),$P(ACRSS(ACRSSDA),U))
.S DA=+ACRSS(ACRSSDA)
.S DIE="^ACRSS("
.S DR="[ACR REJECTION/CANCELLATION]"
.D DDS^ACRFDIC
.Q:'$D(ACRSCREN)
.K ACRSCREN
.W !
.D DIE^ACRFDIC
.K ACREASON
I $D(ACRQUIT) K ACRQUIT Q
I $D(ACRNEWPO) K ACRNEWPO D DEL Q
S ACRTXDA=$P(ACRDOC0,U,4)
S ACRID=$P(ACRDOC0,U,14)
S ACRTXPFX="PO"
S (ACRREF,ACRREFX)=116
S ACRREFDA=$O(^AUTTDOCR("B",ACRREF,0))
S ACRCANDA=$P(ACROBL0,U,4)
S (ACRLBDA,ACRZDA,ACRFDNO)=$P(ACROBL0,U,3)
S ACRALWNO=$P(ACROBL0,U,8)
S ACRSSADA=$P(ACROBL0,U,7)
S ACRAPPDA=$P(ACROBL0,U,9)
S ACRTXOBJ=$P(ACROBLDT,U,3)
N X
S X=+$G(^ACRDOC(ACRDOCDA,"PA"))
;S X=$P($G(^VA(200,+X,0)),U) ;ACR*2.1*19.02 IM16848
S X=$$NAME2^ACRFUTL1(+X) ;ACR*2.1*19.02 IM16848
S X=$P($P(X,",",2)," ")_" "_$P(X,",")
W !!,"A new PO is being generated."
W !,"This PO will be assigned to ",X," to process."
W !,"Please contact this purchasing agent with any quesitons regarding this order."
D EN^ACRFAUTO
Q
DEL N ACRX
S ACRX=0
F S ACRX=$O(ACRCAN(ACRX)) Q:'ACRX D
.S DA=ACRX
.S DIE="^ACRSS("
.S DR="13////0;16////0;16.1////0;18////0"
.D DIE^ACRFDIC
.K ^ACRSS("C",ACRDOCDA,ACRX),^ACRSS("J",ACRDOCDA,ACRX)
Q
ACRFRR2 ;IHS/OIRM/DSD/THL,AEF - CANCEL ITEMS FROM RECEIVING REPORT; [ 09/23/2005 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFRR
CANCEL ;EP;
+1 NEW ACRCAN
+2 SET DIR(0)="YO"
+3 SET DIR("A")="Create PO for cancelled items"
+4 SET DIR("B")="NO"
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF Y'=1
SET ACRNEWPO=""
+8 SET DIR(0)="LO^1:"_ACRSSMAX
+9 SET DIR("A")="Cancel which items(s)"
+10 WRITE !
+11 DO DIR^ACRFDIC
+12 IF 'Y!$DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+13 NEW ACRY
+14 SET ACRY=Y
+15 FOR ACRJ=1:1
SET ACRSSDA=$PIECE(ACRY,",",ACRJ)
IF 'ACRSSDA
QUIT
Begin DoDot:1
+16 IF $DATA(^ACRRR("B",+ACRSS(ACRSSDA)))
Begin DoDot:2
+17 WRITE *7,*7
+18 WRITE !!,"Receiving action on file for item ",ACRSSDA,"."
+19 WRITE !,"It cannot be cancelled."
+20 HANG 2
+21 SET ACRQUIT=""
End DoDot:2
QUIT
+22 SET ACRCAN($PIECE(ACRSS(ACRSSDA),U))=""
+23 KILL ^ACRSS("C",ACRDOCDA,$PIECE(ACRSS(ACRSSDA),U))
+24 KILL ^ACRSS("J",ACRDOCDA,$PIECE(ACRSS(ACRSSDA),U))
+25 KILL ^ACRSS("E",ACRDOCDA,+$GET(^ACRSS($PIECE(ACRSS(ACRSSDA),U),0)),$PIECE(ACRSS(ACRSSDA),U))
+26 SET DA=+ACRSS(ACRSSDA)
+27 SET DIE="^ACRSS("
+28 SET DR="[ACR REJECTION/CANCELLATION]"
+29 DO DDS^ACRFDIC
+30 IF '$DATA(ACRSCREN)
QUIT
+31 KILL ACRSCREN
+32 WRITE !
+33 DO DIE^ACRFDIC
+34 KILL ACREASON
End DoDot:1
IF $DATA(ACRQUIT)
QUIT
+35 IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+36 IF $DATA(ACRNEWPO)
KILL ACRNEWPO
DO DEL
QUIT
+37 SET ACRTXDA=$PIECE(ACRDOC0,U,4)
+38 SET ACRID=$PIECE(ACRDOC0,U,14)
+39 SET ACRTXPFX="PO"
+40 SET (ACRREF,ACRREFX)=116
+41 SET ACRREFDA=$ORDER(^AUTTDOCR("B",ACRREF,0))
+42 SET ACRCANDA=$PIECE(ACROBL0,U,4)
+43 SET (ACRLBDA,ACRZDA,ACRFDNO)=$PIECE(ACROBL0,U,3)
+44 SET ACRALWNO=$PIECE(ACROBL0,U,8)
+45 SET ACRSSADA=$PIECE(ACROBL0,U,7)
+46 SET ACRAPPDA=$PIECE(ACROBL0,U,9)
+47 SET ACRTXOBJ=$PIECE(ACROBLDT,U,3)
+48 NEW X
+49 SET X=+$GET(^ACRDOC(ACRDOCDA,"PA"))
+50 ;S X=$P($G(^VA(200,+X,0)),U) ;ACR*2.1*19.02 IM16848
+51 ;ACR*2.1*19.02 IM16848
SET X=$$NAME2^ACRFUTL1(+X)
+52 SET X=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")
+53 WRITE !!,"A new PO is being generated."
+54 WRITE !,"This PO will be assigned to ",X," to process."
+55 WRITE !,"Please contact this purchasing agent with any quesitons regarding this order."
+56 DO EN^ACRFAUTO
+57 QUIT
DEL NEW ACRX
+1 SET ACRX=0
+2 FOR
SET ACRX=$ORDER(ACRCAN(ACRX))
IF 'ACRX
QUIT
Begin DoDot:1
+3 SET DA=ACRX
+4 SET DIE="^ACRSS("
+5 SET DR="13////0;16////0;16.1////0;18////0"
+6 DO DIE^ACRFDIC
+7 KILL ^ACRSS("C",ACRDOCDA,ACRX),^ACRSS("J",ACRDOCDA,ACRX)
End DoDot:1
+8 QUIT
