source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAABDL.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1FBAABDL ;AISC/DMK-DELETE A BATCH ;23JUL93
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;This routine allows the deletion of a batch that has no line
5 ;items associated with it. Access is restricted to the user
6 ;who opened the batch or the holder of the 'FBAASUPERVISOR'
7 ;security key.
8BT ;select batch
9 S FBNO=1
10 W ! S DIC="^FBAA(161.7,",DIC(0)="AEQZ",DIC("S")=$S($D(^XUSEC("FBAASUPERVISOR",DUZ)):"",1:"I $P(^(0),U,5)=DUZ")
11 D ^DIC K DIC G END:X=""!(X="^") G BT:Y<0 S FBBAT=+Y,FBBAT(0)=Y(0)
12 ;
13 ;reset batch line count and total dollars first
14 I $G(FBBAT) N FBTOTAL,FBLCNT D
15 . 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
16 ..S:FBTOTAL=0 $P(^FBAA(161.7,+FBBAT,0),U,9)=""
17 ..S:FBLCNT=0 $P(^FBAA(161.7,+FBBAT,0),U,11)=""
18 . S FBBAT(0)=^FBAA(161.7,+FBBAT,0)
19 ;
20 ;check to see if batch meets criteria for deletion
21 ;Total Dollars '>0 Invoice Count '>0
22 ;Payment Line Count '>0 Rejects Pending flag '= "Y"
23 ;
24 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
25 ;check to see if any invoices point to batch
26 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
27 .W !!?5,$P($T(NOGO+5),";;",2)
28 I $P(FBBAT(0),U,17)="Y" W !!?5,$P($T(NOGO+4),";;",2) S FBNO=0 D END G BT
29 ;display batch and ask if sure want to delete
30 W !! S DIC="^FBAA(161.7,",DA=FBBAT,DR="0;ST" D EN^DIQ K DIC,DR,DA
31 ;
32 S DIR(0)="Y",DIR("B")="No",DIR("A")="Sure you want to DELETE this batch" D ^DIR K DIR S:'Y FBNO=0
33 I $D(DIRUT)!('Y) D END G BT
34 ;
35 ;delete batch
36 I $G(FBNO) S DA=FBBAT,DIK="^FBAA(161.7," D ^DIK K DIK
37 W !!?5,*7,"Batch Deleted.",!
38 D END G BT
39 ;
40END K DA,I,FBBAT,FBNO,X,Y,FBTYPE Q
41 ;
42NOGO ;reasons why batch cannot be deleted
43 ;;TOTAL DOLLARS in batch is greater than zero.
44 ;;INVOICE COUNT in batch is greater than zero.
45 ;;PAYMENT LINE COUNT in batch is greater than zero.
46 ;;REJECTS PENDING flag in batch is set to 'YES'.
47 ;;Batch has INVOICES associated with it.
Note: See TracBrowser for help on using the repository browser.