WVRPSNP1 ;HCIOFO/FT,JR-REPORT: SNAPSHOT OF PROGRAM ;7/7/99 11:14
;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
;; Original routine created by IHS/ANMC/MWR
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; DISPLAY CODE FOR SNAPSHOT REPORT. CALLED BY WVRPSNP.
;
;---> REQUIRED VARIABLES: WVDT=DATE SNAPSHOT WAS RUN.
;---> WVFAC=FACILITY IEN IN ^DIC(4 - DUZ(2)
;---> A-L,P,Q = FIELDS #.03-#.16 IN FILE 790.71
;
DISPLAY ;EP
U IO
S WVTOY=$S($D(WVTOY):WVTOY,1:M),WVPOP=0
I '$D(WVJDT) S WVJDT=$S(WVTOY="C":WVDT,$E(WVDT,4,5)>9:WVDT,1:WVDT-10000)
S WVJDTO=$S($G(WVTOY)="F":"Oct 1, ",1:"Jan 1, ")_($E($S($D(WVJDT):WVJDT,1:WVDT),1,3)+1700)_":"
S WVJTOY=$S(WVTOY="F":"Fiscal Year",1:"Calendar Year")
D HDR
;
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:'WVCRT !
S X="Total Number of PAP Smears done since "_WVJDTO
S Y=P D DOTS G:WVPOP=1 EXIT
S X="Total Number of CBEs done since "_WVJDTO
S Y=R D DOTS G:WVPOP=1 EXIT
S X="Total Number of Mammograms done since "_WVJDTO
S Y=Q D DOTS G:WVPOP=1 EXIT
W !
S X="Total Number of Notifications with a Status of ""OPEN"":",Y=J
D DOTS G:WVPOP=1 EXIT
S X="Number of OPEN Notifications Past Due (or not dated):",Y=K D DOTS G:WVPOP=1 EXIT
S X="Number of Letters Queued (for later printing):",Y=L D DOTS G:WVPOP=1 EXIT
I $G(WVDTIEN)>0 S WVJX=$G(^WV(790.71,WVDTIEN,2)) D
.F P=1:1:30 S WVI(P)=$P(WVJX,U,P)
W !!," REFUSALS for TREATMENT:"
S X="Breast Ultrasounds:",Y=WVI(1) D DOTS G:WVPOP=1 EXIT
S X="Clinical Breast Exams:",Y=WVI(2) D DOTS G:WVPOP=1 EXIT
S X="Colposcopy Impression (No Bx):",Y=WVI(3) D DOTS G:WVPOP=1 EXIT
S X="Colposcopy W/Biopsy:",Y=WVI(4) D DOTS G:WVPOP=1 EXIT
S X="Cone Biopsy:",Y=WVI(5) D DOTS G:WVPOP=1 EXIT
S X="Cryotherapy:",Y=WVI(6) D DOTS G:WVPOP=1 EXIT
S X="Ectocervical Biopsy:",Y=WVI(7) D DOTS G:WVPOP=1 EXIT
S X="Endocervical Currettage:",Y=WVI(8) D DOTS G:WVPOP=1 EXIT
S X="Endometrial Biopsy:",Y=WVI(9) D DOTS G:WVPOP=1 EXIT
S X="Fine Needle Aspiration:",Y=WVI(10) D DOTS G:WVPOP=1 EXIT
S X="General Surgery Consults:",Y=WVI(11) D DOTS G:WVPOP=1 EXIT
S X="Gyn Onc Consults:",Y=WVI(12) D DOTS G:WVPOP=1 EXIT
S X="Hysterectomy:",Y=WVI(13) D DOTS G:WVPOP=1 EXIT
S X="Laser Abilation:",Y=WVI(14) D DOTS G:WVPOP=1 EXIT
S X="Laser Cone:",Y=WVI(15) D DOTS G:WVPOP=1 EXIT
S X="Leep:",Y=WVI(16) D DOTS G:WVPOP=1 EXIT
S X="Lumpectomy:",Y=WVI(17) D DOTS G:WVPOP=1 EXIT
S X="Mammogram Dx Bilat:",Y=WVI(18) D DOTS G:WVPOP=1 EXIT
S X="Mammogram Dx Unilat:",Y=WVI(19) D DOTS G:WVPOP=1 EXIT
S X="Mammogram Screening:",Y=WVI(20) D DOTS G:WVPOP=1 EXIT
S X="Mastectomy:",Y=WVI(21) D DOTS G:WVPOP=1 EXIT
S X="Needle Biopsy:",Y=WVI(22) D DOTS G:WVPOP=1 EXIT
S X="Open Biopsy:",Y=WVI(23) D DOTS G:WVPOP=1 EXIT
S X="Pap Smear:",Y=WVI(24) D DOTS G:WVPOP=1 EXIT
S X="Pelvic Ultrasound:",Y=WVI(29) D DOTS G:WVPOP=1 EXIT
S X="Pregnancy Test:",Y=WVI(25) D DOTS G:WVPOP=1 EXIT
S X="STD Evaluation:",Y=WVI(26) D DOTS G:WVPOP=1 EXIT
S X="Stereotactic Biopsy:",Y=WVI(27) D DOTS G:WVPOP=1 EXIT
S X="Tubal Ligation:",Y=WVI(28) D DOTS G:WVPOP=1 EXIT
S X="Vaginal Ultrasound:",Y=WVI(30) D DOTS G:WVPOP=1 EXIT
SKIP D:'WVCRT
.N WVTITLE S WVTITLE="----- End of Report -----"
.D CENTERT^WVUTL5(.WVTITLE) W !!!,WVTITLE
I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
D ^%ZISC
Q
;
PNUM ;EP
;---> PATIENT NUMBERS
W:'WVCRT ! W !?3,X W $$REPEAT^XLFSTR(" .",(58-$L(X))/2)
W ?61,".",?62,$J(Y,5) W:A>0 ?69,$J(Y/A*100,3,0),"%"
Q
;
DOTS ;EP
I $Y+4>IOSL D:WVCRT&('$D(IO("S"))) DIRZ^WVUTL3 Q:$G(WVPOP)=1 D HDR
W:'WVCRT ! W !?3,X W $$REPEAT^XLFSTR(" .",(58-$L(X))/2)
W ?61,".",?62,$J(Y,5)
Q
HDR ;EP
S WVTITLE="* * * PROGRAM SNAPSHOT FOR "_$$TXDT^WVUTL5(WVDT)_" * * *"
D CENTERT^WVUTL5(.WVTITLE)
D TOPHEAD1^WVUTL7,HEADER6^WVUTL7
Q
CH ;
Q:$Y+4<IOSL
I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
Q:WVPOP D HDR
Q
EXIT ;
D ^%ZISC,KILLALL^WVUTL8 Q
K ^TMP("WVF",$J),^TMP("WVREF",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPSNP1 4571 printed Sep 23, 2025@20:24:17 Page 2
WVRPSNP1 ;HCIOFO/FT,JR-REPORT: SNAPSHOT OF PROGRAM ;7/7/99 11:14
+1 ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
+2 ;; Original routine created by IHS/ANMC/MWR
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; DISPLAY CODE FOR SNAPSHOT REPORT. CALLED BY WVRPSNP.
+5 ;
+6 ;---> REQUIRED VARIABLES: WVDT=DATE SNAPSHOT WAS RUN.
+7 ;---> WVFAC=FACILITY IEN IN ^DIC(4 - DUZ(2)
+8 ;---> A-L,P,Q = FIELDS #.03-#.16 IN FILE 790.71
+9 ;
DISPLAY ;EP
+1 USE IO
+2 SET WVTOY=$SELECT($DATA(WVTOY):WVTOY,1:M)
SET WVPOP=0
+3 IF '$DATA(WVJDT)
SET WVJDT=$SELECT(WVTOY="C":WVDT,$EXTRACT(WVDT,4,5)>9:WVDT,1:WVDT-10000)
+4 SET WVJDTO=$SELECT($GET(WVTOY)="F":"Oct 1, ",1:"Jan 1, ")_($EXTRACT($SELECT($DATA(WVJDT):WVJDT,1:WVDT),1,3)+1700)_":"
+5 SET WVJTOY=$SELECT(WVTOY="F":"Fiscal Year",1:"Calendar Year")
+6 DO HDR
+7 ;
+8 NEW X,Y
+9 WRITE !
+10 SET X="Total Active Women in Register:"
SET Y=A
DO PNUM
+11 SET X="Women Who Are Pregnant:"
SET Y=B
DO PNUM
+12 ;S X="Woman Who Are DES Daughters:",Y=C D PNUM
+13 SET X="Women with Cervical Tx Needs not specified or not dated:"
SET Y=D
+14 DO PNUM
+15 SET X="Women with Cervical Tx Needs specified and past due:"
SET Y=E
DO PNUM
+16 SET X="Women with Breast Tx Needs not specified or not dated:"
SET Y=F
DO PNUM
+17 SET X="Women with Breast Tx Needs specified and past due:"
SET Y=G
DO PNUM
+18 WRITE !
+19 SET X="Total Number of Procedures with a Status of ""OPEN"":"
SET Y=H
DO DOTS
+20 SET X="Number of OPEN Procedures Past Due (or not dated):"
SET Y=S
DO DOTS
+21 if 'WVCRT
WRITE !
+22 SET X="Total Number of PAP Smears done since "_WVJDTO
+23 SET Y=P
DO DOTS
if WVPOP=1
GOTO EXIT
+24 SET X="Total Number of CBEs done since "_WVJDTO
+25 SET Y=R
DO DOTS
if WVPOP=1
GOTO EXIT
+26 SET X="Total Number of Mammograms done since "_WVJDTO
+27 SET Y=Q
DO DOTS
if WVPOP=1
GOTO EXIT
+28 WRITE !
+29 SET X="Total Number of Notifications with a Status of ""OPEN"":"
SET Y=J
+30 DO DOTS
if WVPOP=1
GOTO EXIT
+31 SET X="Number of OPEN Notifications Past Due (or not dated):"
SET Y=K
DO DOTS
if WVPOP=1
GOTO EXIT
+32 SET X="Number of Letters Queued (for later printing):"
SET Y=L
DO DOTS
if WVPOP=1
GOTO EXIT
+33 IF $GET(WVDTIEN)>0
SET WVJX=$GET(^WV(790.71,WVDTIEN,2))
Begin DoDot:1
+34 FOR P=1:1:30
SET WVI(P)=$PIECE(WVJX,U,P)
End DoDot:1
+35 WRITE !!," REFUSALS for TREATMENT:"
+36 SET X="Breast Ultrasounds:"
SET Y=WVI(1)
DO DOTS
if WVPOP=1
GOTO EXIT
+37 SET X="Clinical Breast Exams:"
SET Y=WVI(2)
DO DOTS
if WVPOP=1
GOTO EXIT
+38 SET X="Colposcopy Impression (No Bx):"
SET Y=WVI(3)
DO DOTS
if WVPOP=1
GOTO EXIT
+39 SET X="Colposcopy W/Biopsy:"
SET Y=WVI(4)
DO DOTS
if WVPOP=1
GOTO EXIT
+40 SET X="Cone Biopsy:"
SET Y=WVI(5)
DO DOTS
if WVPOP=1
GOTO EXIT
+41 SET X="Cryotherapy:"
SET Y=WVI(6)
DO DOTS
if WVPOP=1
GOTO EXIT
+42 SET X="Ectocervical Biopsy:"
SET Y=WVI(7)
DO DOTS
if WVPOP=1
GOTO EXIT
+43 SET X="Endocervical Currettage:"
SET Y=WVI(8)
DO DOTS
if WVPOP=1
GOTO EXIT
+44 SET X="Endometrial Biopsy:"
SET Y=WVI(9)
DO DOTS
if WVPOP=1
GOTO EXIT
+45 SET X="Fine Needle Aspiration:"
SET Y=WVI(10)
DO DOTS
if WVPOP=1
GOTO EXIT
+46 SET X="General Surgery Consults:"
SET Y=WVI(11)
DO DOTS
if WVPOP=1
GOTO EXIT
+47 SET X="Gyn Onc Consults:"
SET Y=WVI(12)
DO DOTS
if WVPOP=1
GOTO EXIT
+48 SET X="Hysterectomy:"
SET Y=WVI(13)
DO DOTS
if WVPOP=1
GOTO EXIT
+49 SET X="Laser Abilation:"
SET Y=WVI(14)
DO DOTS
if WVPOP=1
GOTO EXIT
+50 SET X="Laser Cone:"
SET Y=WVI(15)
DO DOTS
if WVPOP=1
GOTO EXIT
+51 SET X="Leep:"
SET Y=WVI(16)
DO DOTS
if WVPOP=1
GOTO EXIT
+52 SET X="Lumpectomy:"
SET Y=WVI(17)
DO DOTS
if WVPOP=1
GOTO EXIT
+53 SET X="Mammogram Dx Bilat:"
SET Y=WVI(18)
DO DOTS
if WVPOP=1
GOTO EXIT
+54 SET X="Mammogram Dx Unilat:"
SET Y=WVI(19)
DO DOTS
if WVPOP=1
GOTO EXIT
+55 SET X="Mammogram Screening:"
SET Y=WVI(20)
DO DOTS
if WVPOP=1
GOTO EXIT
+56 SET X="Mastectomy:"
SET Y=WVI(21)
DO DOTS
if WVPOP=1
GOTO EXIT
+57 SET X="Needle Biopsy:"
SET Y=WVI(22)
DO DOTS
if WVPOP=1
GOTO EXIT
+58 SET X="Open Biopsy:"
SET Y=WVI(23)
DO DOTS
if WVPOP=1
GOTO EXIT
+59 SET X="Pap Smear:"
SET Y=WVI(24)
DO DOTS
if WVPOP=1
GOTO EXIT
+60 SET X="Pelvic Ultrasound:"
SET Y=WVI(29)
DO DOTS
if WVPOP=1
GOTO EXIT
+61 SET X="Pregnancy Test:"
SET Y=WVI(25)
DO DOTS
if WVPOP=1
GOTO EXIT
+62 SET X="STD Evaluation:"
SET Y=WVI(26)
DO DOTS
if WVPOP=1
GOTO EXIT
+63 SET X="Stereotactic Biopsy:"
SET Y=WVI(27)
DO DOTS
if WVPOP=1
GOTO EXIT
+64 SET X="Tubal Ligation:"
SET Y=WVI(28)
DO DOTS
if WVPOP=1
GOTO EXIT
+65 SET X="Vaginal Ultrasound:"
SET Y=WVI(30)
DO DOTS
if WVPOP=1
GOTO EXIT
SKIP if 'WVCRT
Begin DoDot:1
+1 NEW WVTITLE
SET WVTITLE="----- End of Report -----"
+2 DO CENTERT^WVUTL5(.WVTITLE)
WRITE !!!,WVTITLE
End DoDot:1
+3 IF WVCRT&('$DATA(IO("S")))
DO DIRZ^WVUTL3
WRITE @IOF
+4 DO ^%ZISC
+5 QUIT
+6 ;
PNUM ;EP
+1 ;---> PATIENT NUMBERS
+2 if 'WVCRT
WRITE !
WRITE !?3,X
WRITE $$REPEAT^XLFSTR(" .",(58-$LENGTH(X))/2)
+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 $Y+4>IOSL
if WVCRT&('$DATA(IO("S")))
DO DIRZ^WVUTL3
if $GET(WVPOP)=1
QUIT
DO HDR
+2 if 'WVCRT
WRITE !
WRITE !?3,X
WRITE $$REPEAT^XLFSTR(" .",(58-$LENGTH(X))/2)
+3 WRITE ?61,".",?62,$JUSTIFY(Y,5)
+4 QUIT
HDR ;EP
+1 SET WVTITLE="* * * PROGRAM SNAPSHOT FOR "_$$TXDT^WVUTL5(WVDT)_" * * *"
+2 DO CENTERT^WVUTL5(.WVTITLE)
+3 DO TOPHEAD1^WVUTL7
DO HEADER6^WVUTL7
+4 QUIT
CH ;
+1 if $Y+4<IOSL
QUIT
+2 IF WVCRT&('$DATA(IO("S")))
DO DIRZ^WVUTL3
WRITE @IOF
+3 if WVPOP
QUIT
DO HDR
+4 QUIT
EXIT ;
+1 DO ^%ZISC
DO KILLALL^WVUTL8
QUIT
+2 KILL ^TMP("WVF",$JOB),^TMP("WVREF",$JOB)
+3 QUIT
