- 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 Mar 13, 2025@20:59:38 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.
