source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAADCB.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: 1.4 KB
Line 
1FBAADCB ;AISC/GRR-DISPLAY CLOSED BATCHES ;03JAN86
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 I '$D(^FBAA(161.7,"AC","C")) W !!,*7,"There are No Closed Batches that have not been Certified!",!! G Q
5 W ! S PGM="START^FBAADCB",VAR="" D ZIS^FBAAUTL G Q:FBPOP
6 ;
7START U IO S FBAAOUT=0,Q="",$P(Q,"=",80)="=" W:$E(IOST,1,2)="C-" @IOF D HED
8 F B=0:0 S B=$O(^FBAA(161.7,"AC","C",B)) Q:B'>0!(FBAAOUT) I $D(^FBAA(161.7,B,0)) S Z=^(0) D WRT
9 F B=0:0 S B=$O(^FBAA(161.7,"AC","A",B)) Q:B'>0!(FBAAOUT) I $D(^FBAA(161.7,B,0)) S Z=^(0) D WRT
10 ;
11Q K A,B1,B2,B3,B4,B5,B6,Q,X,ZZ,Z,B,D,Y,FBAAOUT,PRC,PRCSCPAN,DIRUT
12 D CLOSE^FBAAUTL Q
13 ;
14HED W !?22,"FEE BATCHES PENDING RELEASE",!!,"Batch #",?10,"Date Closed",?25,"Clerk Who Opened",?54,"FCP-Obligation #",?72,"Total $",!,Q
15 Q
16WRT I $Y+5>IOSL D HANG Q:FBAAOUT
17 S B1=$P(Z,"^"),B4=$P(Z,"^",2),B2=$P(Z,"^",13),B2=$E(B2,4,5)_"/"_$E(B2,6,7)_"/"_$E(B2,2,3)
18 S B3=$P($G(^VA(200,+$P(Z,"^",5),0)),"^"),B5=$P(Z,"^",9)+.0001,B5=$P(B5,".",1)_"."_$E($P(B5,".",2),1,2)
19 D FCP S B4=$S(B6="":B4,1:B6_"-"_B4)
20 W !!,B1,?11,B2,?25,B3,?55,B4,?71,$J(B5,8)
21 Q
22HANG I $E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
23 W @IOF D HED
24 Q
25FCP ;GET FCP FROM IFCAP
26 I $P(Z,"^",8)="" S B6="" Q
27 S PRC("SITE")=$P(Z,"^",8),PRCS("X")=PRC("SITE")_"-"_B4
28 N Z,B,B1,B2,B3,B4,B5,Q
29 D EN1^PRCS58
30 S B6=$S(Y=-1:"",1:+$P(Y,"^",3))
31 Q
Note: See TracBrowser for help on using the repository browser.