BDGCEN20.m

BDGCEN20 ; IHS/ANMC/LJF - CENSUS AID-LIST BY SERVICE ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;

 NEW DGDT,DGSTR,ADJ

 ;

 ; adjustment for piece in node (peds items are 10 pieces higher)

 S ADJ=$S(BDGAGE="A":0,1:10)

 ;

 ; -- loop thru census file by service and print data

 S DGDT=BDGBD-.0001

 F  S DGDT=$O(^BDGCTX(BDGTX,1,DGDT)) Q:'DGDT  Q:(DGDT>BDGED)  D

 . ;

 . I '$D(^BDGCTX(BDGTX,1,DGDT,0)) D  Q

 .. W !!,"NO CENSUS DATA FOR THIS SERVICE FOR ",$$FMTE^XLFDT(DGDT),!!

 . ;

 . S DGSTR=^BDGCTX(BDGTX,1,DGDT,0)

 . W !,$E(DGDT,4,5)_"/"_$E(DGDT,6,7)_"/"_$E(DGDT,2,3)

 . W ?17,$P(DGSTR,U,3+ADJ),?27,$P(DGSTR,U,5+ADJ)

 . W ?37,$P(DGSTR,U,6+ADJ),?48,$P(DGSTR,U,4+ADJ)

 . W ?58,$P(DGSTR,U,7+ADJ),?69,$P(DGSTR,U,2+ADJ)

 Q

 ;

 ;

HEAD ;***> subrtn to print heading

 ; DGPAGE is set by calling routine

 NEW SITE,TITLE,LINE

 S SITE=$$GET1^DIQ(4,DUZ(2),.01),LINE=$$REPEAT^XLFSTR("=",80)

 S TITLE=$$GET1^DIQ(45.7,BDGTX,.01)_" SERVICE"

 ;

 W:DGPAGE>0 @IOF S DGPAGE=DGPAGE+1

 W !,$$GET1^DIQ(200,DUZ,2),?80-$L(SITE)/2,SITE

 W !,$$TIME^BDGF($$NOW^XLFDT)

 S X="ADT CENSUS DATA FOR" W ?80-$L(X)/2,X

 S Y=DT X ^DD("DD") W !,Y

 W !,$$FMTE^XLFDT(DT),?80-$L(TITLE)/2,TITLE,?70,"Page: ",DGPAGE

 W !,LINE,!,"Date",?15,"Admits",?25,"Trans In",?35,"Trans Out"

 W ?46,"Disch",?55,"Deaths",?65,"Remaining",!,LINE,!

 Q

BDGCEN20  ; IHS/ANMC/LJF - CENSUS AID-LIST BY SERVICE ; 

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

 +3        NEW DGDT,DGSTR,ADJ

 +4       ;

 +5       ; adjustment for piece in node (peds items are 10 pieces higher)

 +6        SET ADJ=$SELECT(BDGAGE="A":0,1:10)

 +7       ;

 +8       ; -- loop thru census file by service and print data

 +9        SET DGDT=BDGBD-.0001

 +10       FOR 

               SET DGDT=$ORDER(^BDGCTX(BDGTX,1,DGDT))

               IF 'DGDT

                   QUIT 

               IF (DGDT>BDGED)

                   QUIT 

               Begin DoDot:1

 +11      ;

 +12               IF '$DATA(^BDGCTX(BDGTX,1,DGDT,0))

                       Begin DoDot:2

 +13                       WRITE !!,"NO CENSUS DATA FOR THIS SERVICE FOR ",$$FMTE^XLFDT(DGDT),!!

                       End DoDot:2

                       QUIT 

 +14      ;

 +15               SET DGSTR=^BDGCTX(BDGTX,1,DGDT,0)

 +16               WRITE !,$EXTRACT(DGDT,4,5)_"/"_$EXTRACT(DGDT,6,7)_"/"_$EXTRACT(DGDT,2,3)

 +17               WRITE ?17,$PIECE(DGSTR,U,3+ADJ),?27,$PIECE(DGSTR,U,5+ADJ)

 +18               WRITE ?37,$PIECE(DGSTR,U,6+ADJ),?48,$PIECE(DGSTR,U,4+ADJ)

 +19               WRITE ?58,$PIECE(DGSTR,U,7+ADJ),?69,$PIECE(DGSTR,U,2+ADJ)

               End DoDot:1

 +20       QUIT 

 +21      ;

 +22      ;

HEAD      ;***> subrtn to print heading

 +1       ; DGPAGE is set by calling routine

 +2        NEW SITE,TITLE,LINE

 +3        SET SITE=$$GET1^DIQ(4,DUZ(2),.01)

           SET LINE=$$REPEAT^XLFSTR("=",80)

 +4        SET TITLE=$$GET1^DIQ(45.7,BDGTX,.01)_" SERVICE"

 +5       ;

 +6        IF DGPAGE>0

               WRITE @IOF

           SET DGPAGE=DGPAGE+1

 +7        WRITE !,$$GET1^DIQ(200,DUZ,2),?80-$LENGTH(SITE)/2,SITE

 +8        WRITE !,$$TIME^BDGF($$NOW^XLFDT)

 +9        SET X="ADT CENSUS DATA FOR"

           WRITE ?80-$LENGTH(X)/2,X

 +10       SET Y=DT

           XECUTE ^DD("DD")

           WRITE !,Y

 +11       WRITE !,$$FMTE^XLFDT(DT),?80-$LENGTH(TITLE)/2,TITLE,?70,"Page: ",DGPAGE

 +12       WRITE !,LINE,!,"Date",?15,"Admits",?25,"Trans In",?35,"Trans Out"

 +13       WRITE ?46,"Disch",?55,"Deaths",?65,"Remaining",!,LINE,!

 +14       QUIT