FBCHSTAT ;AISC/DMK-REQUEST STATS ;04MAY90
 ;;3.5;FEE BASIS;;JAN 30, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
EN D DATE^FBAAUTL G END:FBPOP S FBFRDT=BEGDATE,FBTODT=ENDDATE+.99999
 S VAR="FBFRDT^FBTODT",VAL=FBFRDT_"^"_FBTODT,PGM="START^FBCHSTAT" D ZIS^FBAAUTL G END:FBPOP
START U IO W:$E(IOST,1,2)="C-" @IOF S (FBTOT,FBINEL,FBAAOUT,FBPCNT)=0,FB(1)="" D HED
 F I=FBFRDT:0 S I=$O(^FBAA(162.2,"B",I)) Q:I'>0!(I>FBTODT)!(FBAAOUT)  F J=0:0 S J=$O(^FBAA(162.2,"B",I,J)) Q:J'>0!(FBAAOUT)  I $D(^FBAA(162.2,J,0)) S FB(0)=^(0) D GET
 W:'FBAAOUT !!,"Total Requests: ",FBTOT,!,"# of Requests Denied: ",FBINEL,!,"# of Requests Pending: ",FBPCNT
END K ENDDATE,FB,FBPCNT,FBAAOUT,FBDATE,FBFRDT,FBTODT,FBINEL,FBTOT,FBVEN,FBVET,I,J,Q,QQ,X,Y D CLOSE^FBAAUTL Q
GET Q:'$P(FB(0),U,4)  S FBVET=+$P(FB(0),"^",4),FBVET=$P($G(^DPT(FBVET,0)),U) S:FBVET']"" FBVET="UNKNOWN" S FBVEN=+$P(FB(0),"^",2),FBVEN=$P($G(^FBAAV(FBVEN,0)),U),FBVEN=$S(FBVEN]"":$E(FBVEN,1,35),1:"UNKNOWN")
 S FBTOT=FBTOT+1,FBINEL=FBINEL+$S($P(FB(0),"^",9)="N":1,$P(FB(0),"^",12)="N":1,1:0),FB(1)=""
 I $P(FB(0),"^",9)="N" S FB(1)="!"
 I $P(FB(0),"^",12)="N" S FB(1)="!"
 S Y=$P(FB(0),"^",5) X ^DD("DD") S FBDATE=$P(Y,"@")
 I $P(FB(0),"^",15)'=3 S FBPCNT=FBPCNT+1,FB(1)="+"
 W !,FB(1),?3,FBVET,?32,FBVEN,?69,FBDATE
 I $Y+4>IOSL,$E(IOST)="C" D HANG^FBAAUTL1 Q:FBAAOUT  W @IOF D HED
 E  I $Y+4>IOSL W @IOF D HED
 Q
HED S Q="",$P(Q,"=",80)="=",QQ="",$P(QQ,"-",38)="-"
 W !,?16,"CONTRACT HOSPITAL REQUEST STATISTICS",!,?15,QQ,!,?22,"('+' Request Pending)",!,?22,"('!' Request Denied)",!
 W ?1,"VETERAN",?32,"VENDOR",?69,"ADMISSION",!,Q,!!
 Q