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

BWGRVL3.m

Go to the documentation of this file.
  1. BWGRVL3 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ; [ 08/16/01 3:48 PM ]
  1. ;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996
  1. ;
  1. ;
  1. ;IHS/CMI/LAB - modified file number
  1. TITLE ;EP
  1. Q:"FTC"[BWGRCTYP
  1. K DIR,X,Y S DIR(0)="Y",DIR("A")="Would you like a custom title for this report",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) S BWGRQUIT=1 Q
  1. Q:Y=0
  1. S BWGRLENG=$S(BWGRTCW:BWGRTCW-8,1:60)
  1. I Y=1 K DIR,X,Y S DIR(0)="F^3:"_BWGRLENG,DIR("A")="Enter custom title",DIR("?")=" Enter from 3 to "_BWGRLENG_" characters" D ^DIR K DIR
  1. G:$D(DIRUT) TITLE
  1. S BWGRTITL=Y
  1. Q
  1. SAVE ;EP
  1. Q:$D(BWGRCAND) ;--- don't ask if already a pre-defined rpt
  1. Q:BWGRCTYP'="D" ;--- must be a detailed report to be saved
  1. S BWGRSAVE=""
  1. K DIR,X,Y S DIR(0)="Y",DIR("A")="Do you wish to SAVE this "_$S('$D(BWGREP1):"SEARCH/",1:"")_"PRINT/SORT logic for future use",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. Q:$D(DIRUT)
  1. Q:'Y
  1. K DIR,X,Y S DIR(0)="9002086.88,.03",DIR("A")="Enter NAME for this REPORT DEFINITION" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. G:$D(DIRUT) SAVE
  1. S BWGRNAME=Y
  1. S DIE="^BWGRTRPT(",DA=BWGRRPT,DR=".02////1;.03///"_BWGRNAME_";.06///"_BWGRPTVS_";.05///"_BWGRCTYP S:$D(BWGREP1) DR=DR_";.09///"_BWGRPACK D ^DIE K DIE,DA,DR
  1. Q
  1. COUNT ;EP
  1. W !!
  1. S DIR(0)="S^T:Total Count Only;S:Sub-counts and Total Count;D:Detailed "_$S(BWGRPTVS="R":"WH Procedure",1:"Patient")_" Listing"
  1. S DIR("A")=" Choose Type of Report",DIR("B")="D" D ^DIR K DIR W !!
  1. S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) S BWGRQUIT=1 Q
  1. S BWGRCTYP=Y
  1. I BWGRCTYP="T" S $P(^BWGRTRPT(BWGRRPT,0),U,5)="T" S:BWGRPTVS="R" BWGRSORT=19,BWGRSORV="Procedure Date" S:BWGRPTVS="P" BWGRSORT=1,BWGRSORV="Patient Name" Q
  1. I BWGRCTYP="D" D PRINT Q:$D(BWGRQUIT) D SORT Q
  1. D SORT
  1. Q
  1. PRINT ;
  1. S BWGRCNTL="P"
  1. D ^BWGRVL4
  1. Q
  1. SORT ;EP
  1. K BWGRSORT,BWGRSORV,BWGRQUIT
  1. I BWGRCTYP="D",'$D(^BWGRTRPT(BWGRRPT,12)) W !!,"NO PRINT FIELDS SELECTED!!",$C(7),$C(7) S BWGRQUIT=1 Q
  1. S BWGRSORT=""
  1. D SHOWR^BWGRVLS
  1. S BWGRCNTL="R" D ^BWGRVL4 K BWGRCNTL
  1. I '$D(BWGRSORV) S BWGRQUIT=1 Q
  1. Q:BWGRCTYP'="D"
  1. PAGE ;
  1. K BWGRSPAG
  1. Q:BWGRCTYP'="D"
  1. S DIR(0)="Y",DIR("A")="Do you want a separate page for each "_BWGRSORV,DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) G SORT
  1. S BWGRSPAG=Y,DIE="^BWGRTRPT(",DA=BWGRRPT,DR=".04///"_BWGRSPAG D ^DIE K DA,DR,DIE
  1. Q
  1. FLAT ;
  1. S BWGRFILE="BWGR"_DUZ_"."
  1. S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S BWGRJD=X+1
  1. S BWGRFILE=BWGRFILE_BWGRJD
  1. W !!,"I am going to create a file called ",BWGRFILE," which will reside in ",!,"the ",$S($P(^AUTTSITE(1,0),U,21)=1:"/usr/spool/uucppublic",1:"C:\EXPORT")," directory.",!
  1. W "Actually, the file will be placed in the same directory that the data export"
  1. W !,"globals are placed. See your site manager for assistance in finding the file",!,"after it is created. PLEASE jot down and remember the following file name:",!?15,"********** ",BWGRFILE," **********",!
  1. W "It may be several hours (or overnight) before your report and flat file are ",!,"finished.",!
  1. W !,"As a reminder, the records that are generated and placed in file ",BWGRFILE,!
  1. W !,"are in a standard, pre-defined record format. For a definition of the format",!,"please see your user manual.",!
  1. S DIR(0)="Y",DIR("A")="Is everything ok? Do you want to continue?",DIR("B")="Y" K DA D ^DIR K DIR
  1. I $D(DIRUT)!(Y'=1) S BWGRQUIT=1 Q
  1. S DA=BWGRRPT,DR=".12///"_BWGRFILE,DIE="^BWGRTRPT(" D ^DIE
  1. K DIE,DA,DR
  1. Q