WVRPSCR ;HCIOFO/FT,JR IHS/ANMC/MWR - Display Compliance Rates ;12/9/98 13:39
;;1.0;WOMEN'S HEALTH;**3**;Sep 30, 1998
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; THIS REPORT WILL DISPLAY COMPLIANCE RATES FOR PAPS & MAMS.
;
PRINT ;EP
;
N I,J,M,N,P,Q
D SETUP
D TITLE^WVUTL5("COMPLIANCE RATES FOR PAPS AND MAMS")
D TEXT1,DIRZ^WVUTL3 G:WVPOP EXIT
D DATES G:WVPOP EXIT
D AGERNG G:WVPOP EXIT
D DEVICE G:WVPOP EXIT
D DATA^WVRPSCR1,EN^WVRPSCR2
D DISPLAY
I WVCRT&('$D(IO("S")))&('$G(WVPOP)) D DIRZ^WVUTL3 W @IOF
;
EXIT ;EP
D KILLALL^WVUTL8
Q
;
SETUP ;EP
D SETVARS^WVUTL5
Q
;
DATES ;EP
;---> ASK DATE RANGE. RETURN DATES IN WVBEGDT AND WVENDDT.
D ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP)
Q
;
AGERNG ;EP
;---> ASK AGE RANGE.
;---> RETURN AGE RANGE IN WVAGRG.
D AGERNG^WVRPSCR1(.WVAGRG,.WVPOP)
Q
;
DEVICE ;EP
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
S ZTRTN="DEQUEUE^WVRPSCR"
F WVSV="AGRG","BEGDT","ENDDT" D
.I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
;---> SAVE ATTRIBUTES ARRAY. NOTE: SUBSTITUTE LOCAL ARRAY FOR WVATT.
I $D(WVCC) N N S N=0 F S N=$O(WVCC(N)) Q:N="" D
.S ZTSAVE("WVCC("""_N_""")")=""
D ZIS^WVUTL2(.WVPOP,1,"HOME")
Q
;
;
DISPLAY ;EP
U IO
S WVTITLE="* WOMEN'S HEALTH: COMPLIANCE RATES FOR PAPS AND MAMS *"
D CENTERT^WVUTL5(.WVTITLE)
D TOPHEAD^WVUTL7
S WVPAGE=1,WVPOP=0
S WVSUB="W !?3,""For Age Range: "",$S(WVAGRG=1:""ALL"",1:WVAGRG)"
;
S (WVPOP,N,Z)=0
W:WVCRT @IOF D HEADER8^WVUTL7
F S N=$O(^TMP("WV",$J,N)) Q:'N!(WVPOP) D
.I N=16.001!(N=7.001) W ! D HDR^WVRPSCR2
.I $Y+3>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP I $O(^TMP("WV",$J,N))'="" W @IOF D HEADER8^WVUTL7 D:'WVCRT HDR^WVRPSCR2
.W !,^TMP("WV",$J,N,0)
D ^%ZISC
Q
;
DEQUEUE ;EP
;---> CALLED BY TASKMAN
D SETUP,DATA^WVRPSCR1,EN^WVRPSCR2,DISPLAY,EXIT
Q
;
TEXT1 ;
;;This report is designed to serve as an indicator of compliance
;;rates for PAPs and MAMs. The report will display the percentages
;;of women who received PAPs and MAMs for compliance 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 compliance 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 WVTAB=5,WVLINL="TEXT1" D PRINTX
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPSCR 3098 printed Sep 23, 2025@20:24:13 Page 2
WVRPSCR ;HCIOFO/FT,JR IHS/ANMC/MWR - Display Compliance Rates ;12/9/98 13:39
+1 ;;1.0;WOMEN'S HEALTH;**3**;Sep 30, 1998
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; THIS REPORT WILL DISPLAY COMPLIANCE RATES FOR PAPS & MAMS.
+4 ;
PRINT ;EP
+1 ;
+2 NEW I,J,M,N,P,Q
+3 DO SETUP
+4 DO TITLE^WVUTL5("COMPLIANCE RATES FOR PAPS AND MAMS")
+5 DO TEXT1
DO DIRZ^WVUTL3
if WVPOP
GOTO EXIT
+6 DO DATES
if WVPOP
GOTO EXIT
+7 DO AGERNG
if WVPOP
GOTO EXIT
+8 DO DEVICE
if WVPOP
GOTO EXIT
+9 DO DATA^WVRPSCR1
DO EN^WVRPSCR2
+10 DO DISPLAY
+11 IF WVCRT&('$DATA(IO("S")))&('$GET(WVPOP))
DO DIRZ^WVUTL3
WRITE @IOF
+12 ;
EXIT ;EP
+1 DO KILLALL^WVUTL8
+2 QUIT
+3 ;
SETUP ;EP
+1 DO SETVARS^WVUTL5
+2 QUIT
+3 ;
DATES ;EP
+1 ;---> ASK DATE RANGE. RETURN DATES IN WVBEGDT AND WVENDDT.
+2 DO ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP)
+3 QUIT
+4 ;
AGERNG ;EP
+1 ;---> ASK AGE RANGE.
+2 ;---> RETURN AGE RANGE IN WVAGRG.
+3 DO AGERNG^WVRPSCR1(.WVAGRG,.WVPOP)
+4 QUIT
+5 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 SET ZTRTN="DEQUEUE^WVRPSCR"
+3 FOR WVSV="AGRG","BEGDT","ENDDT"
Begin DoDot:1
+4 IF $DATA(@("WV"_WVSV))
SET ZTSAVE("WV"_WVSV)=""
End DoDot:1
+5 ;---> SAVE ATTRIBUTES ARRAY. NOTE: SUBSTITUTE LOCAL ARRAY FOR WVATT.
+6 IF $DATA(WVCC)
NEW N
SET N=0
FOR
SET N=$ORDER(WVCC(N))
if N=""
QUIT
Begin DoDot:1
+7 SET ZTSAVE("WVCC("""_N_""")")=""
End DoDot:1
+8 DO ZIS^WVUTL2(.WVPOP,1,"HOME")
+9 QUIT
+10 ;
+11 ;
DISPLAY ;EP
+1 USE IO
+2 SET WVTITLE="* WOMEN'S HEALTH: COMPLIANCE RATES FOR PAPS AND MAMS *"
+3 DO CENTERT^WVUTL5(.WVTITLE)
+4 DO TOPHEAD^WVUTL7
+5 SET WVPAGE=1
SET WVPOP=0
+6 SET WVSUB="W !?3,""For Age Range: "",$S(WVAGRG=1:""ALL"",1:WVAGRG)"
+7 ;
+8 SET (WVPOP,N,Z)=0
+9 if WVCRT
WRITE @IOF
DO HEADER8^WVUTL7
+10 FOR
SET N=$ORDER(^TMP("WV",$JOB,N))
if 'N!(WVPOP)
QUIT
Begin DoDot:1
+11 IF N=16.001!(N=7.001)
WRITE !
DO HDR^WVRPSCR2
+12 IF $Y+3>IOSL
if WVCRT
DO DIRZ^WVUTL3
if WVPOP
QUIT
IF $ORDER(^TMP("WV",$JOB,N))'=""
WRITE @IOF
DO HEADER8^WVUTL7
if 'WVCRT
DO HDR^WVRPSCR2
+13 WRITE !,^TMP("WV",$JOB,N,0)
End DoDot:1
+14 DO ^%ZISC
+15 QUIT
+16 ;
DEQUEUE ;EP
+1 ;---> CALLED BY TASKMAN
+2 DO SETUP
DO DATA^WVRPSCR1
DO EN^WVRPSCR2
DO DISPLAY
DO EXIT
+3 QUIT
+4 ;
TEXT1 ;
+1 ;;This report is designed to serve as an indicator of compliance
+2 ;;rates for PAPs and MAMs. The report will display the percentages
+3 ;;of women who received PAPs and MAMs for compliance 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 compliance 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 WVTAB=5
SET WVLINL="TEXT1"
DO PRINTX
+20 QUIT
+21 ;
PRINTX ;EP
+1 NEW I,T,X
SET T=$$REPEAT^XLFSTR(" ",WVTAB)
+2 FOR I=1:1
SET X=$TEXT(@WVLINL+I)
if X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+3 QUIT
