BDGCEN31 ; IHS/ANMC/LJF - BED MOVEMENT LISTING CONT. ; [ 06/20/2002 12:59 PM ]
;;5.3;PIMS;;APR 26, 2002
;
;
LOOP ; initialize subtotals for wards
NEW WARD,I,WARD,CHANGE,CHANGENB,BDGI,SUB,HEADING
;
; set ward array
S WARD=0 F S WARD=$O(^DIC(42,WARD)) Q:'WARD D
. Q:'$D(^BDGWD(WARD))
. Q:$$GET1^DIQ(9009016.5,WARD,.02)="INACTIVE"
. F I="A","T","D" S BDGSUB($$GET1^DIQ(42,WARD,.01),I)=0
;
; newborn subtotals
F I="A","T","D" S BDGNB(I)=0
;
; -- loop thru wards and patients found
S WARD=0
F S WARD=$O(^TMP("BDGCEN31",$J,WARD)) Q:WARD="" D
. S (CHANGE,CHANGENB)=0 ;initialize ward change totals
. ;
. D SET($$SP(72-$L(WARD)/2)_"*** "_WARD_" ***",.VALMCNT) ;ward name
. ;
. ; loop thru 10 movement categories and display
. F BDGI=1:1:10 D
.. S SUB=$P($T(SUB+BDGI),";;",2),HEADING=$P($T(SUB+BDGI),";;",3)
.. Q:'$D(^TMP("BDGCEN31",$J,WARD,SUB)) ;no data for mvmnt type
.. D FIND
.. ;
. ; now display ward change totals
. D SET("",.VALMCNT)
. D SET($$SP(45)_"CENSUS CHANGE FOR WARD: "_$J(CHANGE,3),.VALMCNT)
. D SET("",.VALMCNT)
. D SET($$SP(37)_"NEWBORN CENSUS CHANGE FOR WARD: "_$J(CHANGENB,3),.VALMCNT)
. D SET("",.VALMCNT)
Q
;
;
FIND ; within ward loop by patient and display data
NEW COUNT,DATE,NAME,DFN,LINE
D SET("",.VALMCNT)
D SET($$SP(80-$L(HEADING)/2)_HEADING,.VALMCNT)
;
S (DATE,COUNT)=0
F S DATE=$O(^TMP("BDGCEN31",$J,WARD,SUB,DATE)) Q:'DATE D
. S NAME=0
. F S NAME=$O(^TMP("BDGCEN31",$J,WARD,SUB,DATE,NAME)) Q:NAME="" D
.. S DFN=0
.. F S DFN=$O(^TMP("BDGCEN31",$J,WARD,SUB,DATE,NAME,DFN)) Q:'DFN D
... ;
... ; display patient data
... S LINE=$$PAD($P($$FMTE^XLFDT(DATE),":",1,2),22)
... S LINE=$$PAD(LINE_NAME,55)_$J($$HRCN^BDGF2(DFN,DUZ(2)),6)
... D SET(LINE,.VALMCNT)
... ;
... ; increment counts within type of movement
... S COUNT=$G(COUNT)+1
;
; increment counts for type of movement
I BDGI=1 S BDGSUB(WARD,"A")=COUNT,CHANGE=CHANGE+COUNT
I BDGI=2 S BDGSUB(WARD,"T")=BDGSUB(WARD,"T")+COUNT,CHANGE=CHANGE+COUNT
I BDGI=3 S BDGSUB(WARD,"T")=BDGSUB(WARD,"T")-COUNT,CHANGE=CHANGE-COUNT
; discharges and deaths
I (BDGI=4)!(BDGI=5) S BDGSUB(WARD,"D")=BDGSUB(WARD,"D")+COUNT,CHANGE=CHANGE-COUNT
;
; now newborn counts
I BDGI=6 S BDGNB("A")=BDGNB("A")+COUNT,CHANGENB=CHANGENB+COUNT
I BDGI=7 S BDGNB("T")=BDGNB("T")+COUNT,CHANGENB=CHANGENB+COUNT
I BDGI=8 S BDGNB("T")=BDGNB("T")-COUNT,CHANGENB=CHANGENB-COUNT
;6/20/2002 LJF10 (per Linda) changed the plus sign to minus sign
;I (BDGI=9)!(BDGI=10) S BDGNB("D")=BDGNB("D")+COUNT,CHANGENB=CHANGENB+COUNT
I (BDGI=9)!(BDGI=10) S BDGNB("D")=BDGNB("D")+COUNT,CHANGENB=CHANGENB-COUNT ;IHS/ANMC/LJF 6/19/2002
;
; display subtotal for category within ward
D SET($$SP(60)_"SUBTOTAL: "_$J(COUNT,3),.VALMCNT)
;
Q
;
;
SET(LINE,NUM) ; put display line into array
S NUM=NUM+1
S ^TMP("BDGCEN3",$J,NUM,0)=LINE
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)
SUB ;;
;;AMV1;;ADMISSIONS;;1;;
;;TI;;WARD TRANSFERS IN;;1;;
;;AMV2;;WARD TRANSFERS OUT;;-1;;
;;AMV3;;DISCHARGES;;-1;;
;;DT;;DEATHS;;-1;;
;;NBAMV1;;NEWBORN ADMISSIONS;;1;;
;;NBTI;;NEWBORN TRANSFERS IN;;1;;
;;NBAMV2;;NEWBORN TRANSFERS OUT;;-1;;
;;NBAMV3;;NEWBORN DISCHARGES;;-1;;
;;NBDT;;NEWBORN DEATHS;;-1;;
BDGCEN31 ; IHS/ANMC/LJF - BED MOVEMENT LISTING CONT. ; [ 06/20/2002 12:59 PM ]
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ;
+3 ;
LOOP ; initialize subtotals for wards
+1 NEW WARD,I,WARD,CHANGE,CHANGENB,BDGI,SUB,HEADING
+2 ;
+3 ; set ward array
+4 SET WARD=0
FOR
SET WARD=$ORDER(^DIC(42,WARD))
IF 'WARD
QUIT
Begin DoDot:1
+5 IF '$DATA(^BDGWD(WARD))
QUIT
+6 IF $$GET1^DIQ(9009016.5,WARD,.02)="INACTIVE"
QUIT
+7 FOR I="A","T","D"
SET BDGSUB($$GET1^DIQ(42,WARD,.01),I)=0
End DoDot:1
+8 ;
+9 ; newborn subtotals
+10 FOR I="A","T","D"
SET BDGNB(I)=0
+11 ;
+12 ; -- loop thru wards and patients found
+13 SET WARD=0
+14 FOR
SET WARD=$ORDER(^TMP("BDGCEN31",$JOB,WARD))
IF WARD=""
QUIT
Begin DoDot:1
+15 ;initialize ward change totals
SET (CHANGE,CHANGENB)=0
+16 ;
+17 ;ward name
DO SET($$SP(72-$LENGTH(WARD)/2)_"*** "_WARD_" ***",.VALMCNT)
+18 ;
+19 ; loop thru 10 movement categories and display
+20 FOR BDGI=1:1:10
Begin DoDot:2
+21 SET SUB=$PIECE($TEXT(SUB+BDGI),";;",2)
SET HEADING=$PIECE($TEXT(SUB+BDGI),";;",3)
+22 ;no data for mvmnt type
IF '$DATA(^TMP("BDGCEN31",$JOB,WARD,SUB))
QUIT
+23 DO FIND
+24 ;
End DoDot:2
+25 ; now display ward change totals
+26 DO SET("",.VALMCNT)
+27 DO SET($$SP(45)_"CENSUS CHANGE FOR WARD: "_$JUSTIFY(CHANGE,3),.VALMCNT)
+28 DO SET("",.VALMCNT)
+29 DO SET($$SP(37)_"NEWBORN CENSUS CHANGE FOR WARD: "_$JUSTIFY(CHANGENB,3),.VALMCNT)
+30 DO SET("",.VALMCNT)
End DoDot:1
+31 QUIT
+32 ;
+33 ;
FIND ; within ward loop by patient and display data
+1 NEW COUNT,DATE,NAME,DFN,LINE
+2 DO SET("",.VALMCNT)
+3 DO SET($$SP(80-$LENGTH(HEADING)/2)_HEADING,.VALMCNT)
+4 ;
+5 SET (DATE,COUNT)=0
+6 FOR
SET DATE=$ORDER(^TMP("BDGCEN31",$JOB,WARD,SUB,DATE))
IF 'DATE
QUIT
Begin DoDot:1
+7 SET NAME=0
+8 FOR
SET NAME=$ORDER(^TMP("BDGCEN31",$JOB,WARD,SUB,DATE,NAME))
IF NAME=""
QUIT
Begin DoDot:2
+9 SET DFN=0
+10 FOR
SET DFN=$ORDER(^TMP("BDGCEN31",$JOB,WARD,SUB,DATE,NAME,DFN))
IF 'DFN
QUIT
Begin DoDot:3
+11 ;
+12 ; display patient data
+13 SET LINE=$$PAD($PIECE($$FMTE^XLFDT(DATE),":",1,2),22)
+14 SET LINE=$$PAD(LINE_NAME,55)_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+15 DO SET(LINE,.VALMCNT)
+16 ;
+17 ; increment counts within type of movement
+18 SET COUNT=$GET(COUNT)+1
End DoDot:3
End DoDot:2
End DoDot:1
+19 ;
+20 ; increment counts for type of movement
+21 IF BDGI=1
SET BDGSUB(WARD,"A")=COUNT
SET CHANGE=CHANGE+COUNT
+22 IF BDGI=2
SET BDGSUB(WARD,"T")=BDGSUB(WARD,"T")+COUNT
SET CHANGE=CHANGE+COUNT
+23 IF BDGI=3
SET BDGSUB(WARD,"T")=BDGSUB(WARD,"T")-COUNT
SET CHANGE=CHANGE-COUNT
+24 ; discharges and deaths
+25 IF (BDGI=4)!(BDGI=5)
SET BDGSUB(WARD,"D")=BDGSUB(WARD,"D")+COUNT
SET CHANGE=CHANGE-COUNT
+26 ;
+27 ; now newborn counts
+28 IF BDGI=6
SET BDGNB("A")=BDGNB("A")+COUNT
SET CHANGENB=CHANGENB+COUNT
+29 IF BDGI=7
SET BDGNB("T")=BDGNB("T")+COUNT
SET CHANGENB=CHANGENB+COUNT
+30 IF BDGI=8
SET BDGNB("T")=BDGNB("T")-COUNT
SET CHANGENB=CHANGENB-COUNT
+31 ;6/20/2002 LJF10 (per Linda) changed the plus sign to minus sign
+32 ;I (BDGI=9)!(BDGI=10) S BDGNB("D")=BDGNB("D")+COUNT,CHANGENB=CHANGENB+COUNT
+33 ;IHS/ANMC/LJF 6/19/2002
IF (BDGI=9)!(BDGI=10)
SET BDGNB("D")=BDGNB("D")+COUNT
SET CHANGENB=CHANGENB-COUNT
+34 ;
+35 ; display subtotal for category within ward
+36 DO SET($$SP(60)_"SUBTOTAL: "_$JUSTIFY(COUNT,3),.VALMCNT)
+37 ;
+38 QUIT
+39 ;
+40 ;
SET(LINE,NUM) ; put display line into array
+1 SET NUM=NUM+1
+2 SET ^TMP("BDGCEN3",$JOB,NUM,0)=LINE
+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)
SUB ;;
+1 ;;AMV1;;ADMISSIONS;;1;;
+2 ;;TI;;WARD TRANSFERS IN;;1;;
+3 ;;AMV2;;WARD TRANSFERS OUT;;-1;;
+4 ;;AMV3;;DISCHARGES;;-1;;
+5 ;;DT;;DEATHS;;-1;;
+6 ;;NBAMV1;;NEWBORN ADMISSIONS;;1;;
+7 ;;NBTI;;NEWBORN TRANSFERS IN;;1;;
+8 ;;NBAMV2;;NEWBORN TRANSFERS OUT;;-1;;
+9 ;;NBAMV3;;NEWBORN DISCHARGES;;-1;;
+10 ;;NBDT;;NEWBORN DEATHS;;-1;;
