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