DGPMBSP5.m

DGPMBSP5 ;ALB/LM - BSR PRINT, CONT.; 13 JUNE 90

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 ;

A Q:'AT

 ;

 S X="A V E R A G E    D A I L Y   C E N S U S   (ADC)"

 ;

 W ! W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL

 W !?0,"|",?(RM-$L(X)\2),X,?130,"|"

 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL

 W !?0,"|",?57,"|",?67,"Cumulative FYTD",?93,"||",?103,"Cumulative MONTH",?130,"|"

 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL

 W !?0,"|","DIVISION",?57,"|",?61,"Hospital|",?77,"NHCU|",?89,"Dom.||",?98,"Hospital|",?114,"NHCU|",?126,"Dom.|"

 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL

 S D=0

 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

 K I,X,X1,X2,L

Q Q

 ;

WADC 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),"|"

 S X2=""

 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)

 W !?0,"|",?50,"ACTUAL |"

 F I=1:1:3 S X=$P(X2,"^",I)/FY("D") W $J(X,11,1),"|"

 W "|" F I=4:1:6 S X=$P(X2,"^",I)/FY("DIM") W $J(X,11,1),"|"

 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL

 Q

DGPMBSP5  ;ALB/LM - BSR PRINT, CONT.; 13 JUNE 90

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +2       ;

A          IF 'AT

               QUIT 

 +1       ;

 +2        SET X="A V E R A G E    D A I L Y   C E N S U S   (ADC)"

 +3       ;

 +4        WRITE !

           IF $Y<131

               WRITE ?131,""

           WRITE $CHAR(13)

           IF UL["-"

               WRITE !

           FOR L=1:1:131

               WRITE UL

 +5        WRITE !?0,"|",?(RM-$LENGTH(X)\2),X,?130,"|"

 +6        IF $Y<131

               WRITE ?131,""

           WRITE $CHAR(13)

           IF UL["-"

               WRITE !

           FOR L=1:1:131

               WRITE UL

 +7        WRITE !?0,"|",?57,"|",?67,"Cumulative FYTD",?93,"||",?103,"Cumulative MONTH",?130,"|"

 +8        IF $Y<131

               WRITE ?131,""

           WRITE $CHAR(13)

           IF UL["-"

               WRITE !

           FOR L=1:1:131

               WRITE UL

 +9        WRITE !?0,"|","DIVISION",?57,"|",?61,"Hospital|",?77,"NHCU|",?89,"Dom.||",?98,"Hospital|",?114,"NHCU|",?126,"Dom.|"

 +10       IF $Y<131

               WRITE ?131,""

           WRITE $CHAR(13)

           IF UL["-"

               WRITE !

           FOR L=1:1:131

               WRITE UL

 +11       SET D=0

 +12       FOR D1=0:0

               SET D=$ORDER(ADC(D))

               IF D'>0

                   QUIT 

               IF $DATA(^DG(40.8,+D,0))

                   SET X=^(0)

                   SET X1=$SELECT($DATA(^DG(40.8,+D,"CEN",RD,0)):^(0),1:0)

                   DO WADC

 +13       KILL I,X,X1,X2,L

Q          QUIT 

 +1       ;

WADC      WRITE !?0,"|",$EXTRACT($PIECE(X,"^"),1,30),?49,"Planned |",$JUSTIFY(+$PIECE(X1,"^",4),11,1),"|",$JUSTIFY(+$PIECE(X1,"^",2),11,1),"|",$JUSTIFY(+$PIECE(X1,"^",10),11,1),"||",...

           ... $JUSTIFY(+$PIECE(X1,"^",3),11,1),"|",$JUSTIFY(+$PIECE(X1,"^",11),11,1),"|",$JUSTIFY(+$PIECE(X1,"^",12),11,1),"|"

 +1        SET X2=""

 +2        FOR I=1:1:3

               SET X=$SELECT($DATA(ADC(D,I)):ADC(D,I),1:0)

               SET $PIECE(X2,"^",I)=+$PIECE(X,"^")

               SET $PIECE(X2,"^",(I+3))=+$PIECE(X,"^",2)

 +3        WRITE !?0,"|",?50,"ACTUAL |"

 +4        FOR I=1:1:3

               SET X=$PIECE(X2,"^",I)/FY("D")

               WRITE $JUSTIFY(X,11,1),"|"

 +5        WRITE "|"

           FOR I=4:1:6

               SET X=$PIECE(X2,"^",I)/FY("DIM")

               WRITE $JUSTIFY(X,11,1),"|"

 +6        IF $Y<131

               WRITE ?131,""

           WRITE $CHAR(13)

           IF UL["-"

               WRITE !

           FOR L=1:1:131

               WRITE UL

 +7        QUIT