BWRPSNP1 ;IHS/ANMC/MWR - REPORT: SNAPSHOT OF PROGRAM [ 12/17/98 3:46 PM ];15-Feb-2003 22:10;PLS
;;2.0;WOMEN'S HEALTH;**4,8**;MAY 16, 1996
;IHS/CMI/LAB - removed hard coded year Y2K patch 4
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; DISPLAY CODE FOR SNAPSHOT REPORT. CALLED BY BWRPSNP.
;
;---> REQUIRED VARIABLES: BWDT=DATE SNAPSHOT WAS RUN.
;---> BWFAC=FACILITY IEN IN ^DIC(4 - DUZ(2)
;---> A-L,P,Q = FIELDS #.03-#.16 IN FILE 9002086.71
;
DISPLAY ;EP
U IO
S BWTITLE="* * * PROGRAM SNAPSHOT FOR "_$$TXDT^BWUTL5(BWDT)_" * * *"
D CENTERT^BWUTL5(.BWTITLE),TOPHEAD^BWUTL7,HEADER6^BWUTL7
;
N X,Y
W !
S X="Total Active Women in Register:",Y=A D PNUM
S X="Women Who Are Pregnant:",Y=B D PNUM
;S X="Woman Who Are DES Daughters:",Y=C D PNUM
S X="Women with Cervical Tx Needs not specified or not dated:",Y=D
D PNUM
S X="Women with Cervical Tx Needs specified and past due:",Y=E D PNUM
S X="Women with Breast Tx Needs not specified or not dated:",Y=F D PNUM
S X="Women with Breast Tx Needs specified and past due:",Y=G D PNUM
W !
S X="Total Number of Procedures with a Status of ""OPEN"":",Y=H D DOTS
S X="Number of OPEN Procedures Past Due (or not dated):",Y=S D DOTS
W:'BWCRT !
;beginning Y2K IHS/CMI/LAB
;S X="Total Number of PAP Smears done since Jan 1, 19"_$E(BWDT,2,3)_":" ;Y2000 IHS/CMI/LAB
S X="Total Number of PAP Smears done since Jan 1, "_(1700+$E(BWDT,1,3))_":" ;Y2000 IHS/CMI/LAB
S Y=P D DOTS
;S X="Total Number of CBEs done since Jan 1, 19"_$E(BWDT,2,3)_":" ;Y2000 IHS/CMI/LAB
S X="Total Number of CBEs done since Jan 1, "_(1700+$E(BWDT,1,3))_":" ;Y2000 IHS/CMI/LAB
S Y=R D DOTS
;S X="Total Number of Mammograms done since Jan 1, 19"_$E(BWDT,2,3)_":" ;Y2000 IHS/CMI/LAB
S X="Total Number of Mammograms done since Jan 1, "_(1700+$E(BWDT,1,3))_":" ;Y2000 IHS/CMI/LAB
;end Y2K IHS/CMI/LAB
S Y=Q D DOTS
W !
S X="Total Number of Notifications with a Status of ""OPEN"":",Y=J
D DOTS
S X="Number of OPEN Notifications Past Due (or not dated):",Y=K D DOTS
S X="Number of Letters Queued (for later printing):",Y=L D DOTS
;
D:'BWCRT
.N BWTITLE S BWTITLE="----- End of Report -----"
.D CENTERT^BWUTL5(.BWTITLE) W !!!,BWTITLE,@IOF
I BWCRT&('$D(IO("S"))) D DIRZ^BWUTL3 W @IOF
D ^%ZISC
Q
;
PNUM ;EP
;---> PATIENT NUMBERS
W:'BWCRT ! W !?3,X F I=1:1:(58-$L(X))/2 W " ."
W ?61,".",?62,$J(Y,5) W:A>0 ?69,$J(Y/A*100,3,0),"%"
Q
;
DOTS ;EP
W:'BWCRT ! W !?3,X F I=1:1:(58-$L(X))/2 W " ."
W ?61,".",?62,$J(Y,5)
Q
BWRPSNP1 ;IHS/ANMC/MWR - REPORT: SNAPSHOT OF PROGRAM [ 12/17/98 3:46 PM ];15-Feb-2003 22:10;PLS
+1 ;;2.0;WOMEN'S HEALTH;**4,8**;MAY 16, 1996
+2 ;IHS/CMI/LAB - removed hard coded year Y2K patch 4
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; DISPLAY CODE FOR SNAPSHOT REPORT. CALLED BY BWRPSNP.
+5 ;
+6 ;---> REQUIRED VARIABLES: BWDT=DATE SNAPSHOT WAS RUN.
+7 ;---> BWFAC=FACILITY IEN IN ^DIC(4 - DUZ(2)
+8 ;---> A-L,P,Q = FIELDS #.03-#.16 IN FILE 9002086.71
+9 ;
DISPLAY ;EP
+1 USE IO
+2 SET BWTITLE="* * * PROGRAM SNAPSHOT FOR "_$$TXDT^BWUTL5(BWDT)_" * * *"
+3 DO CENTERT^BWUTL5(.BWTITLE)
DO TOPHEAD^BWUTL7
DO HEADER6^BWUTL7
+4 ;
+5 NEW X,Y
+6 WRITE !
+7 SET X="Total Active Women in Register:"
SET Y=A
DO PNUM
+8 SET X="Women Who Are Pregnant:"
SET Y=B
DO PNUM
+9 ;S X="Woman Who Are DES Daughters:",Y=C D PNUM
+10 SET X="Women with Cervical Tx Needs not specified or not dated:"
SET Y=D
+11 DO PNUM
+12 SET X="Women with Cervical Tx Needs specified and past due:"
SET Y=E
DO PNUM
+13 SET X="Women with Breast Tx Needs not specified or not dated:"
SET Y=F
DO PNUM
+14 SET X="Women with Breast Tx Needs specified and past due:"
SET Y=G
DO PNUM
+15 WRITE !
+16 SET X="Total Number of Procedures with a Status of ""OPEN"":"
SET Y=H
DO DOTS
+17 SET X="Number of OPEN Procedures Past Due (or not dated):"
SET Y=S
DO DOTS
+18 IF 'BWCRT
WRITE !
+19 ;beginning Y2K IHS/CMI/LAB
+20 ;S X="Total Number of PAP Smears done since Jan 1, 19"_$E(BWDT,2,3)_":" ;Y2000 IHS/CMI/LAB
+21 ;Y2000 IHS/CMI/LAB
SET X="Total Number of PAP Smears done since Jan 1, "_(1700+$EXTRACT(BWDT,1,3))_":"
+22 SET Y=P
DO DOTS
+23 ;S X="Total Number of CBEs done since Jan 1, 19"_$E(BWDT,2,3)_":" ;Y2000 IHS/CMI/LAB
+24 ;Y2000 IHS/CMI/LAB
SET X="Total Number of CBEs done since Jan 1, "_(1700+$EXTRACT(BWDT,1,3))_":"
+25 SET Y=R
DO DOTS
+26 ;S X="Total Number of Mammograms done since Jan 1, 19"_$E(BWDT,2,3)_":" ;Y2000 IHS/CMI/LAB
+27 ;Y2000 IHS/CMI/LAB
SET X="Total Number of Mammograms done since Jan 1, "_(1700+$EXTRACT(BWDT,1,3))_":"
+28 ;end Y2K IHS/CMI/LAB
+29 SET Y=Q
DO DOTS
+30 WRITE !
+31 SET X="Total Number of Notifications with a Status of ""OPEN"":"
SET Y=J
+32 DO DOTS
+33 SET X="Number of OPEN Notifications Past Due (or not dated):"
SET Y=K
DO DOTS
+34 SET X="Number of Letters Queued (for later printing):"
SET Y=L
DO DOTS
+35 ;
+36 IF 'BWCRT
Begin DoDot:1
+37 NEW BWTITLE
SET BWTITLE="----- End of Report -----"
+38 DO CENTERT^BWUTL5(.BWTITLE)
WRITE !!!,BWTITLE,@IOF
End DoDot:1
+39 IF BWCRT&('$DATA(IO("S")))
DO DIRZ^BWUTL3
WRITE @IOF
+40 DO ^%ZISC
+41 QUIT
+42 ;
PNUM ;EP
+1 ;---> PATIENT NUMBERS
+2 IF 'BWCRT
WRITE !
WRITE !?3,X
FOR I=1:1:(58-$LENGTH(X))/2
WRITE " ."
+3 WRITE ?61,".",?62,$JUSTIFY(Y,5)
IF A>0
WRITE ?69,$JUSTIFY(Y/A*100,3,0),"%"
+4 QUIT
+5 ;
DOTS ;EP
+1 IF 'BWCRT
WRITE !
WRITE !?3,X
FOR I=1:1:(58-$LENGTH(X))/2
WRITE " ."
+2 WRITE ?61,".",?62,$JUSTIFY(Y,5)
+3 QUIT
