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

WVRPSCR1.m

Go to the documentation of this file. 
  1. WVRPSCR1 ;HCIOFO/FT,JR-Display Compliance Rates (cont.) ;6/17/99  11:47
  1.  ;;1.0;WOMEN'S HEALTH;**3,7**;Sep 30, 1998
  1.  ;;  Original routine created by IHS/ANMC/MWR
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  THIS REPORT WILL DISPLAY COMPLIANCE RATES FOR PAPS & MAMS.
  1.  ;;  ENTRY POINTS CALLED BY WVRPSCR.
  1. DATA ;EP
  1.  ;---> SORT AND STORE ARRAY IN ^TMP("WV",$J
  1.  K WVTMP,^TMP("WV",$J),^TMP("WVP",$J),WVPR
  1.  ;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
  1.  ;---> WVENDDT1=THE LAST SECOND OF END DATE.
  1.  F WVCNT=20,30,40,50,60,70,200 S WVAGRG(WVCNT)=""
  1.  S WVBEGDT1=WVBEGDT-.0001,WVENDDT1=WVENDDT+.9999
  1.  ;
  1.  S WVDATE=WVBEGDT1,WVTOT=$$ACTIVE^WVRPSCR2(WVBEGDT,WVENDDT1,WVAGRG)
  1.  F  S WVDATE=$O(^WV(790.1,"D",WVDATE)) Q:'WVDATE!(WVDATE>WVENDDT1)  D
  1.  .S WVIEN=0
  1.  .F  S WVIEN=$O(^WV(790.1,"D",WVDATE,WVIEN)) Q:'WVIEN  D
  1.  ..S Y=^WV(790.1,WVIEN,0)
  1.  ..S WVDFN=$P(Y,U,2),WVPCDN=$P(Y,U,4),WVRES=$P(Y,U,5)
  1.  ..;
  1.  ..;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
  1.  ..Q:WVRES=8
  1.  ..;
  1.  ..;---> QUIT IF NEITHER A PAP (IEN=1) NOR A SCREENING MAM (IEN=28).
  1.  ..Q:((WVPCDN'=1)&(WVPCDN'=28))
  1.  ..;
  1.  ..;---> QUIT IS PATIENT IS NOT WITHIN AGE RANGE.
  1.  ..S WVAGE=+$$AGE^WVUTL9(WVDFN)
  1.  ..I WVAGRG'=1 Q:((WVAGE<$P(WVAGRG,"-"))!(WVAGE>$P(WVAGRG,"-",2)))
  1.  ..;
  1.  ..;---> GET VALUE OF RESULT: 0=NORMAL, 1=ABNORMAL, 2=NO RESULT
  1.  ..S WVNORM=$$NORMAL^WVUTL4(WVRES) S:WVNORM=2 WVNORM=0
  1.  ..;
  1.  ..S ^TMP("WV",$J,WVDFN,WVNORM,WVPCDN,WVIEN)=""
  1.  ..I WVPCDN=1 D
  1.  ...S WVJPAPR=$P($G(^WV(790,WVDFN,0)),U,16)
  1.  ...I WVJPAPR'>0 S WVJPAPR="NOT SPECIFIED"
  1.  ...E  S WVJPAPR=$P($G(^WV(790.03,WVJPAPR,0)),U)
  1.  ...S ^TMP("WVP",$J,WVJPAPR,WVDFN,WVNORM,WVPCDN,WVIEN)=""
  1.  ..I WVPCDN=28 D
  1.  ...S WVJ=$O(WVAGRG(WVAGE))
  1.  ...S WVJAGER=$S(WVJ=20:"<20",WVJ=30:"20-29",WVJ=40:"30-39",WVJ=50:"40-49",WVJ=60:"50-59",WVJ=70:"60-69",WVJ=200:">70",1:"AGE UNKNOWN")
  1.  ...S ^TMP("WVP",$J,WVJAGER,WVDFN,WVNORM,WVPCDN,WVIEN)=""
  1.  ;
  1.  ;---> NOW COLLATE DATA FROM ^TMP ARRAY INTO LOCAL WVTMP REPORT ARRAY.
  1.  ;---> FIRST, SEED LOCAL ARRAY WITH ZEROS.
  1.  F M=1,28 D
  1.  .N I F I=1:1:5 S WVTMP("RES",M,I)=0
  1.  ;
  1.  ;---> COLLATE DATA.
  1.  S N=0
  1.  F  S N=$O(^TMP("WV",$J,N)) Q:'N  D
  1.  .F M=1,28 D
  1.  ..Q:$D(^TMP("WV",$J,N,1,M))
  1.  ..S P=0,Q=0
  1.  ..F  S P=$O(^TMP("WV",$J,N,0,M,P)) Q:'P  S Q=Q+1
  1.  ..Q:'Q
  1.  ..I '$D(WVTMP("RES",M,Q)) S WVTMP("RES",M,Q)=1 Q
  1.  ..S WVTMP("RES",M,Q)=WVTMP("RES",M,Q)+1
  1.  ;
  1.  ;---> STORE ALL NODES >5 IN THE 5+ NODE.
  1.  F M=1,28 D
  1.  .S Q=5
  1.  .F  S Q=$O(WVTMP("RES",M,Q)) Q:'Q  D
  1.  ..S WVTMP("RES",M,5)=WVTMP("RES",M,5)+WVTMP("RES",M,Q)
  1.  ..K WVTMP("RES",M,Q)
  1.  ;
  1.  ;---> FIGURE PERCENTAGES OF WOMEN AND STORE IN ARRAY.
  1.  F M=1,28 D
  1.  .F Q=1:1:5 S $P(WVTMP("RES",M,Q),U,2)=$J((+WVTMP("RES",M,Q)/WVTOT),0,2)
  1.  ;
  1.  ;---> BUILD DISPLAY ARRAY.
  1.  N WVNODE K ^TMP("WV",$J)
  1.  ;
  1.  ;---> PAPS SUBHEADER LINE.
  1.  S WVNODE=$$S(40)_"SCREENING PAPS"
  1.  D WRITE(1,WVNODE)
  1.  S WVNODE=$$S(39)_"----------------"
  1.  D WRITE(2,WVNODE)
  1.  S WVNODE=" # of PAPs:                                        1     2     3     4     5+"
  1.  D WRITE(4,WVNODE)
  1.  S WVNODE=" -----------                                     ----- ----- ----- ----- -----"
  1.  D WRITE(5,WVNODE)
  1.  ;
  1.  ;---> PAPS NUMBER OF WOMEN DATA LINE.
  1.  S WVNODE=" # of Women:                                    "
  1.  F Q=1:1:5 S WVNODE=WVNODE_$J($P(WVTMP("RES",1,Q),U),6)
  1.  D WRITE(6,WVNODE)
  1.  S WVNODE=" % of Women:                                    "
  1.  F Q=1:1:5 S WVNODE=WVNODE_$J(($P(WVTMP("RES",1,Q),U,2)*100),5)_"%"
  1.  D WRITE(7,WVNODE)
  1.  ;
  1.  ;---> LINE FEEDS BETWEEN PAPS AND MAMS.
  1.  S WVNODE="" D WRITE(8,WVNODE) S WVNODE="" D WRITE(9,WVNODE)
  1.  ;
  1.  ;---> MAMS SUBHEADER LINE.
  1.  S WVNODE=$$S(40)_"SCREENING MAMS"
  1.  D WRITE(10,WVNODE)
  1.  S WVNODE=$$S(39)_"----------------"
  1.  D WRITE(11,WVNODE)
  1.  S WVNODE=" # of MAMs:                                        1     2     3     4     5+"
  1.  D WRITE(13,WVNODE)
  1.  S WVNODE=" -----------                                     ----- ----- ----- ----- -----"
  1.  D WRITE(14,WVNODE)
  1.  ;
  1.  ;---> PAPS NUMBER OF WOMEN DATA LINE.
  1.  S WVNODE=" # of Women:                                    "
  1.  F Q=1:1:5 S WVNODE=WVNODE_$J($P(WVTMP("RES",28,Q),U),6)
  1.  D WRITE(15,WVNODE)
  1.  S WVNODE=" % of Women:                                    "
  1.  F Q=1:1:5 S WVNODE=WVNODE_$J(($P(WVTMP("RES",28,Q),U,2)*100),5)_"%"
  1.  D WRITE(16,WVNODE)
  1.  Q
  1.  ;
  1. WRITE(I,Y) ;EP
  1.  S ^TMP("WV",$J,I,0)=Y
  1.  Q
  1.  ;
  1. S(S) ;EP
  1.  ;---> SPACES.
  1.  Q $$S^WVUTL7($G(S))
  1.  ;
  1.  ;
  1. AGERNG(WVAGRG,WVPOP) ;EP
  1.  ;---> ASK AGE RANGE.
  1.  ;---> RETURN AGE RANGE IN WVAGRG.
  1.  N DIR,DIRUT,Y S WVPOP=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) WVPOP=1
  1.  ;---> IF NOT DISPLAYING BY AGE RANGE, SET WVAGRG (AGE RANGE)=1, QUIT.
  1.  I 'Y S WVAGRG=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(^WV(790.72,DUZ,0)) DIR("B")=$P(^(0),U,3)
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) S WVPOP=1 Q
  1.  D CHECK(.Y)
  1.  I Y="" D  G BYAGE1
  1.  .W !!?5,"* INVALID AGE RANGE.  Please begin again."
  1.  ;---> WVAGRG=SELECTED AGE RANGE(S).
  1.  S WVAGRG=Y
  1.  D DIC^WVFMAN(790.72,"L",.Y,"","","","`"_DUZ)
  1.  Q:Y<0
  1.  D DIE^WVFMAN(790.72,".03////"_WVAGRG,+Y,.WVPOP,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 WVTAB=5,WVLINL="HELP1" D HELPTX
  1.  Q
  1.  ;
  1. PRINTX ;EP
  1.  N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
  1.  F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)
  1.  Q
  1.  ;
  1. HELPTX ;EP
  1.  ;---> CREATES DIR ARRAY FOR DIR.  REQUIRED VARIABLES: WVTAB,WVLINL.
  1.  N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
  1.  F I=1:1 S X=$T(@WVLINL+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