BWUTL7 ;IHS/ANMC/MWR - UTIL: HEADERS & TRAILERS;23-Jan-2009 10:35;DU
;;2.0;WOMEN'S HEALTH;**5,6,8,11**;MAY 16, 1996
;IHS/CMI/LAB - spacing 4 digit years
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; UTILITY: HEADERS AND TRAILERS.
;
S(S) ;EP
;---> RETURN A VALUE OF SPACES EQUAL IN LENGTH TO THE NUMBER S.
N I,SP S SP="" F I=1:1:8 S SP=SP_" "
Q $E(SP,1,$G(S))
;
TOPHEAD ;EP
;---> CODE TO SET VARIABLES FOR HEADER.
N X
D NOW^%DTC S BWNOW=$$SLDT1^BWUTL5(%)
S BWLINE="" F I=1:1:8 S BWLINE=BWLINE_"----------"
S BWPAGE=1
S BWCRT=$S($E(IOST)="C":1,1:0)
S BWCONFF="*********************** CONFIDENTIAL PATIENT INFORMATION "
S BWCONFF=BWCONFF_"***********************"
S BWTIMLN=$E(BWLINE,1,26)_" printed: "_BWNOW_" "_$E(BWLINE,1,27)
Q
;
;
;---> BROWSE/REPORT HEADER: MULTIPLE PATIENTS, MULTIPLE PROCEDURES.
;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
;---> OPTIONAL VARIABLE: BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
N X
W:BWPAGE>1!BWCRT @IOF,!
W:$D(BWCONF) BWCONFF,! W:'BWCRT BWTIMLN,!
W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
W !!,"Case Mgr: " D
.I '$D(BWE) W "ALL" Q
.I BWE W "ALL" Q
.I '$D(BWCMGR) W "UNKNOWN" Q
.I BWCMGR="" W "UNKNOWN" Q
.I '$D(^VA(200,BWCMGR,0)) W "UNKNOWN" Q
.W $P(^VA(200,BWCMGR,0),U)
W ?56,"For period: ",$$TXDT^BWUTL5(BWBEGDT)
W !,"Facility: ",$$INSTTX^BWUTL6(DUZ(2))
W ?64,"To: ",$$TXDT^BWUTL5(BWENDDT)
W ! F I=1:1:80 W "="
I $D(BWSUBH) D @BWSUBH
Q
;
;
;---> PATIENT REPORT HEADER: ONE PATIENT, MULTIPLE PROCEDURES.
;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
;---> OPTIONAL VARIABLE: BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
N X
W:BWPAGE>1!BWCRT @IOF,!
W:$D(BWCONF) BWCONFF,! W:'BWCRT BWTIMLN,!
W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
;IHS/CMI/THL PATCH 8
W !!,"Patient Name: ",BWNAMAGE,?55,$$PNLAB^BWUTL5(DUZ(2)),BWCHRT
W !,"DOB : ",$$FMTE^XLFDT($$GET1^DIQ(2,BWDFN,.03,"I")),?58,"PCP: ",$E($$GET1^DIQ(9002086,BWDFN,.25),1,16) ; IHS/MSC/BWF - Patch 10
W !,"Case Manager: ",BWCMGR
W ?53,"Facility: ",$E($$INSTTX^BWUTL6(DUZ(2)),1,17)
W !,"Cx Tx Need : ",BWCNEED
W ?51,"Inact Date: ",$$SLDT2^BWUTL5($$INACT^BWUTL1(BWDFN))
;W ?52,"Period:" ;---> XDATES
;W ?60,$$SLDT2^BWUTL5(BWBEGDT)," to " ;---> XDATES
;W $$SLDT2^BWUTL5(BWENDDT) ;---> XDATES
W !,"PAP Regimen : ",BWPAPRG
W ?50,"Income Elig: "
N X
S X=$P(^BWP(BWDFN,0),U,29)
W $S(X=1:"YES",X=2:"NO",X=3:"REFUSED",1:"NOT DETERMINED")
W !,"Br Tx Need : ",BWBNEED
W ?50,"Income Date: "
N X
S X=$P(^BWP(BWDFN,0),U,30)
W $$SLDT2^BWUTL5(X)
;W !," PCP : "_$$GET1^DIQ(9002086,BWDFN,.25) ;IHS/CIA/PLS - Patch 11
;IHS/CMI/THL END PATCH 8
W ! F I=1:1:49 W "="
;begin Y2K
W $S(BWEDC]"":BWEDC_"====",1:"===============================") ;IHS/CMI/LAB - format 4 digit year Y2000
;end Y2K
I $D(BWSUBH) D @BWSUBH
Q
;
;
;---> LAB LOG REPORT HEADER: MULTIPLE PATIENTS, MULTIPLE PROCEDURES.
;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
;---> OPTIONAL VARIABLE: BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
N X
W:BWPAGE>1!BWCRT @IOF,!
W:$D(BWCONF) BWCONFF,! W:'BWCRT BWTIMLN,!
W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
W !!,"Facility: ",$$INSTTX^BWUTL6($S($G(BWFAC):BWFAC,1:DUZ(2)))
;begin Y2K
W ?49,"From: ",$$SLDT2^BWUTL5(BWBEGDT) ;IHS/CMI/LAB 53 to 49 Y2000
;end Y2K
W " to ",$$SLDT2^BWUTL5(BWENDDT)
W ! F I=1:1:80 W "="
I $D(BWSUBH) D @BWSUBH
Q
;
;
;---> PATIENT REPORT HEADER: ONE PATIENT, ONE PROCEDURE.
;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE1,DUZ(2)
;---> OPTIONAL VARIABLE: BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
W:BWPAGE>1!BWCRT @IOF,!
W BWCONFF W:'BWCRT !,BWTIMLN
W !!,BWTITLE1,?70,"page: ",BWPAGE S BWPAGE=BWPAGE+1
;---> CALLED BY BWPROC; BYPASSES FORMFEED, TITLE, ETC.
W !!,"Patient Name: ",BWNAMAGE,?53,$$PNLAB^BWUTL5(DUZ(2)),BWCHRT
W !,"Case Manager: ",BWCMGR
W ?50,"Procedure: ",$E(BWPN,1,19)
W !,"Cx Tx Need : ",BWCNEED
W ?55,"Acc#: ",BWACCN
W !,"PAP Regimen : ",BWPAPRG
W !,"Br Tx Need : ",BWBNEED
W ?61,$S($$DES^BWUTL1(BWDFN):"*DES DAUGHTER*",1:"")
W ! F I=1:1:49 W "-"
W $S(BWEDC]"":BWEDC_"------",1:"-------------------------------")
Q
;
;
;---> DELINQUENT NEEDS REPORT HEADER: MULTIPLE PATIENTS
;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
;---> OPTIONAL VARIABLE: BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
N X
W:BWPAGE>1!BWCRT @IOF,!
W:$D(BWCONF) BWCONFF,! W:'BWCRT BWTIMLN,!
W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
W !!,"Case Mgr: " D
.I '$D(BWE) W "ALL" Q
.I BWE W "ALL" Q
.I $G(BWCMGR)']"" W "UNKNOWN" Q
.I '$D(^VA(200,BWCMGR,0)) W "UNKNOWN" Q
.W $P(^VA(200,BWCMGR,0),U)
W ?46,"Communit" D
.I $D(BWCC("ALL")) W "ies: ALL" Q
.N I,N S N=0 F I=0:1 S N=$O(BWCC(N)) Q:'N
.I I=1 W "y: ",$E($P(^AUTTCOM($O(BWCC(N)),0),U),1,22) Q
.W "ies: ",$E($P(^AUTTCOM($O(BWCC(N)),0),U),1,18),",..." Q
W !,"Facility: ",$$INSTTX^BWUTL6(BWFAC)
W ?46,"Tx Needs Past Due as of ",$$SLDT2^BWUTL5(BWDDATE)
W ! F I=1:1:80 W "="
I $D(BWSUBH) D @BWSUBH
Q
;
;
;---> PROGRAM SNAPSHOT HEADER: JUST TITLE AND FACILITY (NO PATIENTS)
;---> REQUIRED VARIABLES: BWCRT,BWTITLE,DUZ(2)
N X
W:BWPAGE>1!BWCRT @IOF,!
W:'BWCRT !,BWTIMLN,!
W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
W !!," Note: This report includes all facilities"
W " using this database."
;W " Facility: ",$$INSTTX^BWUTL6(DUZ(2))
;W " (This report is not site specific.)"
W ! F I=1:1:80 W "="
Q
;
;
;---> AUTOLOAD OF PATIENTS HEADER
;---> REQUIRED VARIABLES: BWCRT,BWTITLE,DUZ(2)
N X
W:BWPAGE>1!BWCRT @IOF,!
W:$D(BWCONF) BWCONFF,! W:'BWCRT BWTIMLN,!
W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE S BWPAGE=BWPAGE+1
W !!,"Facility: ",$$INSTTX^BWUTL6(DUZ(2))
W ?64,"Cutoff Age: ",BWAGE
W ! F I=1:1:80 W "="
W !,?3,"NAME",?30,$$PNLB^BWUTL5(DUZ(2)),?45,"DOB",?60,"STATUS"
W !,BWLINE
Q
;
;
;---> SCREENING RATES REPORT HEADER: (NO PATIENTS)
;---> REQUIRED VARIABLES: BWCRT,BWTITLE,DUZ(2)
N X
W:BWPAGE>1!BWCRT @IOF,!
W:'BWCRT !,BWTIMLN,!
W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
W !!?4,"For Age Range: ",$S(BWAGRG=1:"ALL",1:BWAGRG)
W ?56,"For period: ",$$SLDT2^BWUTL5(BWBEGDT)
W !?4,"Communit" D
.I $D(BWCC("ALL")) W "ies: ALL" Q
.N I,N S N="",I=0 F S N=$O(BWCC(N)) Q:N="" S I=I+1
.I I=1 W "y: ",$E($O(BWCC("")),1,22) Q
.W "ies: ",$E($O(BWCC("")),1,18),",..." Q
W ?64,"To: ",$$SLDT2^BWUTL5(BWENDDT)
W ! F I=1:1:80 W "="
W !?4,"(Note: This report includes all facilities"
W " using this database.)",!
;I $D(BWSUBH) D @BWSUBH
Q
;
ENDREP(X) ;EP
;---> END A REPORT, DO FORMFEED OR "Press <Return>" IF NECESSARY.
;---> REQUIRED VARIABLES: BWCRT=1 IF OUTPUT TO SCREEN
;---> BWPOP=1 IF ESCAPING
;---> OPTIONAL VARIABLE: X=1 IF "End of Report" SHOULD NOT DISPLAY.
;
S BWTITLE="----- End of Report -----"
I '$G(X)&('BWPOP) D CENTERT^BWUTL5(.BWTITLE) W !,BWTITLE
W:'BWCRT @IOF,!
I BWCRT&('$D(IO("S")))&('BWPOP) D DIRZ^BWUTL3 W @IOF,!
D ^%ZISC
Q
BWUTL7 ;IHS/ANMC/MWR - UTIL: HEADERS & TRAILERS;23-Jan-2009 10:35;DU
+1 ;;2.0;WOMEN'S HEALTH;**5,6,8,11**;MAY 16, 1996
+2 ;IHS/CMI/LAB - spacing 4 digit years
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; UTILITY: HEADERS AND TRAILERS.
+5 ;
S(S) ;EP
+1 ;---> RETURN A VALUE OF SPACES EQUAL IN LENGTH TO THE NUMBER S.
+2 NEW I,SP
SET SP=""
FOR I=1:1:8
SET SP=SP_" "
+3 QUIT $EXTRACT(SP,1,$GET(S))
+4 ;
TOPHEAD ;EP
+1 ;---> CODE TO SET VARIABLES FOR HEADER.
+2 NEW X
+3 DO NOW^%DTC
SET BWNOW=$$SLDT1^BWUTL5(%)
+4 SET BWLINE=""
FOR I=1:1:8
SET BWLINE=BWLINE_"----------"
+5 SET BWPAGE=1
+6 SET BWCRT=$SELECT($EXTRACT(IOST)="C":1,1:0)
+7 SET BWCONFF="*********************** CONFIDENTIAL PATIENT INFORMATION "
+8 SET BWCONFF=BWCONFF_"***********************"
+9 SET BWTIMLN=$EXTRACT(BWLINE,1,26)_" printed: "_BWNOW_" "_$EXTRACT(BWLINE,1,27)
+10 QUIT
+11 ;
+12 ;
+1 ;---> BROWSE/REPORT HEADER: MULTIPLE PATIENTS, MULTIPLE PROCEDURES.
+2 ;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
+3 ;---> OPTIONAL VARIABLE: BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
+4 NEW X
+5 IF BWPAGE>1!BWCRT
WRITE @IOF,!
+6 IF $DATA(BWCONF)
WRITE BWCONFF,!
IF 'BWCRT
WRITE BWTIMLN,!
+7 WRITE !,BWTITLE
IF 'BWCRT
WRITE ?70,"page: ",BWPAGE
+8 WRITE !!,"Case Mgr: "
Begin DoDot:1
+9 IF '$DATA(BWE)
WRITE "ALL"
QUIT
+10 IF BWE
WRITE "ALL"
QUIT
+11 IF '$DATA(BWCMGR)
WRITE "UNKNOWN"
QUIT
+12 IF BWCMGR=""
WRITE "UNKNOWN"
QUIT
+13 IF '$DATA(^VA(200,BWCMGR,0))
WRITE "UNKNOWN"
QUIT
+14 WRITE $PIECE(^VA(200,BWCMGR,0),U)
End DoDot:1
+15 WRITE ?56,"For period: ",$$TXDT^BWUTL5(BWBEGDT)
+16 WRITE !,"Facility: ",$$INSTTX^BWUTL6(DUZ(2))
+17 WRITE ?64,"To: ",$$TXDT^BWUTL5(BWENDDT)
+18 WRITE !
FOR I=1:1:80
WRITE "="
+19 IF $DATA(BWSUBH)
DO @BWSUBH
+20 QUIT
+21 ;
+22 ;
+1 ;---> PATIENT REPORT HEADER: ONE PATIENT, MULTIPLE PROCEDURES.
+2 ;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
+3 ;---> OPTIONAL VARIABLE: BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
+4 NEW X
+5 IF BWPAGE>1!BWCRT
WRITE @IOF,!
+6 IF $DATA(BWCONF)
WRITE BWCONFF,!
IF 'BWCRT
WRITE BWTIMLN,!
+7 WRITE !,BWTITLE
IF 'BWCRT
WRITE ?70,"page: ",BWPAGE
+8 ;IHS/CMI/THL PATCH 8
+9 WRITE !!,"Patient Name: ",BWNAMAGE,?55,$$PNLAB^BWUTL5(DUZ(2)),BWCHRT
+10 ; IHS/MSC/BWF - Patch 10
WRITE !,"DOB : ",$$FMTE^XLFDT($$GET1^DIQ(2,BWDFN,.03,"I")),?58,"PCP: ",$EXTRACT($$GET1^DIQ(9002086,BWDFN,.25),1,16)
+11 WRITE !,"Case Manager: ",BWCMGR
+12 WRITE ?53,"Facility: ",$EXTRACT($$INSTTX^BWUTL6(DUZ(2)),1,17)
+13 WRITE !,"Cx Tx Need : ",BWCNEED
+14 WRITE ?51,"Inact Date: ",$$SLDT2^BWUTL5($$INACT^BWUTL1(BWDFN))
+15 ;W ?52,"Period:" ;---> XDATES
+16 ;W ?60,$$SLDT2^BWUTL5(BWBEGDT)," to " ;---> XDATES
+17 ;W $$SLDT2^BWUTL5(BWENDDT) ;---> XDATES
+18 WRITE !,"PAP Regimen : ",BWPAPRG
+19 WRITE ?50,"Income Elig: "
+20 NEW X
+21 SET X=$PIECE(^BWP(BWDFN,0),U,29)
+22 WRITE $SELECT(X=1:"YES",X=2:"NO",X=3:"REFUSED",1:"NOT DETERMINED")
+23 WRITE !,"Br Tx Need : ",BWBNEED
+24 WRITE ?50,"Income Date: "
+25 NEW X
+26 SET X=$PIECE(^BWP(BWDFN,0),U,30)
+27 WRITE $$SLDT2^BWUTL5(X)
+28 ;W !," PCP : "_$$GET1^DIQ(9002086,BWDFN,.25) ;IHS/CIA/PLS - Patch 11
+29 ;IHS/CMI/THL END PATCH 8
+30 WRITE !
FOR I=1:1:49
WRITE "="
+31 ;begin Y2K
+32 ;IHS/CMI/LAB - format 4 digit year Y2000
WRITE $SELECT(BWEDC]"":BWEDC_"====",1:"===============================")
+33 ;end Y2K
+34 IF $DATA(BWSUBH)
DO @BWSUBH
+35 QUIT
+36 ;
+37 ;
+1 ;---> LAB LOG REPORT HEADER: MULTIPLE PATIENTS, MULTIPLE PROCEDURES.
+2 ;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
+3 ;---> OPTIONAL VARIABLE: BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
+4 NEW X
+5 IF BWPAGE>1!BWCRT
WRITE @IOF,!
+6 IF $DATA(BWCONF)
WRITE BWCONFF,!
IF 'BWCRT
WRITE BWTIMLN,!
+7 WRITE !,BWTITLE
IF 'BWCRT
WRITE ?70,"page: ",BWPAGE
+8 WRITE !!,"Facility: ",$$INSTTX^BWUTL6($SELECT($GET(BWFAC):BWFAC,1:DUZ(2)))
+9 ;begin Y2K
+10 ;IHS/CMI/LAB 53 to 49 Y2000
WRITE ?49,"From: ",$$SLDT2^BWUTL5(BWBEGDT)
+11 ;end Y2K
+12 WRITE " to ",$$SLDT2^BWUTL5(BWENDDT)
+13 WRITE !
FOR I=1:1:80
WRITE "="
+14 IF $DATA(BWSUBH)
DO @BWSUBH
+15 QUIT
+16 ;
+17 ;
+1 ;---> PATIENT REPORT HEADER: ONE PATIENT, ONE PROCEDURE.
+2 ;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE1,DUZ(2)
+3 ;---> OPTIONAL VARIABLE: BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
+4 IF BWPAGE>1!BWCRT
WRITE @IOF,!
+5 WRITE BWCONFF
IF 'BWCRT
WRITE !,BWTIMLN
+6 WRITE !!,BWTITLE1,?70,"page: ",BWPAGE
SET BWPAGE=BWPAGE+1
+1 ;---> CALLED BY BWPROC; BYPASSES FORMFEED, TITLE, ETC.
+2 WRITE !!,"Patient Name: ",BWNAMAGE,?53,$$PNLAB^BWUTL5(DUZ(2)),BWCHRT
+3 WRITE !,"Case Manager: ",BWCMGR
+4 WRITE ?50,"Procedure: ",$EXTRACT(BWPN,1,19)
+5 WRITE !,"Cx Tx Need : ",BWCNEED
+6 WRITE ?55,"Acc#: ",BWACCN
+7 WRITE !,"PAP Regimen : ",BWPAPRG
+8 WRITE !,"Br Tx Need : ",BWBNEED
+9 WRITE ?61,$SELECT($$DES^BWUTL1(BWDFN):"*DES DAUGHTER*",1:"")
+10 WRITE !
FOR I=1:1:49
WRITE "-"
+11 WRITE $SELECT(BWEDC]"":BWEDC_"------",1:"-------------------------------")
+12 QUIT
+13 ;
+14 ;
+1 ;---> DELINQUENT NEEDS REPORT HEADER: MULTIPLE PATIENTS
+2 ;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
+3 ;---> OPTIONAL VARIABLE: BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
+4 NEW X
+5 IF BWPAGE>1!BWCRT
WRITE @IOF,!
+6 IF $DATA(BWCONF)
WRITE BWCONFF,!
IF 'BWCRT
WRITE BWTIMLN,!
+7 WRITE !,BWTITLE
IF 'BWCRT
WRITE ?70,"page: ",BWPAGE
+8 WRITE !!,"Case Mgr: "
Begin DoDot:1
+9 IF '$DATA(BWE)
WRITE "ALL"
QUIT
+10 IF BWE
WRITE "ALL"
QUIT
+11 IF $GET(BWCMGR)']""
WRITE "UNKNOWN"
QUIT
+12 IF '$DATA(^VA(200,BWCMGR,0))
WRITE "UNKNOWN"
QUIT
+13 WRITE $PIECE(^VA(200,BWCMGR,0),U)
End DoDot:1
+14 WRITE ?46,"Communit"
Begin DoDot:1
+15 IF $DATA(BWCC("ALL"))
WRITE "ies: ALL"
QUIT
+16 NEW I,N
SET N=0
FOR I=0:1
SET N=$ORDER(BWCC(N))
IF 'N
QUIT
+17 IF I=1
WRITE "y: ",$EXTRACT($PIECE(^AUTTCOM($ORDER(BWCC(N)),0),U),1,22)
QUIT
+18 WRITE "ies: ",$EXTRACT($PIECE(^AUTTCOM($ORDER(BWCC(N)),0),U),1,18),",..."
QUIT
End DoDot:1
+19 WRITE !,"Facility: ",$$INSTTX^BWUTL6(BWFAC)
+20 WRITE ?46,"Tx Needs Past Due as of ",$$SLDT2^BWUTL5(BWDDATE)
+21 WRITE !
FOR I=1:1:80
WRITE "="
+22 IF $DATA(BWSUBH)
DO @BWSUBH
+23 QUIT
+24 ;
+25 ;
+1 ;---> PROGRAM SNAPSHOT HEADER: JUST TITLE AND FACILITY (NO PATIENTS)
+2 ;---> REQUIRED VARIABLES: BWCRT,BWTITLE,DUZ(2)
+3 NEW X
+4 IF BWPAGE>1!BWCRT
WRITE @IOF,!
+5 IF 'BWCRT
WRITE !,BWTIMLN,!
+6 WRITE !,BWTITLE
IF 'BWCRT
WRITE ?70,"page: ",BWPAGE
+7 WRITE !!," Note: This report includes all facilities"
+8 WRITE " using this database."
+9 ;W " Facility: ",$$INSTTX^BWUTL6(DUZ(2))
+10 ;W " (This report is not site specific.)"
+11 WRITE !
FOR I=1:1:80
WRITE "="
+12 QUIT
+13 ;
+14 ;
+1 ;---> AUTOLOAD OF PATIENTS HEADER
+2 ;---> REQUIRED VARIABLES: BWCRT,BWTITLE,DUZ(2)
+3 NEW X
+4 IF BWPAGE>1!BWCRT
WRITE @IOF,!
+5 IF $DATA(BWCONF)
WRITE BWCONFF,!
IF 'BWCRT
WRITE BWTIMLN,!
+6 WRITE !,BWTITLE
IF 'BWCRT
WRITE ?70,"page: ",BWPAGE
SET BWPAGE=BWPAGE+1
+7 WRITE !!,"Facility: ",$$INSTTX^BWUTL6(DUZ(2))
+8 WRITE ?64,"Cutoff Age: ",BWAGE
+9 WRITE !
FOR I=1:1:80
WRITE "="
+10 WRITE !,?3,"NAME",?30,$$PNLB^BWUTL5(DUZ(2)),?45,"DOB",?60,"STATUS"
+11 WRITE !,BWLINE
+12 QUIT
+13 ;
+14 ;
+1 ;---> SCREENING RATES REPORT HEADER: (NO PATIENTS)
+2 ;---> REQUIRED VARIABLES: BWCRT,BWTITLE,DUZ(2)
+3 NEW X
+4 IF BWPAGE>1!BWCRT
WRITE @IOF,!
+5 IF 'BWCRT
WRITE !,BWTIMLN,!
+6 WRITE !,BWTITLE
IF 'BWCRT
WRITE ?70,"page: ",BWPAGE
+7 WRITE !!?4,"For Age Range: ",$SELECT(BWAGRG=1:"ALL",1:BWAGRG)
+8 WRITE ?56,"For period: ",$$SLDT2^BWUTL5(BWBEGDT)
+9 WRITE !?4,"Communit"
Begin DoDot:1
+10 IF $DATA(BWCC("ALL"))
WRITE "ies: ALL"
QUIT
+11 NEW I,N
SET N=""
SET I=0
FOR
SET N=$ORDER(BWCC(N))
IF N=""
QUIT
SET I=I+1
+12 IF I=1
WRITE "y: ",$EXTRACT($ORDER(BWCC("")),1,22)
QUIT
+13 WRITE "ies: ",$EXTRACT($ORDER(BWCC("")),1,18),",..."
QUIT
End DoDot:1
+14 WRITE ?64,"To: ",$$SLDT2^BWUTL5(BWENDDT)
+15 WRITE !
FOR I=1:1:80
WRITE "="
+16 WRITE !?4,"(Note: This report includes all facilities"
+17 WRITE " using this database.)",!
+18 ;I $D(BWSUBH) D @BWSUBH
+19 QUIT
+20 ;
ENDREP(X) ;EP
+1 ;---> END A REPORT, DO FORMFEED OR "Press <Return>" IF NECESSARY.
+2 ;---> REQUIRED VARIABLES: BWCRT=1 IF OUTPUT TO SCREEN
+3 ;---> BWPOP=1 IF ESCAPING
+4 ;---> OPTIONAL VARIABLE: X=1 IF "End of Report" SHOULD NOT DISPLAY.
+5 ;
+6 SET BWTITLE="----- End of Report -----"
+7 IF '$GET(X)&('BWPOP)
DO CENTERT^BWUTL5(.BWTITLE)
WRITE !,BWTITLE
+8 IF 'BWCRT
WRITE @IOF,!
+9 IF BWCRT&('$DATA(IO("S")))&('BWPOP)
DO DIRZ^BWUTL3
WRITE @IOF,!
+10 DO ^%ZISC
+11 QUIT
