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

BWRPSCR1.m

Go to the documentation of this file. 
  1. BWRPSCR1 ;IHS/ANMC/MWR - WOMEN'S HEALTH PCC LINK  [ 09/07/99  7:28 AM ];15-Feb-2003 22:37;PLS
  1.  ;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996
  1.  ;patch 6 modified current community screen
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  THIS REPORT WILL DISPLAY SCREENING RATES FOR PAPS & MAMS.
  1.  ;;  ENTRY POINTS CALLED BY BWRPSCR.
  1.  ;
  1.  ;
  1. DATA ;EP
  1.  ;---> SORT AND STORE ARRAY IN ^TMP("BW",$J
  1.  K BWTMP,^TMP("BW",$J)
  1.  ;---> BWBEGDT1=ONE SECOND BEFORE BEGIN DATE.
  1.  ;---> BWENDDT1=THE LAST SECOND OF END DATE.
  1.  S BWBEGDT1=BWBEGDT-.0001,BWENDDT1=BWENDDT+.9999
  1.  ;
  1.  S BWDATE=BWBEGDT1
  1.  F  S BWDATE=$O(^BWPCD("D",BWDATE)) Q:'BWDATE!(BWDATE>BWENDDT1)  D
  1.  .S BWIEN=0
  1.  .F  S BWIEN=$O(^BWPCD("D",BWDATE,BWIEN)) Q:'BWIEN  D
  1.  ..S Y=^BWPCD(BWIEN,0)
  1.  ..S BWDFN=$P(Y,U,2),BWPCDN=$P(Y,U,4),BWRES=$P(Y,U,5)
  1.  ..;
  1.  ..;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
  1.  ..Q:BWRES=8
  1.  ..;
  1.  ..;---> QUIT IF NEITHER A PAP (IEN=1) NOR A SCREENING MAM (IEN=28).
  1.  ..Q:((BWPCDN'=1)&(BWPCDN'=28))
  1.  ..;
  1.  ..;---> QUIT IS PATIENT IS NOT WITHIN AGE RANGE.
  1.  ..S BWAGE=+$$AGE^BWUTL1(BWDFN)
  1.  ..I BWAGRG'=1 Q:((BWAGE<$P(BWAGRG,"-"))!(BWAGE>$P(BWAGRG,"-",2)))
  1.  ..;
  1.  ..;---> QUIT IF NOT SELECTING ALL CURRENT COMMUNITIES AND IF THIS
  1.  ..;---> IS NOT ONE OF THE SELECETED.
  1.  ..I '$D(BWCC("ALL")) S X=$P($G(^AUPNPAT(BWDFN,11)),U,18) Q:X=""  Q:'$D(BWCC(X))
  1.  ..;
  1.  ..;---> GET VALUE OF RESULT: 0=NORMAL, 1=ABNORMAL, 2=NO RESULT
  1.  ..S BWNORM=$$NORMAL^BWUTL4(BWRES) S:BWNORM=2 BWNORM=0
  1.  ..;
  1.  ..S ^TMP("BW",$J,BWDFN,BWNORM,BWPCDN,BWIEN)=""
  1.  ;
  1.  ;---> NOW COLLATE DATA FROM ^TMP ARRAY INTO LOCAL BWTMP REPORT ARRAY.
  1.  ;---> FIRST, SEED LOCAL ARRAY WITH ZEROS.
  1.  F M=1,28 D
  1.  .N I F I=1:1:9 S BWTMP("RES",M,I)=0
  1.  ;
  1.  ;---> COLLATE DATA.
  1.  S N=0
  1.  F  S N=$O(^TMP("BW",$J,N)) Q:'N  D
  1.  .F M=1,28 D
  1.  ..Q:$D(^TMP("BW",$J,N,1,M))
  1.  ..S P=0,Q=0
  1.  ..F  S P=$O(^TMP("BW",$J,N,0,M,P)) Q:'P  S Q=Q+1
  1.  ..Q:'Q
  1.  ..I '$D(BWTMP("RES",M,Q)) S BWTMP("RES",M,Q)=1 Q
  1.  ..S BWTMP("RES",M,Q)=BWTMP("RES",M,Q)+1
  1.  ;
  1.  ;---> STORE ALL NODES >9 IN THE 9+ NODE.
  1.  F M=1,28 D
  1.  .S Q=9
  1.  .F  S Q=$O(BWTMP("RES",M,Q)) Q:'Q  D
  1.  ..S BWTMP("RES",M,9)=BWTMP("RES",M,9)+BWTMP("RES",M,Q)
  1.  ..K BWTMP("RES",M,Q)
  1.  ;
  1.  ;---> FIGURE PERCENTAGES OF WOMEN AND STORE IN ARRAY.
  1.  F M=1,28 D
  1.  .S BWTOT=0
  1.  .F Q=1:1:9 S BWTOT=BWTOT+BWTMP("RES",M,Q)
  1.  .S:'BWTOT BWTOT=1
  1.  .F Q=1:1:9 S $P(BWTMP("RES",M,Q),U,2)=$J((+BWTMP("RES",M,Q)/BWTOT),0,2)
  1.  ;
  1.  ;---> BUILD DISPLAY ARRAY.
  1.  N BWNODE K ^TMP("BW",$J)
  1.  ;
  1.  ;---> PAPS SUBHEADER LINE.
  1.  S BWNODE=$$S(32)_"SCREENING PAPS"
  1.  D WRITE(1,BWNODE)
  1.  S BWNODE=$$S(31)_"----------------"
  1.  D WRITE(2,BWNODE)
  1.  S BWNODE=" # of PAPs:      1      2      3      4      5"
  1.  S BWNODE=BWNODE_"      6      7      8     9+"
  1.  D WRITE(4,BWNODE)
  1.  S BWNODE=" -----------  ------ ------ ------ ------ ------"
  1.  S BWNODE=BWNODE_" ------ ------ ------ ------"
  1.  D WRITE(5,BWNODE)
  1.  ;
  1.  ;---> PAPS NUMBER OF WOMEN DATA LINE.
  1.  S BWNODE=" # of Women: "
  1.  F Q=1:1:9 S BWNODE=BWNODE_$J($P(BWTMP("RES",1,Q),U),7)
  1.  D WRITE(6,BWNODE)
  1.  S BWNODE=" % of Women: "
  1.  F Q=1:1:9 S BWNODE=BWNODE_$J(($P(BWTMP("RES",1,Q),U,2)*100),6)_"%"
  1.  D WRITE(7,BWNODE)
  1.  ;
  1.  ;---> LINE FEEDS BETWEEN PAPS AND MAMS.
  1.  S BWNODE="" D WRITE(8,BWNODE) S BWNODE="" D WRITE(9,BWNODE)
  1.  ;
  1.  ;---> MAMS SUBHEADER LINE.
  1.  S BWNODE=$$S(32)_"SCREENING MAMS"
  1.  D WRITE(10,BWNODE)
  1.  S BWNODE=$$S(31)_"----------------"
  1.  D WRITE(11,BWNODE)
  1.  S BWNODE=" # of MAMs:      1      2      3      4      5"
  1.  S BWNODE=BWNODE_"      6      7      8     9+"
  1.  D WRITE(13,BWNODE)
  1.  S BWNODE=" -----------  ------ ------ ------ ------ ------"
  1.  S BWNODE=BWNODE_" ------ ------ ------ ------"
  1.  D WRITE(14,BWNODE)
  1.  ;
  1.  ;---> PAPS NUMBER OF WOMEN DATA LINE.
  1.  S BWNODE=" # of Women: "
  1.  F Q=1:1:9 S BWNODE=BWNODE_$J($P(BWTMP("RES",28,Q),U),7)
  1.  D WRITE(15,BWNODE)
  1.  S BWNODE=" % of Women: "
  1.  F Q=1:1:9 S BWNODE=BWNODE_$J(($P(BWTMP("RES",28,Q),U,2)*100),6)_"%"
  1.  D WRITE(16,BWNODE)
  1.  Q
  1.  ;
  1. WRITE(I,Y) ;EP
  1.  S ^TMP("BW",$J,I,0)=Y
  1.  Q
  1.  ;
  1. S(S) ;EP
  1.  ;---> SPACES.
  1.  Q $$S^BWUTL7($G(S))
  1.  ;
  1.  ;
  1. AGERNG(BWAGRG,BWPOP) ;EP
  1.  ;---> ASK AGE RANGE.
  1.  ;---> RETURN AGE RANGE IN BWAGRG.
  1.  N DIR,DIRUT,Y S BWPOP=0
  1.  W !!?3,"Do you wish to limit this report to an age range?"
  1.  S DIR(0)="Y",DIR("B")="NO" D HELP1
  1.  S DIR("A")="   Enter Yes or No"
  1.  D ^DIR K DIR W !
  1.  S:$D(DIRUT) BWPOP=1
  1.  ;---> IF NOT DISPLAYING BY AGE RANGE, SET BWAGRG (AGE RANGE)=1, QUIT.
  1.  I 'Y S BWAGRG=1 Q
  1. BYAGE1 ;
  1.  W !?5,"Enter the age range you wish to select in the form of: 40-75"
  1.  W !?5,"Use a dash ""-"" to separate the limits of the range."
  1.  W !?5,"To select only one age, simply enter that age, with no dash."
  1.  W !?5,"(NOTE: Patient ages will reflect the age they are today.)",!
  1.  K DIR
  1.  S DIR(0)="FOA",DIR("A")="     Enter age range: "
  1.  S:$D(^BWAGDF(DUZ,0)) DIR("B")=$P(^(0),U,3)
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) S BWPOP=1 Q
  1.  D CHECK(.Y)
  1.  I Y="" D  G BYAGE1
  1.  .W !!?5,"* INVALID AGE RANGE.  Please begin again."
  1.  ;---> BWAGRG=SELECTED AGE RANGE(S).
  1.  S BWAGRG=Y
  1.  D DIC^BWFMAN(9002086.72,"L",.Y,"","","","`"_DUZ)
  1.  Q:Y<0
  1.  D DIE^BWFMAN(9002086.72,".03////"_BWAGRG,+Y,.BWPOP,1)
  1.  Q
  1.  ;
  1. HELP1 ;EP
  1.  ;;Answer "YES" to display screening rates for a specific age range.
  1.  ;;If you choose to display for an age range, you will be given the
  1.  ;;opportunity to select the age range.  For example, you might choose
  1.  ;;to display from ages 50-75.
  1.  ;;Answer "NO" to display screening rates for all ages.
  1.  S BWTAB=5,BWLINL="HELP1" D HELPTX
  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
  1.  ;
  1. HELPTX ;EP
  1.  ;---> CREATES DIR ARRAY FOR DIR.  REQUIRED VARIABLES: BWTAB,BWLINL.
  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'[";;"  S DIR("?",I)=T_$P(X,";;",2)
  1.  S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
  1.  Q
  1.  ;
  1. CHECK(X) ;EP
  1.  ;---> CHECK SYNTAX OF AGE RANGE STRING.
  1.  ;---> IF X=ONE AGE ONLY, SET IT IN THE FORM X-X AND QUIT.
  1.  I X?1N.N S X=X_"-"_X Q
  1.  ;
  1.  N FAIL,I,Y1,Y2
  1.  S FAIL=0
  1.  ;---> CHECK EACH RANGE.
  1.  S Y1=$P(X,"-"),Y2=$P(X,"-",2)
  1.  ;---> EACH END OF EACH RANGE SHOULD BE A NUMBER.
  1.  I (Y1'?1N.N)!(Y2'?1N.N) S X="" Q
  1.  ;---> THE LOWER NUMBER SHOULD BE FIRST.
  1.  I Y2<Y1 S FAIL=1
  1.  I FAIL S X="" Q
  1.  Q