- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCHSTAT 1635 printed Mar 13, 2025@21:02:56 Page 2
- FBCHSTAT ;AISC/DMK-REQUEST STATS ;04MAY90
- +1 ;;3.5;FEE BASIS;;JAN 30, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- EN DO DATE^FBAAUTL
- if FBPOP
- GOTO END
- SET FBFRDT=BEGDATE
- SET FBTODT=ENDDATE+.99999
- +1 SET VAR="FBFRDT^FBTODT"
- SET VAL=FBFRDT_"^"_FBTODT
- SET PGM="START^FBCHSTAT"
- DO ZIS^FBAAUTL
- if FBPOP
- GOTO END
- START USE IO
- if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- SET (FBTOT,FBINEL,FBAAOUT,FBPCNT)=0
- SET FB(1)=""
- DO HED
- +1 FOR I=FBFRDT:0
- SET I=$ORDER(^FBAA(162.2,"B",I))
- if I'>0!(I>FBTODT)!(FBAAOUT)
- QUIT
- FOR J=0:0
- SET J=$ORDER(^FBAA(162.2,"B",I,J))
- if J'>0!(FBAAOUT)
- QUIT
- IF $DATA(^FBAA(162.2,J,0))
- SET FB(0)=^(0)
- DO GET
- +2 if 'FBAAOUT
- WRITE !!,"Total Requests: ",FBTOT,!,"# of Requests Denied: ",FBINEL,!,"# of Requests Pending: ",FBPCNT
- END KILL ENDDATE,FB,FBPCNT,FBAAOUT,FBDATE,FBFRDT,FBTODT,FBINEL,FBTOT,FBVEN,FBVET,I,J,Q,QQ,X,Y
- DO CLOSE^FBAAUTL
- QUIT
- GET if '$PIECE(FB(0),U,4)
- QUIT
- SET FBVET=+$PIECE(FB(0),"^",4)
- SET FBVET=$PIECE($GET(^DPT(FBVET,0)),U)
- if FBVET']""
- SET FBVET="UNKNOWN"
- SET FBVEN=+$PIECE(FB(0),"^",2)
- SET FBVEN=$PIECE($GET(^FBAAV(FBVEN,0)),U)
- SET FBVEN=$SELECT(FBVEN]"":$EXTRACT(FBVEN,1,35),1:"UNKNOWN")
- +1 SET FBTOT=FBTOT+1
- SET FBINEL=FBINEL+$SELECT($PIECE(FB(0),"^",9)="N":1,$PIECE(FB(0),"^",12)="N":1,1:0)
- SET FB(1)=""
- +2 IF $PIECE(FB(0),"^",9)="N"
- SET FB(1)="!"
- +3 IF $PIECE(FB(0),"^",12)="N"
- SET FB(1)="!"
- +4 SET Y=$PIECE(FB(0),"^",5)
- XECUTE ^DD("DD")
- SET FBDATE=$PIECE(Y,"@")
- +5 IF $PIECE(FB(0),"^",15)'=3
- SET FBPCNT=FBPCNT+1
- SET FB(1)="+"
- +6 WRITE !,FB(1),?3,FBVET,?32,FBVEN,?69,FBDATE
- +7 IF $Y+4>IOSL
- IF $EXTRACT(IOST)="C"
- DO HANG^FBAAUTL1
- if FBAAOUT
- QUIT
- WRITE @IOF
- DO HED
- +8 IF '$TEST
- IF $Y+4>IOSL
- WRITE @IOF
- DO HED
- +9 QUIT
- HED SET Q=""
- SET $PIECE(Q,"=",80)="="
- SET QQ=""
- SET $PIECE(QQ,"-",38)="-"
- +1 WRITE !,?16,"CONTRACT HOSPITAL REQUEST STATISTICS",!,?15,QQ,!,?22,"('+' Request Pending)",!,?22,"('!' Request Denied)",!
- +2 WRITE ?1,"VETERAN",?32,"VENDOR",?69,"ADMISSION",!,Q,!!
- +3 QUIT
