| [613] | 1 | FBAADCB ;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 | ;
|
|---|
| 7 | START 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 | ;
|
|---|
| 11 | Q 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 | ;
|
|---|
| 14 | HED W !?22,"FEE BATCHES PENDING RELEASE",!!,"Batch #",?10,"Date Closed",?25,"Clerk Who Opened",?54,"FCP-Obligation #",?72,"Total $",!,Q
|
|---|
| 15 | Q
|
|---|
| 16 | WRT 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
|
|---|
| 22 | HANG 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
|
|---|
| 25 | FCP ;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
|
|---|
