FBAABDL ;AISC/DMK - DELETE A BATCH ;7/14/14 12:07
;;3.5;FEE BASIS;**132,154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;This routine allows the deletion of a batch that has no line
;items associated with it. Access is restricted to the user
;who opened the batch or the holder of the 'FBAA LEVEL 2'
;security key.
BT ;select batch
S FBNO=1
W ! S DIC="^FBAA(161.7,",DIC(0)="AEQZ",DIC("S")=$S($D(^XUSEC("FBAA LEVEL 2",DUZ)):"",1:"I $P(^(0),U,5)=DUZ")
D ^DIC K DIC G END:X=""!(X="^") G BT:Y<0 S FBBAT=+Y,FBBAT(0)=Y(0)
;
I $$GET1^DIQ(161.7,FBBAT_",",25,"I")=1 W !!,"Batch cannot be deleted because:",!?5,$P($T(NOGO+6),";;",2) S FBNO=0 D END G BT
;reset batch line count and total dollars first
I $G(FBBAT) N FBTOTAL,FBLCNT D
. D CNTTOT^FBAARB(FBBAT) S DA=FBBAT,DIE="^FBAA(161.7,",DR="10////^S X=FBLCNT;8////^S X=FBTOTAL;S:FBLCNT!(FBTOTAL) Y="""";9///@" D ^DIE K DIE,DR,DA D
..S:FBTOTAL=0 $P(^FBAA(161.7,+FBBAT,0),U,9)=""
..S:FBLCNT=0 $P(^FBAA(161.7,+FBBAT,0),U,11)=""
. S FBBAT(0)=^FBAA(161.7,+FBBAT,0)
;
;check to see if batch meets criteria for deletion
;Total Dollars '>0 Invoice Count '>0
;Payment Line Count '>0 Rejects Pending flag '= "Y"
;
F I=9,10,11 I $P(FBBAT(0),U,I)>0 W !!?5,$P($T(NOGO+(I-8)),";;",2) S FBNO=0 D END G BT
;check to see if any invoices point to batch
S FBTYPE=$P(^FBAA(161.7,FBBAT,0),"^",3) I $S(FBTYPE="B3":$D(^FBAAC("AC",FBBAT)),FBTYPE="B5":$D(^FBAA(162.1,"AE",FBBAT)),FBTYPE="B9":$D(^FBAAI("AC",FBBAT)),FBTYPE="B2":$D(^FBAAC("AD",FBBAT)),1:0) D D END G BT
.W !!?5,$P($T(NOGO+5),";;",2)
I $P(FBBAT(0),U,17)="Y" W !!?5,$P($T(NOGO+4),";;",2) S FBNO=0 D END G BT
;display batch and ask if sure want to delete
W !! S DIC="^FBAA(161.7,",DA=FBBAT,DR="0:1;ST" D EN^DIQ K DIC,DR,DA
;
S DIR(0)="Y",DIR("B")="No",DIR("A")="Sure you want to DELETE this batch" D ^DIR K DIR S:'Y FBNO=0
I $D(DIRUT)!('Y) D END G BT
;
;delete batch
I $G(FBNO) S DA=FBBAT,DIK="^FBAA(161.7," D ^DIK K DIK
W !!?5,*7,"Batch Deleted.",!
D END G BT
;
END K DA,I,FBBAT,FBNO,X,Y,FBTYPE Q
;
NOGO ;reasons why batch cannot be deleted
;;TOTAL DOLLARS in batch is greater than zero.
;;INVOICE COUNT in batch is greater than zero.
;;PAYMENT LINE COUNT in batch is greater than zero.
;;REJECTS PENDING flag in batch is set to 'YES'.
;;Batch has INVOICES associated with it.
;;Batch was rejected using the Reprocess Overdue Batch option.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAABDL 2472 printed Dec 13, 2024@01:54:55 Page 2
FBAABDL ;AISC/DMK - DELETE A BATCH ;7/14/14 12:07
+1 ;;3.5;FEE BASIS;**132,154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;This routine allows the deletion of a batch that has no line
+4 ;items associated with it. Access is restricted to the user
+5 ;who opened the batch or the holder of the 'FBAA LEVEL 2'
+6 ;security key.
BT ;select batch
+1 SET FBNO=1
+2 WRITE !
SET DIC="^FBAA(161.7,"
SET DIC(0)="AEQZ"
SET DIC("S")=$SELECT($DATA(^XUSEC("FBAA LEVEL 2",DUZ)):"",1:"I $P(^(0),U,5)=DUZ")
+3 DO ^DIC
KILL DIC
if X=""!(X="^")
GOTO END
if Y<0
GOTO BT
SET FBBAT=+Y
SET FBBAT(0)=Y(0)
+4 ;
+5 IF $$GET1^DIQ(161.7,FBBAT_",",25,"I")=1
WRITE !!,"Batch cannot be deleted because:",!?5,$PIECE($TEXT(NOGO+6),";;",2)
SET FBNO=0
DO END
GOTO BT
+6 ;reset batch line count and total dollars first
+7 IF $GET(FBBAT)
NEW FBTOTAL,FBLCNT
Begin DoDot:1
+8 DO CNTTOT^FBAARB(FBBAT)
SET DA=FBBAT
SET DIE="^FBAA(161.7,"
SET DR="10////^S X=FBLCNT;8////^S X=FBTOTAL;S:FBLCNT!(FBTOTAL) Y="""";9///@"
DO ^DIE
KILL DIE,DR,DA
Begin DoDot:2
+9 if FBTOTAL=0
SET $PIECE(^FBAA(161.7,+FBBAT,0),U,9)=""
+10 if FBLCNT=0
SET $PIECE(^FBAA(161.7,+FBBAT,0),U,11)=""
End DoDot:2
+11 SET FBBAT(0)=^FBAA(161.7,+FBBAT,0)
End DoDot:1
+12 ;
+13 ;check to see if batch meets criteria for deletion
+14 ;Total Dollars '>0 Invoice Count '>0
+15 ;Payment Line Count '>0 Rejects Pending flag '= "Y"
+16 ;
+17 FOR I=9,10,11
IF $PIECE(FBBAT(0),U,I)>0
WRITE !!?5,$PIECE($TEXT(NOGO+(I-8)),";;",2)
SET FBNO=0
DO END
GOTO BT
+18 ;check to see if any invoices point to batch
+19 SET FBTYPE=$PIECE(^FBAA(161.7,FBBAT,0),"^",3)
IF $SELECT(FBTYPE="B3":$DATA(^FBAAC("AC",FBBAT)),FBTYPE="B5":$DATA(^FBAA(162.1,"AE",FBBAT)),FBTYPE="B9":$DATA(^FBAAI("AC",FBBAT)),FBTYPE="B2":$DATA(^FBAAC("AD",FBBAT)),1:0)
Begin DoDot:1
+20 WRITE !!?5,$PIECE($TEXT(NOGO+5),";;",2)
End DoDot:1
DO END
GOTO BT
+21 IF $PIECE(FBBAT(0),U,17)="Y"
WRITE !!?5,$PIECE($TEXT(NOGO+4),";;",2)
SET FBNO=0
DO END
GOTO BT
+22 ;display batch and ask if sure want to delete
+23 WRITE !!
SET DIC="^FBAA(161.7,"
SET DA=FBBAT
SET DR="0:1;ST"
DO EN^DIQ
KILL DIC,DR,DA
+24 ;
+25 SET DIR(0)="Y"
SET DIR("B")="No"
SET DIR("A")="Sure you want to DELETE this batch"
DO ^DIR
KILL DIR
if 'Y
SET FBNO=0
+26 IF $DATA(DIRUT)!('Y)
DO END
GOTO BT
+27 ;
+28 ;delete batch
+29 IF $GET(FBNO)
SET DA=FBBAT
SET DIK="^FBAA(161.7,"
DO ^DIK
KILL DIK
+30 WRITE !!?5,*7,"Batch Deleted.",!
+31 DO END
GOTO BT
+32 ;
END KILL DA,I,FBBAT,FBNO,X,Y,FBTYPE
QUIT
+1 ;
NOGO ;reasons why batch cannot be deleted
+1 ;;TOTAL DOLLARS in batch is greater than zero.
+2 ;;INVOICE COUNT in batch is greater than zero.
+3 ;;PAYMENT LINE COUNT in batch is greater than zero.
+4 ;;REJECTS PENDING flag in batch is set to 'YES'.
+5 ;;Batch has INVOICES associated with it.
+6 ;;Batch was rejected using the Reprocess Overdue Batch option.
