BDGCEN3 ; IHS/ANMC/LJF - CENSUS AID-PATIENT LISTS ;
;;5.3;PIMS;;APR 26, 2002
;
NEW Y,X,BDGWD,BDGBD,BDGED
S Y=$$READ^BDGF("Y","Print for ALL Wards","NO") Q:Y=U
I Y=1 S BDGWD="A" ;all wards
E D Q:BDGWD<1 ;just one
. S X="I +$P($G(^BDGWD(+Y,0)),U,3)'=""I"""
. S BDGWD=+$$READ^BDGF("PO^42:EQMZ","Select Ward","","",X)
;
S BDGBD=$$READ^BDGF("DO^:"_$$NOW^XLFDT_":EPR","Select beginning date and time") Q:BDGBD<1
S BDGED=$$READ^BDGF("DO^"_BDGBD_":"_$$NOW^XLFDT_":EPR","Select ending date and time") Q:BDGED<1
;
I $$BROWSE^BDGF="B" D EN Q
D ZIS^BDGF("QP","EN^BDGCEN3","CENSUS AID4","BDGWD;BDGBD;BDGED")
D HOME^%ZIS
Q
;
;
EN ;EP; -- main entry point for BDG CENSUS AID4
NEW VALMCNT,BDGPRT
I $E(IOST,1,2)="P-" S BDGPRT=1 D INIT,PRINT Q
D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BDG CENSUS AID4")
D CLEAR^VALM1
Q
;
HDR ; -- header code
NEW X
S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
S X=$$FMTE^XLFDT(BDGBD)_" to "_$$FMTE^XLFDT(BDGED)
S VALMHDR(2)=$$SP(75-$L(X)\2)_X
S X=$S(BDGWD="A":"For All Wards",1:"For "_$$GET1^DIQ(42,BDGWD,.01))
S VALMHDR(3)=$$SP(79-$L(X)\2)_X
Q
;
INIT ; -- init variables and list array
I '$G(BDGPRT) D MSG^BDGF("Compiling list; please wait...",2,0)
K ^TMP("BDGCEN3",$J),^TMP("BDGCEN31",$J)
S VALMCNT=0
D ^BDGCEN30,^BDGCEN31 ;compile data and put into display array
I BDGWD="A" D ^BDGCEN32 ;summary page
;
I '$D(^TMP("BDGCEN3",$J)) D SET^BDGCEN31("No data found",.VALMCNT)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BDGCEN3",$J) K BDGWD,BDGED,BDGBD,BDGSUB,BDGNB
Q
;
EXPND ; -- expand code
Q
;
PRINT ; print report to paper
NEW BDGLN,BDGPG,BDGSUM
U IO D INIT^BDGF
;
S BDGLN=0 F S BDGLN=$O(^TMP("BDGCEN3",$J,BDGLN)) Q:'BDGLN D
. I ^TMP("BDGCEN3",$J,BDGLN,0)["<< SUMMARY PAGE >>" S BDGSUM=1 D HDG Q
. I ^TMP("BDGCEN3",$J,BDGLN,0)["***" D HDG
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BDGCEN3",$J,BDGLN,0)
;
D ^%ZISC,PRTKL^BDGF,EXIT
Q
;
HDG ; heading when printing to paper
S BDGPG=$G(BDGPG)+1 I BDGPG>1 W @IOF
W !,BDGUSR,?13,"***",$$CONF^BDGF,"***"
W !,BDGDATE,?30,"Ward Census Listing",?71,"Page: ",BDGPG
NEW X S X="For "_$$FMTE^XLFDT(BDGBD)_" through "_$$FMTE^XLFDT(BDGED)
W !,BDGTIME,?(80-$L(X)\2),X
;
; column heading all pages except summary page
I '$G(BDGSUM) D
. W !,$$REPEAT^XLFSTR("-",80)
. W !?3," Time",?22,"Patient Name",?55,"Chart #"
. W !,$$REPEAT^XLFSTR("=",80)
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)
;
BDGCEN3 ; IHS/ANMC/LJF - CENSUS AID-PATIENT LISTS ;
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ;
+3 NEW Y,X,BDGWD,BDGBD,BDGED
+4 SET Y=$$READ^BDGF("Y","Print for ALL Wards","NO")
IF Y=U
QUIT
+5 ;all wards
IF Y=1
SET BDGWD="A"
+6 ;just one
IF '$TEST
Begin DoDot:1
+7 SET X="I +$P($G(^BDGWD(+Y,0)),U,3)'=""I"""
+8 SET BDGWD=+$$READ^BDGF("PO^42:EQMZ","Select Ward","","",X)
End DoDot:1
IF BDGWD<1
QUIT
+9 ;
+10 SET BDGBD=$$READ^BDGF("DO^:"_$$NOW^XLFDT_":EPR","Select beginning date and time")
IF BDGBD<1
QUIT
+11 SET BDGED=$$READ^BDGF("DO^"_BDGBD_":"_$$NOW^XLFDT_":EPR","Select ending date and time")
IF BDGED<1
QUIT
+12 ;
+13 IF $$BROWSE^BDGF="B"
DO EN
QUIT
+14 DO ZIS^BDGF("QP","EN^BDGCEN3","CENSUS AID4","BDGWD;BDGBD;BDGED")
+15 DO HOME^%ZIS
+16 QUIT
+17 ;
+18 ;
EN ;EP; -- main entry point for BDG CENSUS AID4
+1 NEW VALMCNT,BDGPRT
+2 IF $EXTRACT(IOST,1,2)="P-"
SET BDGPRT=1
DO INIT
DO PRINT
QUIT
+3 DO TERM^VALM0
DO CLEAR^VALM1
+4 DO EN^VALM("BDG CENSUS AID4")
+5 DO CLEAR^VALM1
+6 QUIT
+7 ;
HDR ; -- header code
+1 NEW X
+2 SET VALMHDR(1)=$$SP(15)_$$CONF^BDGF
+3 SET X=$$FMTE^XLFDT(BDGBD)_" to "_$$FMTE^XLFDT(BDGED)
+4 SET VALMHDR(2)=$$SP(75-$LENGTH(X)\2)_X
+5 SET X=$SELECT(BDGWD="A":"For All Wards",1:"For "_$$GET1^DIQ(42,BDGWD,.01))
+6 SET VALMHDR(3)=$$SP(79-$LENGTH(X)\2)_X
+7 QUIT
+8 ;
INIT ; -- init variables and list array
+1 IF '$GET(BDGPRT)
DO MSG^BDGF("Compiling list; please wait...",2,0)
+2 KILL ^TMP("BDGCEN3",$JOB),^TMP("BDGCEN31",$JOB)
+3 SET VALMCNT=0
+4 ;compile data and put into display array
DO ^BDGCEN30
DO ^BDGCEN31
+5 ;summary page
IF BDGWD="A"
DO ^BDGCEN32
+6 ;
+7 IF '$DATA(^TMP("BDGCEN3",$JOB))
DO SET^BDGCEN31("No data found",.VALMCNT)
+8 QUIT
+9 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BDGCEN3",$JOB)
KILL BDGWD,BDGED,BDGBD,BDGSUB,BDGNB
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
PRINT ; print report to paper
+1 NEW BDGLN,BDGPG,BDGSUM
+2 USE IO
DO INIT^BDGF
+3 ;
+4 SET BDGLN=0
FOR
SET BDGLN=$ORDER(^TMP("BDGCEN3",$JOB,BDGLN))
IF 'BDGLN
QUIT
Begin DoDot:1
+5 IF ^TMP("BDGCEN3",$JOB,BDGLN,0)["<< SUMMARY PAGE >>"
SET BDGSUM=1
DO HDG
QUIT
+6 IF ^TMP("BDGCEN3",$JOB,BDGLN,0)["***"
DO HDG
+7 IF $Y>(IOSL-4)
DO HDG
+8 WRITE !,^TMP("BDGCEN3",$JOB,BDGLN,0)
End DoDot:1
+9 ;
+10 DO ^%ZISC
DO PRTKL^BDGF
DO EXIT
+11 QUIT
+12 ;
HDG ; heading when printing to paper
+1 SET BDGPG=$GET(BDGPG)+1
IF BDGPG>1
WRITE @IOF
+2 WRITE !,BDGUSR,?13,"***",$$CONF^BDGF,"***"
+3 WRITE !,BDGDATE,?30,"Ward Census Listing",?71,"Page: ",BDGPG
+4 NEW X
SET X="For "_$$FMTE^XLFDT(BDGBD)_" through "_$$FMTE^XLFDT(BDGED)
+5 WRITE !,BDGTIME,?(80-$LENGTH(X)\2),X
+6 ;
+7 ; column heading all pages except summary page
+8 IF '$GET(BDGSUM)
Begin DoDot:1
+9 WRITE !,$$REPEAT^XLFSTR("-",80)
+10 WRITE !?3," Time",?22,"Patient Name",?55,"Chart #"
+11 WRITE !,$$REPEAT^XLFSTR("=",80)
End DoDot:1
+12 QUIT
+13 ;
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)
+2 ;
