- 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)
