source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBCHSTAT.m@ 1732

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1FBCHSTAT ;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.
4EN 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
6START 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
9END K ENDDATE,FB,FBPCNT,FBAAOUT,FBDATE,FBFRDT,FBTODT,FBINEL,FBTOT,FBVEN,FBVET,I,J,Q,QQ,X,Y D CLOSE^FBAAUTL Q
10GET 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
20HED 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
Note: See TracBrowser for help on using the repository browser.