- 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
