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