BDGCEN32.m

BDGCEN32 ; IHS/ANMC/LJF - CENSUS WARD LIST-SUMMARY ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;

 ;

 NEW LINE,DGWN,DGWD,UNDER

 S UNDER=$$REPEAT^XLFSTR("_",6)    ;underline of 6 spaces

 ;

 S LINE="<<< SUMMARY PAGE >>>"

 D SET($$SP(75-$L(LINE)\2)_$G(IORVON)_LINE_$G(IORVOFF),.VALMCNT)

 S LINE=$$PAD("Ward",16)_"Beg Census  Admits  Net Transfers  Discharges  Ending Census"

 D SET($$REPEAT^XLFSTR("=",80),.VALMCNT)

 D SET(LINE,.VALMCNT)

 D SET($$REPEAT^XLFSTR("-",80),.VALMCNT)

 ;

 ; loop through active wards by name

 S DGWN=0

 F  S DGWN=$O(^DIC(42,"B",DGWN)) Q:DGWN=""  D

 . S DGWD=0 F  S DGWD=$O(^DIC(42,"B",DGWN,DGWD)) Q:'DGWD  D

 .. I '$D(^BDGWD(DGWD)) Q                         ;deleted ward

 .. I $$GET1^DIQ(9009016.5,DGWD,.03)="INACTIVE" Q  ;inactive

 .. ;

 .. ; for each ward, list changes

 .. S LINE=$$PAD(DGWN,16)_UNDER_"  +"

 .. S LINE=$$PAD(LINE,30)_(+$G(BDGSUB(DGWN,"A")))        ;admits

 .. S LINE=$$PAD(LINE,42)_(+$G(BDGSUB(DGWN,"T")))        ;net transfers

 .. S LINE=$$PAD($$PAD(LINE,49)_"-",55)_(+$G(BDGSUB(DGWN,"D")))  ;dsch

 .. S LINE=$$PAD(LINE,65)_UNDER

 .. D SET(LINE,.VALMCNT),SET("",.VALMCNT)

 .. ;

 .. ; increment totals for whole facility

 .. S BDGTOT("A")=$G(BDGTOT("A"))+$G(BDGSUB(DGWN,"A"))

 .. S BDGTOT("T")=$G(BDGTOT("T"))+$G(BDGSUB(DGWN,"T"))

 .. S BDGTOT("D")=$G(BDGTOT("D"))+$G(BDGSUB(DGWN,"D"))

 ;

 D SET($$REPEAT^XLFSTR("=",80),.VALMCNT)

 S LINE=$$PAD("TOTALS:",16)_UNDER_"  +"

 S LINE=$$PAD(LINE,30)_(+$G(BDGTOT("A")))

 S LINE=$$PAD(LINE,42)_(+$G(BDGTOT("T")))

 S LINE=$$PAD($$PAD(LINE,49)_"-",55)_(+$G(BDGTOT("D")))

 S LINE=$$PAD(LINE,63)_"= "_UNDER

 D SET(LINE,.VALMCNT)

 ;

 S LINE=$$PAD("NEWBORNS:",16)_UNDER_"  +"

 S LINE=$$PAD(LINE,30)_(+$G(BDGNB("A")))

 S LINE=$$PAD(LINE,42)_(+$G(BDGNB("T")))

 S LINE=$$PAD($$PAD(LINE,49)_"-",55)_(+$G(BDGNB("D")))

 S LINE=$$PAD(LINE,63)_"+ "_UNDER

 D SET(LINE,.VALMCNT)

 ;

 K BDGTOT,BDGSUB,BDGNB

 Q

 ;

SET(DATA,NUM) ; put display data into array

 S NUM=NUM+1

 S ^TMP("BDGCEN3",$J,NUM,0)=DATA

 Q

 ;

PAD(D,L) ;EP -- SUBRTN to pad length of data

 ; -- D=data L=length

 Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)

 ;

SP(N) ; -- SUBRTN to pad N number of spaces

 Q $$PAD(" ",N)

BDGCEN32  ; IHS/ANMC/LJF - CENSUS WARD LIST-SUMMARY ; 

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

 +2       ;

 +3       ;

 +4        NEW LINE,DGWN,DGWD,UNDER

 +5       ;underline of 6 spaces

           SET UNDER=$$REPEAT^XLFSTR("_",6)

 +6       ;

 +7        SET LINE="<<< SUMMARY PAGE >>>"

 +8        DO SET($$SP(75-$LENGTH(LINE)\2)_$GET(IORVON)_LINE_$GET(IORVOFF),.VALMCNT)

 +9        SET LINE=$$PAD("Ward",16)_"Beg Census  Admits  Net Transfers  Discharges  Ending Census"

 +10       DO SET($$REPEAT^XLFSTR("=",80),.VALMCNT)

 +11       DO SET(LINE,.VALMCNT)

 +12       DO SET($$REPEAT^XLFSTR("-",80),.VALMCNT)

 +13      ;

 +14      ; loop through active wards by name

 +15       SET DGWN=0

 +16       FOR 

               SET DGWN=$ORDER(^DIC(42,"B",DGWN))

               IF DGWN=""

                   QUIT 

               Begin DoDot:1

 +17               SET DGWD=0

                   FOR 

                       SET DGWD=$ORDER(^DIC(42,"B",DGWN,DGWD))

                       IF 'DGWD

                           QUIT 

                       Begin DoDot:2

 +18      ;deleted ward

                           IF '$DATA(^BDGWD(DGWD))

                               QUIT 

 +19      ;inactive

                           IF $$GET1^DIQ(9009016.5,DGWD,.03)="INACTIVE"

                               QUIT 

 +20      ;

 +21      ; for each ward, list changes

 +22                       SET LINE=$$PAD(DGWN,16)_UNDER_"  +"

 +23      ;admits

                           SET LINE=$$PAD(LINE,30)_(+$GET(BDGSUB(DGWN,"A")))

 +24      ;net transfers

                           SET LINE=$$PAD(LINE,42)_(+$GET(BDGSUB(DGWN,"T")))

 +25      ;dsch

                           SET LINE=$$PAD($$PAD(LINE,49)_"-",55)_(+$GET(BDGSUB(DGWN,"D")))

 +26                       SET LINE=$$PAD(LINE,65)_UNDER

 +27                       DO SET(LINE,.VALMCNT)

                           DO SET("",.VALMCNT)

 +28      ;

 +29      ; increment totals for whole facility

 +30                       SET BDGTOT("A")=$GET(BDGTOT("A"))+$GET(BDGSUB(DGWN,"A"))

 +31                       SET BDGTOT("T")=$GET(BDGTOT("T"))+$GET(BDGSUB(DGWN,"T"))

 +32                       SET BDGTOT("D")=$GET(BDGTOT("D"))+$GET(BDGSUB(DGWN,"D"))

                       End DoDot:2

               End DoDot:1

 +33      ;

 +34       DO SET($$REPEAT^XLFSTR("=",80),.VALMCNT)

 +35       SET LINE=$$PAD("TOTALS:",16)_UNDER_"  +"

 +36       SET LINE=$$PAD(LINE,30)_(+$GET(BDGTOT("A")))

 +37       SET LINE=$$PAD(LINE,42)_(+$GET(BDGTOT("T")))

 +38       SET LINE=$$PAD($$PAD(LINE,49)_"-",55)_(+$GET(BDGTOT("D")))

 +39       SET LINE=$$PAD(LINE,63)_"= "_UNDER

 +40       DO SET(LINE,.VALMCNT)

 +41      ;

 +42       SET LINE=$$PAD("NEWBORNS:",16)_UNDER_"  +"

 +43       SET LINE=$$PAD(LINE,30)_(+$GET(BDGNB("A")))

 +44       SET LINE=$$PAD(LINE,42)_(+$GET(BDGNB("T")))

 +45       SET LINE=$$PAD($$PAD(LINE,49)_"-",55)_(+$GET(BDGNB("D")))

 +46       SET LINE=$$PAD(LINE,63)_"+ "_UNDER

 +47       DO SET(LINE,.VALMCNT)

 +48      ;

 +49       KILL BDGTOT,BDGSUB,BDGNB

 +50       QUIT 

 +51      ;

SET(DATA,NUM) ; put display data into array

 +1        SET NUM=NUM+1

 +2        SET ^TMP("BDGCEN3",$JOB,NUM,0)=DATA

 +3        QUIT 

 +4       ;

PAD(D,L)  ;EP -- SUBRTN to pad length of data

 +1       ; -- D=data L=length

 +2        QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)

 +3       ;

SP(N)     ; -- SUBRTN to pad N number of spaces

 +1        QUIT $$PAD(" ",N)