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

BRNAGE1.m

Go to the documentation of this file.
  1. BRNAGE1 ; IHS/PHXAO/TMJ - ROI AGING REPORT (BY AGE STARTING POINT) ;
  1. ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
  1. ;IHS/OIT/LJF 10/11/2007 PATCH 1 added ;EP to ASK line label
  1. ; 01/24/2008 PATCH 1 Added choice of facility
  1. ;
  1. ;
  1. ASK ;EP - Ask For Beginning Aging Range ;IHS/OIT/LJF 10/11/2007 PATCH 1
  1. ; now called by DRIVER^BRNAGE2
  1. S BRNOLDB=0,BRNOLDE=1000
  1. W ! S DIR(0)="Y0",DIR("A")="Would you like to include a particular Aging Starting Range",DIR("B")="NO"
  1. S DIR("?")="To Include a Particular Number of Days Old Starting Point-Answer Yes."
  1. D ^DIR K DIR
  1. G:$D(DIRUT) END
  1. I 'Y G PRINT
  1. ;
  1. OLD1 ;ROI Disclosure DAYS OLD SCREEN
  1. S DIR(0)="S^30:30 DAYS +;60:60 DAYS +;90:90 DAYS +;120:120 DAYS +",DIR("A")="Enter the Number Starting Point"
  1. K DA D ^DIR K DIR
  1. G:$D(DIRUT) ASK
  1. G:Y=0 ASK
  1. S BRNOLDB=Y
  1. ;
  1. ;
  1. PRINT ;PRINT MASTER DISCLOSURE LOG
  1. ;
  1. ;IHS/OIT/LJF 01/24/2008 PATCH 1
  1. ;select facility
  1. NEW BRNFAC,BRNFACN D ASKFAC^BRNU(.BRNFAC) I BRNFAC="" D END Q
  1. I BRNFAC>0 S BRNFACN=$$GET1^DIQ(90264.2,BRNFAC,.01)
  1. ;
  1. ;set up print
  1. ;S FLDS="[BRN GS AGING RPT]",BY="@23,(#.04),.08,@.01",DIC="^BRNREC(",L=0
  1. ;S FR=BRNOLDB,TO=BRNOLDE
  1. S FLDS="[BRN GS AGING RPT]",BY="FACILITY;S1,@23,(#.04),.08,@.01",DIC="^BRNREC(",L=0
  1. I BRNFAC=0 S FR="@,"_BRNOLDB,TO="ZZZ,"_BRNOLDE
  1. E S FR=BRNFACN_","_BRNOLDB,TO=BRNFACN_","_BRNOLDE
  1. ;end of PATCH 1 changes
  1. ;
  1. K DHIT,DIOEND,DIOBEG
  1. D EN1^DIP
  1. END ;
  1. K BRNOLDB,BRNOLDE,DD0,B,X Q