source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMBSP5.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1DGPMBSP5 ;ALB/LM - BSR PRINT, CONT.; 13 JUNE 90
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4A Q:'AT
5 ;
6 S X="A V E R A G E D A I L Y C E N S U S (ADC)"
7 ;
8 W ! W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
9 W !?0,"|",?(RM-$L(X)\2),X,?130,"|"
10 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
11 W !?0,"|",?57,"|",?67,"Cumulative FYTD",?93,"||",?103,"Cumulative MONTH",?130,"|"
12 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
13 W !?0,"|","DIVISION",?57,"|",?61,"Hospital|",?77,"NHCU|",?89,"Dom.||",?98,"Hospital|",?114,"NHCU|",?126,"Dom.|"
14 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
15 S D=0
16 F D1=0:0 S D=$O(ADC(D)) Q:D'>0 I $D(^DG(40.8,+D,0)) S X=^(0),X1=$S($D(^DG(40.8,+D,"CEN",RD,0)):^(0),1:0) D WADC
17 K I,X,X1,X2,L
18Q Q
19 ;
20WADC W !?0,"|",$E($P(X,"^"),1,30),?49,"Planned |",$J(+$P(X1,"^",4),11,1),"|",$J(+$P(X1,"^",2),11,1),"|",$J(+$P(X1,"^",10),11,1),"||",$J(+$P(X1,"^",3),11,1),"|",$J(+$P(X1,"^",11),11,1),"|",$J(+$P(X1,"^",12),11,1),"|"
21 S X2=""
22 F I=1:1:3 S X=$S($D(ADC(D,I)):ADC(D,I),1:0),$P(X2,"^",I)=+$P(X,"^"),$P(X2,"^",(I+3))=+$P(X,"^",2)
23 W !?0,"|",?50,"ACTUAL |"
24 F I=1:1:3 S X=$P(X2,"^",I)/FY("D") W $J(X,11,1),"|"
25 W "|" F I=4:1:6 S X=$P(X2,"^",I)/FY("DIM") W $J(X,11,1),"|"
26 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
27 Q
Note: See TracBrowser for help on using the repository browser.