source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVRPSNP1.m@ 1679

Last change on this file since 1679 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1WVRPSNP1 ;HCIOFO/FT,JR-REPORT: SNAPSHOT OF PROGRAM ;7/7/99 11:14
2 ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
3 ;; Original routine created by IHS/ANMC/MWR
4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
5 ;; DISPLAY CODE FOR SNAPSHOT REPORT. CALLED BY WVRPSNP.
6 ;
7 ;---> REQUIRED VARIABLES: WVDT=DATE SNAPSHOT WAS RUN.
8 ;---> WVFAC=FACILITY IEN IN ^DIC(4 - DUZ(2)
9 ;---> A-L,P,Q = FIELDS #.03-#.16 IN FILE 790.71
10 ;
11DISPLAY ;EP
12 U IO
13 S WVTOY=$S($D(WVTOY):WVTOY,1:M),WVPOP=0
14 I '$D(WVJDT) S WVJDT=$S(WVTOY="C":WVDT,$E(WVDT,4,5)>9:WVDT,1:WVDT-10000)
15 S WVJDTO=$S($G(WVTOY)="F":"Oct 1, ",1:"Jan 1, ")_($E($S($D(WVJDT):WVJDT,1:WVDT),1,3)+1700)_":"
16 S WVJTOY=$S(WVTOY="F":"Fiscal Year",1:"Calendar Year")
17 D HDR
18 ;
19 N X,Y
20 W !
21 S X="Total Active Women in Register:",Y=A D PNUM
22 S X="Women Who Are Pregnant:",Y=B D PNUM
23 ;S X="Woman Who Are DES Daughters:",Y=C D PNUM
24 S X="Women with Cervical Tx Needs not specified or not dated:",Y=D
25 D PNUM
26 S X="Women with Cervical Tx Needs specified and past due:",Y=E D PNUM
27 S X="Women with Breast Tx Needs not specified or not dated:",Y=F D PNUM
28 S X="Women with Breast Tx Needs specified and past due:",Y=G D PNUM
29 W !
30 S X="Total Number of Procedures with a Status of ""OPEN"":",Y=H D DOTS
31 S X="Number of OPEN Procedures Past Due (or not dated):",Y=S D DOTS
32 W:'WVCRT !
33 S X="Total Number of PAP Smears done since "_WVJDTO
34 S Y=P D DOTS G:WVPOP=1 EXIT
35 S X="Total Number of CBEs done since "_WVJDTO
36 S Y=R D DOTS G:WVPOP=1 EXIT
37 S X="Total Number of Mammograms done since "_WVJDTO
38 S Y=Q D DOTS G:WVPOP=1 EXIT
39 W !
40 S X="Total Number of Notifications with a Status of ""OPEN"":",Y=J
41 D DOTS G:WVPOP=1 EXIT
42 S X="Number of OPEN Notifications Past Due (or not dated):",Y=K D DOTS G:WVPOP=1 EXIT
43 S X="Number of Letters Queued (for later printing):",Y=L D DOTS G:WVPOP=1 EXIT
44 I $G(WVDTIEN)>0 S WVJX=$G(^WV(790.71,WVDTIEN,2)) D
45 .F P=1:1:30 S WVI(P)=$P(WVJX,U,P)
46 W !!," REFUSALS for TREATMENT:"
47 S X="Breast Ultrasounds:",Y=WVI(1) D DOTS G:WVPOP=1 EXIT
48 S X="Clinical Breast Exams:",Y=WVI(2) D DOTS G:WVPOP=1 EXIT
49 S X="Colposcopy Impression (No Bx):",Y=WVI(3) D DOTS G:WVPOP=1 EXIT
50 S X="Colposcopy W/Biopsy:",Y=WVI(4) D DOTS G:WVPOP=1 EXIT
51 S X="Cone Biopsy:",Y=WVI(5) D DOTS G:WVPOP=1 EXIT
52 S X="Cryotherapy:",Y=WVI(6) D DOTS G:WVPOP=1 EXIT
53 S X="Ectocervical Biopsy:",Y=WVI(7) D DOTS G:WVPOP=1 EXIT
54 S X="Endocervical Currettage:",Y=WVI(8) D DOTS G:WVPOP=1 EXIT
55 S X="Endometrial Biopsy:",Y=WVI(9) D DOTS G:WVPOP=1 EXIT
56 S X="Fine Needle Aspiration:",Y=WVI(10) D DOTS G:WVPOP=1 EXIT
57 S X="General Surgery Consults:",Y=WVI(11) D DOTS G:WVPOP=1 EXIT
58 S X="Gyn Onc Consults:",Y=WVI(12) D DOTS G:WVPOP=1 EXIT
59 S X="Hysterectomy:",Y=WVI(13) D DOTS G:WVPOP=1 EXIT
60 S X="Laser Abilation:",Y=WVI(14) D DOTS G:WVPOP=1 EXIT
61 S X="Laser Cone:",Y=WVI(15) D DOTS G:WVPOP=1 EXIT
62 S X="Leep:",Y=WVI(16) D DOTS G:WVPOP=1 EXIT
63 S X="Lumpectomy:",Y=WVI(17) D DOTS G:WVPOP=1 EXIT
64 S X="Mammogram Dx Bilat:",Y=WVI(18) D DOTS G:WVPOP=1 EXIT
65 S X="Mammogram Dx Unilat:",Y=WVI(19) D DOTS G:WVPOP=1 EXIT
66 S X="Mammogram Screening:",Y=WVI(20) D DOTS G:WVPOP=1 EXIT
67 S X="Mastectomy:",Y=WVI(21) D DOTS G:WVPOP=1 EXIT
68 S X="Needle Biopsy:",Y=WVI(22) D DOTS G:WVPOP=1 EXIT
69 S X="Open Biopsy:",Y=WVI(23) D DOTS G:WVPOP=1 EXIT
70 S X="Pap Smear:",Y=WVI(24) D DOTS G:WVPOP=1 EXIT
71 S X="Pelvic Ultrasound:",Y=WVI(29) D DOTS G:WVPOP=1 EXIT
72 S X="Pregnancy Test:",Y=WVI(25) D DOTS G:WVPOP=1 EXIT
73 S X="STD Evaluation:",Y=WVI(26) D DOTS G:WVPOP=1 EXIT
74 S X="Stereotactic Biopsy:",Y=WVI(27) D DOTS G:WVPOP=1 EXIT
75 S X="Tubal Ligation:",Y=WVI(28) D DOTS G:WVPOP=1 EXIT
76 S X="Vaginal Ultrasound:",Y=WVI(30) D DOTS G:WVPOP=1 EXIT
77SKIP D:'WVCRT
78 .N WVTITLE S WVTITLE="----- End of Report -----"
79 .D CENTERT^WVUTL5(.WVTITLE) W !!!,WVTITLE
80 I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
81 D ^%ZISC
82 Q
83 ;
84PNUM ;EP
85 ;---> PATIENT NUMBERS
86 W:'WVCRT ! W !?3,X W $$REPEAT^XLFSTR(" .",(58-$L(X))/2)
87 W ?61,".",?62,$J(Y,5) W:A>0 ?69,$J(Y/A*100,3,0),"%"
88 Q
89 ;
90DOTS ;EP
91 I $Y+4>IOSL D:WVCRT&('$D(IO("S"))) DIRZ^WVUTL3 Q:$G(WVPOP)=1 D HDR
92 W:'WVCRT ! W !?3,X W $$REPEAT^XLFSTR(" .",(58-$L(X))/2)
93 W ?61,".",?62,$J(Y,5)
94 Q
95HDR ;EP
96 S WVTITLE="* * * PROGRAM SNAPSHOT FOR "_$$TXDT^WVUTL5(WVDT)_" * * *"
97 D CENTERT^WVUTL5(.WVTITLE)
98 D TOPHEAD1^WVUTL7,HEADER6^WVUTL7
99 Q
100CH ;
101 Q:$Y+4<IOSL
102 I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
103 Q:WVPOP D HDR
104 Q
105EXIT ;
106 D ^%ZISC,KILLALL^WVUTL8 Q
107 K ^TMP("WVF",$J),^TMP("WVREF",$J)
108 Q
Note: See TracBrowser for help on using the repository browser.