BDGCEN11.m

BDGCEN11 ; IHS/ANMC/LJF - CENSUS AID-LIST BY WARD&SRV ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;

 NEW DGDT,STR,SRV,X

 ; -- loop thru census files by ward & service

 S DGDT=BDGBD-.0001

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

 . ;

 . ; print totals for ward for date

 . S STR=$G(^BDGCWD(BDGWD,1,DGDT,0))

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

 . W ?17,$P(STR,U,3),?27,$P(STR,U,5)

 . W ?37,$P(STR,U,6),?48,$P(STR,U,4)

 . W ?58,$P(STR,U,7),?69,$P(STR,U,2)

 . ;

 . ; now loop through services within ward

 . S SRV=0

 . F  S SRV=$O(^BDGCWD(BDGWD,1,DGDT,1,SRV)) Q:'SRV  D

 .. Q:'$D(^BDGCWD(BDGWD,1,DGDT,1,SRV,0))

 .. S X=$P(^BDGCWD(BDGWD,1,DGDT,1,SRV,0),U,2,21)

 .. S X=$$STRIP^XLFSTR(X,U),X=$$STRIP^XLFSTR(X,"0") Q:X=""

 .. ;

 .. ; print numbers of service within ward

 .. S STR=^BDGCWD(BDGWD,1,DGDT,1,SRV,0)

 .. W !?3,$$GET1^DIQ(45.7,SRV,99)                     ;abbreviation

 .. W ?17,$P(STR,U,3)+$P(STR,U,13)                    ;admissions

 .. W ?27,$P(STR,U,5)+$P(STR,U,15)                    ;transfer in

 .. W ?37,$P(STR,U,6)+$P(STR,U,16)                    ;transfer out

 .. W ?48,$P(STR,U,4)+$P(STR,U,14)                    ;discharge

 .. W ?58,$P(STR,U,7)+$P(STR,U,17)                    ;deaths

 .. W ?69,$P(STR,U,2)+$P(STR,U,12)                    ;pts remaining

 . W !

 Q

 ;

BDGCEN11  ; IHS/ANMC/LJF - CENSUS AID-LIST BY WARD&SRV ; 

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

 +2       ;

 +3        NEW DGDT,STR,SRV,X

 +4       ; -- loop thru census files by ward & service

 +5        SET DGDT=BDGBD-.0001

 +6        FOR 

               SET DGDT=$ORDER(^BDGCWD(BDGWD,1,DGDT))

               IF 'DGDT

                   QUIT 

               IF (DGDT>BDGED)

                   QUIT 

               Begin DoDot:1

 +7       ;

 +8       ; print totals for ward for date

 +9                SET STR=$GET(^BDGCWD(BDGWD,1,DGDT,0))

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

 +11               WRITE ?17,$PIECE(STR,U,3),?27,$PIECE(STR,U,5)

 +12               WRITE ?37,$PIECE(STR,U,6),?48,$PIECE(STR,U,4)

 +13               WRITE ?58,$PIECE(STR,U,7),?69,$PIECE(STR,U,2)

 +14      ;

 +15      ; now loop through services within ward

 +16               SET SRV=0

 +17               FOR 

                       SET SRV=$ORDER(^BDGCWD(BDGWD,1,DGDT,1,SRV))

                       IF 'SRV

                           QUIT 

                       Begin DoDot:2

 +18                       IF '$DATA(^BDGCWD(BDGWD,1,DGDT,1,SRV,0))

                               QUIT 

 +19                       SET X=$PIECE(^BDGCWD(BDGWD,1,DGDT,1,SRV,0),U,2,21)

 +20                       SET X=$$STRIP^XLFSTR(X,U)

                           SET X=$$STRIP^XLFSTR(X,"0")

                           IF X=""

                               QUIT 

 +21      ;

 +22      ; print numbers of service within ward

 +23                       SET STR=^BDGCWD(BDGWD,1,DGDT,1,SRV,0)

 +24      ;abbreviation

                           WRITE !?3,$$GET1^DIQ(45.7,SRV,99)

 +25      ;admissions

                           WRITE ?17,$PIECE(STR,U,3)+$PIECE(STR,U,13)

 +26      ;transfer in

                           WRITE ?27,$PIECE(STR,U,5)+$PIECE(STR,U,15)

 +27      ;transfer out

                           WRITE ?37,$PIECE(STR,U,6)+$PIECE(STR,U,16)

 +28      ;discharge

                           WRITE ?48,$PIECE(STR,U,4)+$PIECE(STR,U,14)

 +29      ;deaths

                           WRITE ?58,$PIECE(STR,U,7)+$PIECE(STR,U,17)

 +30      ;pts remaining

                           WRITE ?69,$PIECE(STR,U,2)+$PIECE(STR,U,12)

                       End DoDot:2

 +31               WRITE !

               End DoDot:1

 +32       QUIT 

 +33      ;