BRNPUR.m

BRNPUR ; IHS/PHXAO/TMJ - ROI CLOSED DISCLOSURES BY PURPOSE (BY DATE RANGE) ;  

 ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003

 ;IHS/OIT/LJF 01/23/2008 PATCH 1 Added choice of facility to print

 ;                               Added date range limits

 ;

ASK ;Ask For Date Range

 ;

 ;

BD ;get beginning date

 ;W !! S DIR(0)="D^::EP",DIR("A")="Enter beginning ROI Initiated Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=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

 I $D(DIRUT) G END

 S BRNBD=Y

ED ;get ending date

 ;W ! S DIR(0)="D^"_BRNBD_"::EP",DIR("A")="Enter ending ROI Initiation Date"  D ^DIR K DIR S:$D(DUOUT) DIRUT=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

 I $D(DIRUT) G BD

 S BRNED=Y

 S X1=BRNBD,X2=-1 D C^%DTC S BRNSD=X

 W !

 ;

 NEW BRNFAC,BRNFACN D ASKFAC^BRNU(.BRNFAC) I BRNFAC="" D ED Q            ;IHS/OIT/LJF 01/23/2008 PATCH 1

 I BRNFAC>0 S BRNFACN=$$GET1^DIQ(90264.2,BRNFAC,.01)  ;IHS/OIT/LJF 01/23/2008 PATCH 1

 ;

PRINT ;PRINT CLOSED DISCLOSURES BY DATE

 ;

 ;IHS/OIT/LJF 01/23/2008 PATCH 1

 ;S FLDS="[BRN PURPOSE SUBTOTAL PRINT]",BY="'(#.01),INTERNAL(#.08)=""C"",+.07",DIC="^BRNREC(",L=0

 ;S FR=BRNBD,TO=BRNED

 S FLDS="[BRN PURPOSE SUBTOTAL PRINT]",BY="FACILITY,'(#.01),INTERNAL(#.08)=""C"",+.07",DIC="^BRNREC(",L=0

 I BRNFAC=0 S FR="@,"_BRNBD,TO="ZZZ,"_BRNED

 E  S FR=BRNFACN_","_BRNBD,TO=BRNFACN_","_BRNED

 ;end of Patch 1 changes

 ;

 K DHIT,DIOEND,DIOBEG

 D EN1^DIP

END ;

 K BRNBD,BRNED,BRNSD,X,DD0,B Q

BRNPUR    ; IHS/PHXAO/TMJ - ROI CLOSED DISCLOSURES BY PURPOSE (BY DATE RANGE) ;  

 +1       ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003

 +2       ;IHS/OIT/LJF 01/23/2008 PATCH 1 Added choice of facility to print

 +3       ;                               Added date range limits

 +4       ;

ASK       ;Ask For Date Range

 +1       ;

 +2       ;

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

 +2       ;IHS/OIT/LJF 01/23/2008 PATCH 1

           WRITE !!

           SET DIR(0)="D^:"_DT_":EP"

           SET DIR("A")="Enter beginning ROI Initiated Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO END

 +4        SET BRNBD=Y

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

 +2       ;IHS/OIT/LJF 01/23/2008 PATCH 1

           WRITE !

           SET DIR(0)="D^"_BRNBD_":"_DT_":EP"

           SET DIR("A")="Enter ending ROI Initiation Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO BD

 +4        SET BRNED=Y

 +5        SET X1=BRNBD

           SET X2=-1

           DO C^%DTC

           SET BRNSD=X

 +6        WRITE !

 +7       ;

 +8       ;IHS/OIT/LJF 01/23/2008 PATCH 1

           NEW BRNFAC,BRNFACN

           DO ASKFAC^BRNU(.BRNFAC)

           IF BRNFAC=""

               DO ED

               QUIT 

 +9       ;IHS/OIT/LJF 01/23/2008 PATCH 1

           IF BRNFAC>0

               SET BRNFACN=$$GET1^DIQ(90264.2,BRNFAC,.01)

 +10      ;

PRINT     ;PRINT CLOSED DISCLOSURES BY DATE

 +1       ;

 +2       ;IHS/OIT/LJF 01/23/2008 PATCH 1

 +3       ;S FLDS="[BRN PURPOSE SUBTOTAL PRINT]",BY="'(#.01),INTERNAL(#.08)=""C"",+.07",DIC="^BRNREC(",L=0

 +4       ;S FR=BRNBD,TO=BRNED

 +5        SET FLDS="[BRN PURPOSE SUBTOTAL PRINT]"

           SET BY="FACILITY,'(#.01),INTERNAL(#.08)=""C"",+.07"

           SET DIC="^BRNREC("

           SET L=0

 +6        IF BRNFAC=0

               SET FR="@,"_BRNBD

               SET TO="ZZZ,"_BRNED

 +7       IF '$TEST

               SET FR=BRNFACN_","_BRNBD

               SET TO=BRNFACN_","_BRNED

 +8       ;end of Patch 1 changes

 +9       ;

 +10       KILL DHIT,DIOEND,DIOBEG

 +11       DO EN1^DIP

END       ;

 +1        KILL BRNBD,BRNED,BRNSD,X,DD0,B

           QUIT