BWRPSCR ;IHS/ANMC/MWR - WOMEN'S HEALTH PCC LINK [ 09/07/99 7:19 AM ];15-Feb-2003 22:10;PLS
;;2.0;WOMEN'S HEALTH;**1,6,8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; THIS REPORT WILL DISPLAY SCREENING RATES FOR PAPS & MAMS.
;; PATCHED AT LINELABEL CURCOM. IHS/ANMC/MWR 11/20/96
;
PRINT ;EP
;---> DISPLAY PROCEDURE PCC .01 POINTERS.
D SETUP
D TITLE^BWUTL5("SCREENING RATES FOR PAPS AND MAMS")
D TEXT1,DIRZ^BWUTL3 G:BWPOP EXIT
D DATES G:BWPOP EXIT
D AGERNG G:BWPOP EXIT
D CURCOM G:BWPOP EXIT
D DEVICE G:BWPOP EXIT
D DATA^BWRPSCR1
D DISPLAY
;
EXIT ;EP
K AMQQTAX
D KILLALL^BWUTL8
Q
;
SETUP ;EP
D SETVARS^BWUTL5
Q
;
DATES ;EP
;---> ASK DATE RANGE. RETURN DATES IN BWBEGDT AND BWENDDT.
D ASKDATES^BWUTL3(.BWBEGDT,.BWENDDT,.BWPOP)
Q
;
AGERNG ;EP
;---> ASK AGE RANGE.
;---> RETURN AGE RANGE IN BWAGRG.
D AGERNG^BWRPSCR1(.BWAGRG,.BWPOP)
Q
;
CURCOM ;EP
;---> SELECT CASES FOR ONE OR MORE CURRENT COMMUNITY (OR ALL).
;---> DO NOT PROMPT FOR CURRENT COMMUNITY IF THIS IS A VA SITE.
;I $$AGENCY^BWUTL5(DUZ(2))='"i" S BWCC("ALL")="" Q ;VAMOD
I $$AGENCY^BWUTL5(DUZ(2))'="i" D Q ;IHS/ANMC/MWR 11/20/96
.S BWCC("ALL")="" ;IHS/ANMC/MWR 11/20/96
;---> SELECT CURRENT COMMUNITY(S).
D TEXT2
;D SELECT^BWSELECT("Current Community",9999999.05,"BWCC","","",.BWPOP)
K BWCC
S DIR(0)="S^O:One particular Community;A:All Communities;S:Selected Set of Communities (Taxonomy)",DIR("A")="List children who live in",DIR("B")="O" K DA D ^DIR K DIR
I $D(DIRUT) S BWPOP=1 Q
I Y="A" W !!,"All communities will be included in the report.",! S BWCC("ALL")="" Q
I Y="O" D Q:$D(BWCC) I 1
.S DIC="^AUTTCOM(",DIC(0)="AEMQ",DIC("A")="Which COMMUNITY: " D ^DIC K DIC
.Q:Y=-1
.S BWCC($P(^AUTTCOM(+Y,0),U))=""
S X="COMMUNITY",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G CURCOM
D ^AMQQGTX0(+Y,"BWCC(")
I '$D(BWCC) G CURCOM
I $D(BWCC("*")) S BWCC("ALL")=""
Q
;
DEVICE ;EP
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
S ZTRTN="DEQUEUE^BWRPSCR"
F BWSV="AGRG","BEGDT","ENDDT" D
.I $D(@("BW"_BWSV)) S ZTSAVE("BW"_BWSV)=""
;---> SAVE ATTRIBUTES ARRAY. NOTE: SUBSTITUTE LOCAL ARRAY FOR BWATT.
I $D(BWCC) N N S N=0 F S N=$O(BWCC(N)) Q:N="" D
.S ZTSAVE("BWCC("""_N_""")")=""
D ZIS^BWUTL2(.BWPOP,1,"HOME")
Q
;
;
DISPLAY ;EP
U IO
S BWTITLE="* WOMEN'S HEALTH: SCREENING RATES FOR PAPS AND MAMS *"
D CENTERT^BWUTL5(.BWTITLE)
D TOPHEAD^BWUTL7
S BWPAGE=1,BWPOP=0
S BWSUB="W !?3,""For Age Range: "",$S(BWAGRG=1:""ALL"",1:BWAGRG)"
;
S (BWPOP,N,Z)=0
W:BWCRT @IOF D HEADER8^BWUTL7
F S N=$O(^TMP("BW",$J,N)) Q:'N!(BWPOP) D
.I $Y+3>IOSL D:BWCRT DIRZ^BWUTL3 Q:BWPOP D HEADER8^BWUTL7
.W !,^TMP("BW",$J,N,0)
W:'BWCRT !
D ENDREP^BWUTL7(BWCRT)
Q
;
DEQUEUE ;EP
;---> CALLED BY TASKMAN
D SETUP,DATA^BWRPSCR1,DISPLAY,EXIT
Q
;
TEXT1 ;
;;This report is designed to serve as an indicator of screening
;;rates for PAPs and MAMs. The report will display the percentages
;;of women who received PAPs and MAMs for screening purposes only,
;;within the selected date range.
;;
;;Only patients who have had normal results for procedures in the
;;specified date range are counted; the intent is to exclude
;;any procedures that would involve abnormal results, diagnostic
;;and follow-up procedures, etc. Due to the complexities
;;involved in the treatment of individual cases that involve
;;abnormal results, those patients will not be included, even
;;though some of them may have received screening PAPs or MAMs.
;;
;;This report, therefore, serves ONLY AS AN INDICATOR (NOT as an exact
;;count of screening rates) for gauging the success rates of annual
;;screening programs. It can be run for several different time frames
;;in order to examine trends. Assuming a screening cycle of one year,
;;a minimum date range spanning 15 months is recommended.
S BWTAB=5,BWLINL="TEXT1" D PRINTX
Q
;
TEXT2 ;EP
;;
;;You may limit this report to one or more specific communities,
;;or you may select all communities. "Community" in this context
;;refers to the patient's "Current Community" as displayed and
;;edited in the IHS Registration software.
S BWTAB=3,BWLINL="TEXT2" D PRINTX
Q
;
PRINTX ;EP
N I,T,X S T="" F I=1:1:BWTAB S T=T_" "
F I=1:1 S X=$T(@BWLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
Q
BWRPSCR ;IHS/ANMC/MWR - WOMEN'S HEALTH PCC LINK [ 09/07/99 7:19 AM ];15-Feb-2003 22:10;PLS
+1 ;;2.0;WOMEN'S HEALTH;**1,6,8**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; THIS REPORT WILL DISPLAY SCREENING RATES FOR PAPS & MAMS.
+4 ;; PATCHED AT LINELABEL CURCOM. IHS/ANMC/MWR 11/20/96
+5 ;
PRINT ;EP
+1 ;---> DISPLAY PROCEDURE PCC .01 POINTERS.
+2 DO SETUP
+3 DO TITLE^BWUTL5("SCREENING RATES FOR PAPS AND MAMS")
+4 DO TEXT1
DO DIRZ^BWUTL3
IF BWPOP
GOTO EXIT
+5 DO DATES
IF BWPOP
GOTO EXIT
+6 DO AGERNG
IF BWPOP
GOTO EXIT
+7 DO CURCOM
IF BWPOP
GOTO EXIT
+8 DO DEVICE
IF BWPOP
GOTO EXIT
+9 DO DATA^BWRPSCR1
+10 DO DISPLAY
+11 ;
EXIT ;EP
+1 KILL AMQQTAX
+2 DO KILLALL^BWUTL8
+3 QUIT
+4 ;
SETUP ;EP
+1 DO SETVARS^BWUTL5
+2 QUIT
+3 ;
DATES ;EP
+1 ;---> ASK DATE RANGE. RETURN DATES IN BWBEGDT AND BWENDDT.
+2 DO ASKDATES^BWUTL3(.BWBEGDT,.BWENDDT,.BWPOP)
+3 QUIT
+4 ;
AGERNG ;EP
+1 ;---> ASK AGE RANGE.
+2 ;---> RETURN AGE RANGE IN BWAGRG.
+3 DO AGERNG^BWRPSCR1(.BWAGRG,.BWPOP)
+4 QUIT
+5 ;
CURCOM ;EP
+1 ;---> SELECT CASES FOR ONE OR MORE CURRENT COMMUNITY (OR ALL).
+2 ;---> DO NOT PROMPT FOR CURRENT COMMUNITY IF THIS IS A VA SITE.
+3 ;I $$AGENCY^BWUTL5(DUZ(2))='"i" S BWCC("ALL")="" Q ;VAMOD
+4 ;IHS/ANMC/MWR 11/20/96
IF $$AGENCY^BWUTL5(DUZ(2))'="i"
Begin DoDot:1
+5 ;IHS/ANMC/MWR 11/20/96
SET BWCC("ALL")=""
End DoDot:1
QUIT
+6 ;---> SELECT CURRENT COMMUNITY(S).
+7 DO TEXT2
+8 ;D SELECT^BWSELECT("Current Community",9999999.05,"BWCC","","",.BWPOP)
+9 KILL BWCC
+10 SET DIR(0)="S^O:One particular Community;A:All Communities;S:Selected Set of Communities (Taxonomy)"
SET DIR("A")="List children who live in"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
SET BWPOP=1
QUIT
+12 IF Y="A"
WRITE !!,"All communities will be included in the report.",!
SET BWCC("ALL")=""
QUIT
+13 IF Y="O"
Begin DoDot:1
+14 SET DIC="^AUTTCOM("
SET DIC(0)="AEMQ"
SET DIC("A")="Which COMMUNITY: "
DO ^DIC
KILL DIC
+15 IF Y=-1
QUIT
+16 SET BWCC($PIECE(^AUTTCOM(+Y,0),U))=""
End DoDot:1
IF $DATA(BWCC)
QUIT
IF 1
+17 SET X="COMMUNITY"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
GOTO CURCOM
+18 DO ^AMQQGTX0(+Y,"BWCC(")
+19 IF '$DATA(BWCC)
GOTO CURCOM
+20 IF $DATA(BWCC("*"))
SET BWCC("ALL")=""
+21 QUIT
+22 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 SET ZTRTN="DEQUEUE^BWRPSCR"
+3 FOR BWSV="AGRG","BEGDT","ENDDT"
Begin DoDot:1
+4 IF $DATA(@("BW"_BWSV))
SET ZTSAVE("BW"_BWSV)=""
End DoDot:1
+5 ;---> SAVE ATTRIBUTES ARRAY. NOTE: SUBSTITUTE LOCAL ARRAY FOR BWATT.
+6 IF $DATA(BWCC)
NEW N
SET N=0
FOR
SET N=$ORDER(BWCC(N))
IF N=""
QUIT
Begin DoDot:1
+7 SET ZTSAVE("BWCC("""_N_""")")=""
End DoDot:1
+8 DO ZIS^BWUTL2(.BWPOP,1,"HOME")
+9 QUIT
+10 ;
+11 ;
DISPLAY ;EP
+1 USE IO
+2 SET BWTITLE="* WOMEN'S HEALTH: SCREENING RATES FOR PAPS AND MAMS *"
+3 DO CENTERT^BWUTL5(.BWTITLE)
+4 DO TOPHEAD^BWUTL7
+5 SET BWPAGE=1
SET BWPOP=0
+6 SET BWSUB="W !?3,""For Age Range: "",$S(BWAGRG=1:""ALL"",1:BWAGRG)"
+7 ;
+8 SET (BWPOP,N,Z)=0
+9 IF BWCRT
WRITE @IOF
DO HEADER8^BWUTL7
+10 FOR
SET N=$ORDER(^TMP("BW",$JOB,N))
IF 'N!(BWPOP)
QUIT
Begin DoDot:1
+11 IF $Y+3>IOSL
IF BWCRT
DO DIRZ^BWUTL3
IF BWPOP
QUIT
DO HEADER8^BWUTL7
+12 WRITE !,^TMP("BW",$JOB,N,0)
End DoDot:1
+13 IF 'BWCRT
WRITE !
+14 DO ENDREP^BWUTL7(BWCRT)
+15 QUIT
+16 ;
DEQUEUE ;EP
+1 ;---> CALLED BY TASKMAN
+2 DO SETUP
DO DATA^BWRPSCR1
DO DISPLAY
DO EXIT
+3 QUIT
+4 ;
TEXT1 ;
+1 ;;This report is designed to serve as an indicator of screening
+2 ;;rates for PAPs and MAMs. The report will display the percentages
+3 ;;of women who received PAPs and MAMs for screening purposes only,
+4 ;;within the selected date range.
+5 ;;
+6 ;;Only patients who have had normal results for procedures in the
+7 ;;specified date range are counted; the intent is to exclude
+8 ;;any procedures that would involve abnormal results, diagnostic
+9 ;;and follow-up procedures, etc. Due to the complexities
+10 ;;involved in the treatment of individual cases that involve
+11 ;;abnormal results, those patients will not be included, even
+12 ;;though some of them may have received screening PAPs or MAMs.
+13 ;;
+14 ;;This report, therefore, serves ONLY AS AN INDICATOR (NOT as an exact
+15 ;;count of screening rates) for gauging the success rates of annual
+16 ;;screening programs. It can be run for several different time frames
+17 ;;in order to examine trends. Assuming a screening cycle of one year,
+18 ;;a minimum date range spanning 15 months is recommended.
+19 SET BWTAB=5
SET BWLINL="TEXT1"
DO PRINTX
+20 QUIT
+21 ;
TEXT2 ;EP
+1 ;;
+2 ;;You may limit this report to one or more specific communities,
+3 ;;or you may select all communities. "Community" in this context
+4 ;;refers to the patient's "Current Community" as displayed and
+5 ;;edited in the IHS Registration software.
+6 SET BWTAB=3
SET BWLINL="TEXT2"
DO PRINTX
+7 QUIT
+8 ;
PRINTX ;EP
+1 NEW I,T,X
SET T=""
FOR I=1:1:BWTAB
SET T=T_" "
+2 FOR I=1:1
SET X=$TEXT(@BWLINL+I)
IF X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+3 QUIT
