BWRPPCD1 ;IHS/ANMC/MWR - REPORT: PROCEDURE STATISTICS;15-Feb-2003 22:09;PLS
;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; DISPLAY CODE FOR PROCEDURE STATISTICS REPORT. CALLED BY BWRPPCD.
;
DISPLAY ;EP
;---> BWTITLE=TITLE AT TOP OF DISPLAY HEADER.
;---> BWSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
;---> BWCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
;
U IO
S BWTITLE="* * * WOMEN'S HEALTH: PROCEDURE STATISTICS REPORT * * *"
D CENTERT^BWUTL5(.BWTITLE)
S BWSUBH="SUBHEAD^BWRPPCD1"
D TOPHEAD^BWUTL7
S (BWPOP,N)=0
;
DISPLAY1 ;EP
D HEADER3^BWUTL7
I '$D(BWAR) D Q
.W !!?5,"No records match the selected criteria.",!
.D ENDREP^BWUTL7()
F S N=$O(BWAR(N)) Q:N=""!(BWPOP) D
.I $Y+10>IOSL D:BWCRT DIRZ^BWUTL3 Q:BWPOP D
..S BWPAGE=BWPAGE+1
..D HEADER3^BWUTL7
.S Y=BWAR(N)
.S BWAGRP=$$BWAGRP($P(Y,U,16))
.;---> QUIT IF DISPLAYING "ALL AGES" ONLY (NOT GROUPED BY AGE).
.Q:BWAGRP=1
.S BWPCD="< "_$P(Y,U)_": "_BWAGRP_" >",BWPCDL=$L(BWPCD)
.S X=$E(BWLINE,1,31-(BWPCDL/2))
.W !!?8,X,BWPCD,X
.D VERTICAL
D ENDREP^BWUTL7()
Q
;
;
VERTICAL ;EP
;---> DISPLAY IN VERTICAL FORMAT.
W !!?23,"NORMAL:",?35,$J($P(Y,U,4),5),?42,"(",$J($P(Y,U,5),3),"%)"
W !?8,"PROCEDURES"
W ?23,"ABNORMAL:",?35,$J($P(Y,U,8),5),?42,"(",$J($P(Y,U,9),3),"%)"
W !?23,"NO RESULT:",?35,$J($P(Y,U,12),5),?42,"(",$J($P(Y,U,13),3),"%)"
W !?23,"TOTAL:",?35,$J($P(Y,U,15),5)
W !!?23,"NORMAL:",?35,$J($P(Y,U,2),5),?42,"(",$J($P(Y,U,3),3),"%)"
W ?51,"Patients may be"
W !?8,"PATIENTS"
W ?23,"ABNORMAL:",?35,$J($P(Y,U,6),5),?42,"(",$J($P(Y,U,7),3),"%)"
W ?51,"included in more"
W !?23,"NO RESULT:",?35,$J($P(Y,U,10),5),?42,"(",$J($P(Y,U,11),3),"%)"
W ?51,"than one category."
W !?23,"TOTAL:",?35,$J($P(Y,U,14),5),!
Q
;
HORIZ ;EP
;---> NOT USED CURRENTLY: DISPLAY IN HORIZONTAL FORMAT.
W !!?2,"NORMAL",?15,"NORMAL",?28,"ABNORMAL",?41,"ABNORMAL"
W ?54,"NO RESULT",?67,"NO RESULT"
W !?2,"patients",?15,"procedures",?28,"patients",?41,"procedures"
W ?54,"patients",?67,"procedures"
S X=$E(BWLINE,1,11) W !,?2,X,?15,X,?28,X,?41,X,?54,X,?67,X
W !?2,$J($P(Y,U,2),5),"(",$P(Y,U,3),"%)"
W ?15,$J($P(Y,U,4),5),"(",$P(Y,U,5),"%)"
W ?28,$J($P(Y,U,6),5),"(",$P(Y,U,7),"%)"
W ?41,$J($P(Y,U,8),5),"(",$P(Y,U,9),"%)"
W ?54,$J($P(Y,U,10),5),"(",$P(Y,U,11),"%)"
W ?67,$J($P(Y,U,12),5),"(",$P(Y,U,13),"%)"
W !!?10,"Total Patients Receiving ",$P(Y,U),": ",$P(Y,U,14)
W !?13,"Total ",$P(Y,U)," Procedures Done: ",$P(Y,U,15),!!
Q
;
;
BWAGRP(AGE) ;EP
;Q:AGE="ALL" "All ages"
Q:AGE="ALL" $S(BWAGRP'=1:"Total for selected ages",1:"All ages")
Q:AGE=1 1
N I,X,Y,Z S X=BWAGRG
F I=1:1:$L(X,",") S Y=$P($P(X,",",I),"-",2) Q:AGE'>Y
S Z=$P($P(X,",",I),"-")
Q:AGE<Z "Under "_Y_" yrs"
Q:AGE>Y "Over "_Y_" yrs"
Q $P(X,",",I)_" yrs"
;---> PUT A FINAL CHECK IN HERE?? *COMEBACK
Q "Unknown age"
;
;
SUBHEAD ;EP
;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.
W !?5,"NOTE: Patient numbers are not intended to total. "
W "See documentation.",!
F I=1:1:80 W "="
Q
BWRPPCD1 ;IHS/ANMC/MWR - REPORT: PROCEDURE STATISTICS;15-Feb-2003 22:09;PLS
+1 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; DISPLAY CODE FOR PROCEDURE STATISTICS REPORT. CALLED BY BWRPPCD.
+4 ;
DISPLAY ;EP
+1 ;---> BWTITLE=TITLE AT TOP OF DISPLAY HEADER.
+2 ;---> BWSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
+3 ;---> BWCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
+4 ;
+5 USE IO
+6 SET BWTITLE="* * * WOMEN'S HEALTH: PROCEDURE STATISTICS REPORT * * *"
+7 DO CENTERT^BWUTL5(.BWTITLE)
+8 SET BWSUBH="SUBHEAD^BWRPPCD1"
+9 DO TOPHEAD^BWUTL7
+10 SET (BWPOP,N)=0
+11 ;
DISPLAY1 ;EP
+1 DO HEADER3^BWUTL7
+2 IF '$DATA(BWAR)
Begin DoDot:1
+3 WRITE !!?5,"No records match the selected criteria.",!
+4 DO ENDREP^BWUTL7()
End DoDot:1
QUIT
+5 FOR
SET N=$ORDER(BWAR(N))
IF N=""!(BWPOP)
QUIT
Begin DoDot:1
+6 IF $Y+10>IOSL
IF BWCRT
DO DIRZ^BWUTL3
IF BWPOP
QUIT
Begin DoDot:2
+7 SET BWPAGE=BWPAGE+1
+8 DO HEADER3^BWUTL7
End DoDot:2
+9 SET Y=BWAR(N)
+10 SET BWAGRP=$$BWAGRP($PIECE(Y,U,16))
+11 ;---> QUIT IF DISPLAYING "ALL AGES" ONLY (NOT GROUPED BY AGE).
+12 IF BWAGRP=1
QUIT
+13 SET BWPCD="< "_$PIECE(Y,U)_": "_BWAGRP_" >"
SET BWPCDL=$LENGTH(BWPCD)
+14 SET X=$EXTRACT(BWLINE,1,31-(BWPCDL/2))
+15 WRITE !!?8,X,BWPCD,X
+16 DO VERTICAL
End DoDot:1
+17 DO ENDREP^BWUTL7()
+18 QUIT
+19 ;
+20 ;
VERTICAL ;EP
+1 ;---> DISPLAY IN VERTICAL FORMAT.
+2 WRITE !!?23,"NORMAL:",?35,$JUSTIFY($PIECE(Y,U,4),5),?42,"(",$JUSTIFY($PIECE(Y,U,5),3),"%)"
+3 WRITE !?8,"PROCEDURES"
+4 WRITE ?23,"ABNORMAL:",?35,$JUSTIFY($PIECE(Y,U,8),5),?42,"(",$JUSTIFY($PIECE(Y,U,9),3),"%)"
+5 WRITE !?23,"NO RESULT:",?35,$JUSTIFY($PIECE(Y,U,12),5),?42,"(",$JUSTIFY($PIECE(Y,U,13),3),"%)"
+6 WRITE !?23,"TOTAL:",?35,$JUSTIFY($PIECE(Y,U,15),5)
+7 WRITE !!?23,"NORMAL:",?35,$JUSTIFY($PIECE(Y,U,2),5),?42,"(",$JUSTIFY($PIECE(Y,U,3),3),"%)"
+8 WRITE ?51,"Patients may be"
+9 WRITE !?8,"PATIENTS"
+10 WRITE ?23,"ABNORMAL:",?35,$JUSTIFY($PIECE(Y,U,6),5),?42,"(",$JUSTIFY($PIECE(Y,U,7),3),"%)"
+11 WRITE ?51,"included in more"
+12 WRITE !?23,"NO RESULT:",?35,$JUSTIFY($PIECE(Y,U,10),5),?42,"(",$JUSTIFY($PIECE(Y,U,11),3),"%)"
+13 WRITE ?51,"than one category."
+14 WRITE !?23,"TOTAL:",?35,$JUSTIFY($PIECE(Y,U,14),5),!
+15 QUIT
+16 ;
HORIZ ;EP
+1 ;---> NOT USED CURRENTLY: DISPLAY IN HORIZONTAL FORMAT.
+2 WRITE !!?2,"NORMAL",?15,"NORMAL",?28,"ABNORMAL",?41,"ABNORMAL"
+3 WRITE ?54,"NO RESULT",?67,"NO RESULT"
+4 WRITE !?2,"patients",?15,"procedures",?28,"patients",?41,"procedures"
+5 WRITE ?54,"patients",?67,"procedures"
+6 SET X=$EXTRACT(BWLINE,1,11)
WRITE !,?2,X,?15,X,?28,X,?41,X,?54,X,?67,X
+7 WRITE !?2,$JUSTIFY($PIECE(Y,U,2),5),"(",$PIECE(Y,U,3),"%)"
+8 WRITE ?15,$JUSTIFY($PIECE(Y,U,4),5),"(",$PIECE(Y,U,5),"%)"
+9 WRITE ?28,$JUSTIFY($PIECE(Y,U,6),5),"(",$PIECE(Y,U,7),"%)"
+10 WRITE ?41,$JUSTIFY($PIECE(Y,U,8),5),"(",$PIECE(Y,U,9),"%)"
+11 WRITE ?54,$JUSTIFY($PIECE(Y,U,10),5),"(",$PIECE(Y,U,11),"%)"
+12 WRITE ?67,$JUSTIFY($PIECE(Y,U,12),5),"(",$PIECE(Y,U,13),"%)"
+13 WRITE !!?10,"Total Patients Receiving ",$PIECE(Y,U),": ",$PIECE(Y,U,14)
+14 WRITE !?13,"Total ",$PIECE(Y,U)," Procedures Done: ",$PIECE(Y,U,15),!!
+15 QUIT
+16 ;
+17 ;
BWAGRP(AGE) ;EP
+1 ;Q:AGE="ALL" "All ages"
+2 IF AGE="ALL"
QUIT $SELECT(BWAGRP'=1:"Total for selected ages",1:"All ages")
+3 IF AGE=1
QUIT 1
+4 NEW I,X,Y,Z
SET X=BWAGRG
+5 FOR I=1:1:$LENGTH(X,",")
SET Y=$PIECE($PIECE(X,",",I),"-",2)
IF AGE'>Y
QUIT
+6 SET Z=$PIECE($PIECE(X,",",I),"-")
+7 IF AGE<Z
QUIT "Under "_Y_" yrs"
+8 IF AGE>Y
QUIT "Over "_Y_" yrs"
+9 QUIT $PIECE(X,",",I)_" yrs"
+10 ;---> PUT A FINAL CHECK IN HERE?? *COMEBACK
+11 QUIT "Unknown age"
+12 ;
+13 ;
SUBHEAD ;EP
+1 ;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.
+2 WRITE !?5,"NOTE: Patient numbers are not intended to total. "
+3 WRITE "See documentation.",!
+4 FOR I=1:1:80
WRITE "="
+5 QUIT
