- 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 Feb 19, 2025@00:14:26 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
