192 lines
6.2 KiB
Mathematica
192 lines
6.2 KiB
Mathematica
WVRPSCR1 ;HCIOFO/FT,JR-Display Compliance Rates (cont.) ;6/17/99 11:47
|
|
;;1.0;WOMEN'S HEALTH;**3,7**;Sep 30, 1998
|
|
;; Original routine created by IHS/ANMC/MWR
|
|
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|
;; THIS REPORT WILL DISPLAY COMPLIANCE RATES FOR PAPS & MAMS.
|
|
;; ENTRY POINTS CALLED BY WVRPSCR.
|
|
DATA ;EP
|
|
;---> SORT AND STORE ARRAY IN ^TMP("WV",$J
|
|
K WVTMP,^TMP("WV",$J),^TMP("WVP",$J),WVPR
|
|
;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
|
|
;---> WVENDDT1=THE LAST SECOND OF END DATE.
|
|
F WVCNT=20,30,40,50,60,70,200 S WVAGRG(WVCNT)=""
|
|
S WVBEGDT1=WVBEGDT-.0001,WVENDDT1=WVENDDT+.9999
|
|
;
|
|
S WVDATE=WVBEGDT1,WVTOT=$$ACTIVE^WVRPSCR2(WVBEGDT,WVENDDT1,WVAGRG)
|
|
F S WVDATE=$O(^WV(790.1,"D",WVDATE)) Q:'WVDATE!(WVDATE>WVENDDT1) D
|
|
.S WVIEN=0
|
|
.F S WVIEN=$O(^WV(790.1,"D",WVDATE,WVIEN)) Q:'WVIEN D
|
|
..S Y=^WV(790.1,WVIEN,0)
|
|
..S WVDFN=$P(Y,U,2),WVPCDN=$P(Y,U,4),WVRES=$P(Y,U,5)
|
|
..;
|
|
..;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
|
|
..Q:WVRES=8
|
|
..;
|
|
..;---> QUIT IF NEITHER A PAP (IEN=1) NOR A SCREENING MAM (IEN=28).
|
|
..Q:((WVPCDN'=1)&(WVPCDN'=28))
|
|
..;
|
|
..;---> QUIT IS PATIENT IS NOT WITHIN AGE RANGE.
|
|
..S WVAGE=+$$AGE^WVUTL9(WVDFN)
|
|
..I WVAGRG'=1 Q:((WVAGE<$P(WVAGRG,"-"))!(WVAGE>$P(WVAGRG,"-",2)))
|
|
..;
|
|
..;---> GET VALUE OF RESULT: 0=NORMAL, 1=ABNORMAL, 2=NO RESULT
|
|
..S WVNORM=$$NORMAL^WVUTL4(WVRES) S:WVNORM=2 WVNORM=0
|
|
..;
|
|
..S ^TMP("WV",$J,WVDFN,WVNORM,WVPCDN,WVIEN)=""
|
|
..I WVPCDN=1 D
|
|
...S WVJPAPR=$P($G(^WV(790,WVDFN,0)),U,16)
|
|
...I WVJPAPR'>0 S WVJPAPR="NOT SPECIFIED"
|
|
...E S WVJPAPR=$P($G(^WV(790.03,WVJPAPR,0)),U)
|
|
...S ^TMP("WVP",$J,WVJPAPR,WVDFN,WVNORM,WVPCDN,WVIEN)=""
|
|
..I WVPCDN=28 D
|
|
...S WVJ=$O(WVAGRG(WVAGE))
|
|
...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")
|
|
...S ^TMP("WVP",$J,WVJAGER,WVDFN,WVNORM,WVPCDN,WVIEN)=""
|
|
;
|
|
;---> NOW COLLATE DATA FROM ^TMP ARRAY INTO LOCAL WVTMP REPORT ARRAY.
|
|
;---> FIRST, SEED LOCAL ARRAY WITH ZEROS.
|
|
F M=1,28 D
|
|
.N I F I=1:1:5 S WVTMP("RES",M,I)=0
|
|
;
|
|
;---> COLLATE DATA.
|
|
S N=0
|
|
F S N=$O(^TMP("WV",$J,N)) Q:'N D
|
|
.F M=1,28 D
|
|
..Q:$D(^TMP("WV",$J,N,1,M))
|
|
..S P=0,Q=0
|
|
..F S P=$O(^TMP("WV",$J,N,0,M,P)) Q:'P S Q=Q+1
|
|
..Q:'Q
|
|
..I '$D(WVTMP("RES",M,Q)) S WVTMP("RES",M,Q)=1 Q
|
|
..S WVTMP("RES",M,Q)=WVTMP("RES",M,Q)+1
|
|
;
|
|
;---> STORE ALL NODES >5 IN THE 5+ NODE.
|
|
F M=1,28 D
|
|
.S Q=5
|
|
.F S Q=$O(WVTMP("RES",M,Q)) Q:'Q D
|
|
..S WVTMP("RES",M,5)=WVTMP("RES",M,5)+WVTMP("RES",M,Q)
|
|
..K WVTMP("RES",M,Q)
|
|
;
|
|
;---> FIGURE PERCENTAGES OF WOMEN AND STORE IN ARRAY.
|
|
F M=1,28 D
|
|
.F Q=1:1:5 S $P(WVTMP("RES",M,Q),U,2)=$J((+WVTMP("RES",M,Q)/WVTOT),0,2)
|
|
;
|
|
;---> BUILD DISPLAY ARRAY.
|
|
N WVNODE K ^TMP("WV",$J)
|
|
;
|
|
;---> PAPS SUBHEADER LINE.
|
|
S WVNODE=$$S(40)_"SCREENING PAPS"
|
|
D WRITE(1,WVNODE)
|
|
S WVNODE=$$S(39)_"----------------"
|
|
D WRITE(2,WVNODE)
|
|
S WVNODE=" # of PAPs: 1 2 3 4 5+"
|
|
D WRITE(4,WVNODE)
|
|
S WVNODE=" ----------- ----- ----- ----- ----- -----"
|
|
D WRITE(5,WVNODE)
|
|
;
|
|
;---> PAPS NUMBER OF WOMEN DATA LINE.
|
|
S WVNODE=" # of Women: "
|
|
F Q=1:1:5 S WVNODE=WVNODE_$J($P(WVTMP("RES",1,Q),U),6)
|
|
D WRITE(6,WVNODE)
|
|
S WVNODE=" % of Women: "
|
|
F Q=1:1:5 S WVNODE=WVNODE_$J(($P(WVTMP("RES",1,Q),U,2)*100),5)_"%"
|
|
D WRITE(7,WVNODE)
|
|
;
|
|
;---> LINE FEEDS BETWEEN PAPS AND MAMS.
|
|
S WVNODE="" D WRITE(8,WVNODE) S WVNODE="" D WRITE(9,WVNODE)
|
|
;
|
|
;---> MAMS SUBHEADER LINE.
|
|
S WVNODE=$$S(40)_"SCREENING MAMS"
|
|
D WRITE(10,WVNODE)
|
|
S WVNODE=$$S(39)_"----------------"
|
|
D WRITE(11,WVNODE)
|
|
S WVNODE=" # of MAMs: 1 2 3 4 5+"
|
|
D WRITE(13,WVNODE)
|
|
S WVNODE=" ----------- ----- ----- ----- ----- -----"
|
|
D WRITE(14,WVNODE)
|
|
;
|
|
;---> PAPS NUMBER OF WOMEN DATA LINE.
|
|
S WVNODE=" # of Women: "
|
|
F Q=1:1:5 S WVNODE=WVNODE_$J($P(WVTMP("RES",28,Q),U),6)
|
|
D WRITE(15,WVNODE)
|
|
S WVNODE=" % of Women: "
|
|
F Q=1:1:5 S WVNODE=WVNODE_$J(($P(WVTMP("RES",28,Q),U,2)*100),5)_"%"
|
|
D WRITE(16,WVNODE)
|
|
Q
|
|
;
|
|
WRITE(I,Y) ;EP
|
|
S ^TMP("WV",$J,I,0)=Y
|
|
Q
|
|
;
|
|
S(S) ;EP
|
|
;---> SPACES.
|
|
Q $$S^WVUTL7($G(S))
|
|
;
|
|
;
|
|
AGERNG(WVAGRG,WVPOP) ;EP
|
|
;---> ASK AGE RANGE.
|
|
;---> RETURN AGE RANGE IN WVAGRG.
|
|
N DIR,DIRUT,Y S WVPOP=0
|
|
W !!?3,"Do you wish to limit this report to an age range?"
|
|
S DIR(0)="Y",DIR("B")="NO" D HELP1
|
|
S DIR("A")=" Enter Yes or No"
|
|
D ^DIR K DIR W !
|
|
S:$D(DIRUT) WVPOP=1
|
|
;---> IF NOT DISPLAYING BY AGE RANGE, SET WVAGRG (AGE RANGE)=1, QUIT.
|
|
I 'Y S WVAGRG=1 Q
|
|
BYAGE1 ;
|
|
W !?5,"Enter the age range you wish to select in the form of: 40-75"
|
|
W !?5,"Use a dash ""-"" to separate the limits of the range."
|
|
W !?5,"To select only one age, simply enter that age, with no dash."
|
|
W !?5,"(NOTE: Patient ages will reflect the age they are today.)",!
|
|
K DIR
|
|
S DIR(0)="FOA",DIR("A")=" Enter age range: "
|
|
S:$D(^WV(790.72,DUZ,0)) DIR("B")=$P(^(0),U,3)
|
|
D ^DIR K DIR
|
|
I $D(DIRUT) S WVPOP=1 Q
|
|
D CHECK(.Y)
|
|
I Y="" D G BYAGE1
|
|
.W !!?5,"* INVALID AGE RANGE. Please begin again."
|
|
;---> WVAGRG=SELECTED AGE RANGE(S).
|
|
S WVAGRG=Y
|
|
D DIC^WVFMAN(790.72,"L",.Y,"","","","`"_DUZ)
|
|
Q:Y<0
|
|
D DIE^WVFMAN(790.72,".03////"_WVAGRG,+Y,.WVPOP,1)
|
|
Q
|
|
;
|
|
HELP1 ;EP
|
|
;;Answer "YES" to display screening rates for a specific age range.
|
|
;;If you choose to display for an age range, you will be given the
|
|
;;opportunity to select the age range. For example, you might choose
|
|
;;to display from ages 50-75.
|
|
;;Answer "NO" to display screening rates for all ages.
|
|
S WVTAB=5,WVLINL="HELP1" D HELPTX
|
|
Q
|
|
;
|
|
PRINTX ;EP
|
|
N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
|
|
F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
|
|
Q
|
|
;
|
|
HELPTX ;EP
|
|
;---> CREATES DIR ARRAY FOR DIR. REQUIRED VARIABLES: WVTAB,WVLINL.
|
|
N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
|
|
F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" S DIR("?",I)=T_$P(X,";;",2)
|
|
S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
|
|
Q
|
|
;
|
|
CHECK(X) ;EP
|
|
;---> CHECK SYNTAX OF AGE RANGE STRING.
|
|
;---> IF X=ONE AGE ONLY, SET IT IN THE FORM X-X AND QUIT.
|
|
I X?1N.N S X=X_"-"_X Q
|
|
;
|
|
N FAIL,I,Y1,Y2
|
|
S FAIL=0
|
|
;---> CHECK EACH RANGE.
|
|
S Y1=$P(X,"-"),Y2=$P(X,"-",2)
|
|
;---> EACH END OF EACH RANGE SHOULD BE A NUMBER.
|
|
I (Y1'?1N.N)!(Y2'?1N.N) S X="" Q
|
|
;---> THE LOWER NUMBER SHOULD BE FIRST.
|
|
I Y2<Y1 S FAIL=1
|
|
I FAIL S X="" Q
|
|
Q
|