Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BWRPPCD1

BWRPPCD1.m

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