Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BWRPSCR

BWRPSCR.m

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