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

BRNPAGE.m

Go to the documentation of this file.
  1. BRNPAGE ; IHS/PHXAO/TMJ - ROI REPRODUCTION COSTS (BY DATE RANGE) ;
  1. ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
  1. ;IHS/OIT/LJF 01/23/2008 PATCH 1 Added choice of facility to print
  1. ; Added date range limits
  1. ;
  1. ASK ;Ask For Date Range
  1. ;
  1. ;
  1. BD ;get beginning date
  1. ;W !! S DIR(0)="D^::EP",DIR("A")="Enter beginning ROI Initiated Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. W !! S DIR(0)="D^:"_DT_":EP",DIR("A")="Enter beginning ROI Initiated Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 ;IHS/OIT/LJF 01/23/2008 PATCH 1
  1. I $D(DIRUT) G END
  1. S BRNBD=Y
  1. ED ;get ending date
  1. ;W ! S DIR(0)="D^"_BRNBD_"::EP",DIR("A")="Enter ending ROI Initiation Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. W ! S DIR(0)="D^"_BRNBD_":"_DT_":EP",DIR("A")="Enter ending ROI Initiation Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 ;IHS/OIT/LJF 01/23/2008 PATCH 1
  1. I $D(DIRUT) G BD
  1. S BRNED=Y
  1. S X1=BRNBD,X2=-1 D C^%DTC S BRNSD=X
  1. W !
  1. ;
  1. NEW BRNFAC,BRNFACN D ASKFAC^BRNU(.BRNFAC) I BRNFAC="" D ED Q ;IHS/OIT/LJF 01/23/2008 PATCH 1
  1. I BRNFAC>0 S BRNFACN=$$GET1^DIQ(90264.2,BRNFAC,.01) ;IHS/OIT/LJF 01/23/2008 PATCH 1
  1. ;
  1. PRINT ;PRINT CLOSED DISCLOSURES BY DATE
  1. ;
  1. ;IHS/OIT/LJF 01/23/2008 PATCH 1
  1. ;S FLDS="[BRN REPRODUCTION COST]",BY="@INTERNAL(#.01)",DIC="^BRNREC(",L=0
  1. ;S FR=BRNBD,TO=BRNED
  1. S FLDS="[BRN REPRODUCTION COST]",BY="FACILITY,@INTERNAL(#.01)",DIC="^BRNREC(",L=0
  1. I BRNFAC=0 S FR="@,"_BRNBD,TO="ZZZ,"_BRNED,DHD="REPRODUCTION COSTS FOR ALL FACILITIES"
  1. E S FR=BRNFACN_","_BRNBD,TO=BRNFACN_","_BRNED,DHD="REPRODUCTION COSTS FOR "_BRNFACN
  1. ;end of Patch 1 changes
  1. ;
  1. K DHIT,DIOEND,DIOBEG
  1. D EN1^DIP
  1. END ;
  1. K BRNBD,BRNED,BRNSD,X,DD0,B Q