BRNAGE2.m

BRNAGE2 ; IHS/OIT/LJF - ROI AGING REPORT (BY STAFF ASSIGNMENT) ; 

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

 ;IHS/OIT/LJF 10/11/2007 PATCH 1  Added this routine - new report & driver

 ;

DRIVER ;EP; entry point from new option

 ; driver calls all 3 aging reports

 NEW DIR,Y,RPT

 W !,"ROI AGING REPORTS"

 S DIR(0)="S^1:By Request STATUS;2:By AGING Range;3:By STAFF Assignment;4:By PURPOSE",DIR("A")="Select a Report"

 K DA D ^DIR K DIR

 Q:$D(DIRUT)  Q:Y<1

 S RPT=$S(Y=1:"ASK1^BRNAGE",Y=2:"ASK^BRNAGE1",Y=3:"ASK^BRNAGE2",1:"ASK2^BRNAGE2") D @RPT

 Q

 ;

ASK ;EP - Restrict a Certain Staff Assignment

 S BRNSTBD="",BRNSTED=""

 W ! S DIR(0)="Y0",DIR("A")="Would you like to run this report for ONLY a particular staff member",DIR("B")="NO"

 S DIR("?")="To RESTRICT to a particular STAFF ASSIGNMENT  - Answer Yes."

 D ^DIR K DIR

 G:$D(DIRUT) END

 I 'Y G PRINT

 ;

STAFF ;ROI Staff Assignment

 S DIR(0)="90264,.11",DIR("A")="Select STAFF ASSIGNED"

 K DA D ^DIR K DIR

 G:$D(DIRUT) ASK

 S BRNSTBD=+Y,BRNSTED=+Y

 ;

 ;

PRINT ;PRINT Report by staff assignment

 ;

 ;select facility

 NEW BRNFAC D ASKFAC^BRNU(.BRNFAC) I BRNFAC="" D END Q

 ;

 ;set up print

 S FLDS="[BRN GS AGING RPT]",BY(0)="^BRNREC(""AH"",",DIC="^BRNREC(",L=0,L(0)=2

 S FR(0,1)=BRNSTBD,TO(0,1)=BRNSTED

 I BRNFAC>0 S DIS(0)="I $P(^BRNREC(D0,0),U,22)=BRNFAC"

 K DHIT,DIOEND,DIOBEG

 D EN1^DIP

END ;

 K BRNSTBD,BRNSTED,DD0,B,X,BRNPURB,BRNPURE

 Q

 ;

ASK2 ;EP - Restrict to a certain PURPOSE

 S BRNPURB="",BRNPURE=""

 W ! S DIR(0)="Y0",DIR("A")="Would you like to run this report for ONLY one PURPOSE",DIR("B")="NO"

 S DIR("?")="To RESTRICT to a particular PURPOSE  - Answer Yes."

 D ^DIR K DIR

 G:$D(DIRUT) END

 I 'Y G PRINT2

 ;

PURPOSE ;ROI Staff Assignment

 S DIR(0)="90264,.07",DIR("A")="Select PURPOSE"

 K DA D ^DIR K DIR

 G:$D(DIRUT) ASK2

 S BRNPURB=$P(Y,U),BRNPURE=$P(Y,U)

 ;

 ;

PRINT2 ;PRINT report by purpose

 ;

 ;select facility

 NEW BRNFAC,BRNFACN D ASKFAC^BRNU(.BRNFAC) I BRNFAC="" D END Q

 I BRNFAC>0 S BRNFACN=$$GET1^DIQ(90264.2,BRNFAC,.01)

 ;

 ;set up print

 S FLDS="[BRN GS AGING RPT]",BY="FACILITY;S1,.07",DIC="^BRNREC(",L=0

 I BRNFAC=0 S FR="@,"_BRNPURB,TO="ZZZ,"_BRNPURE

 E  S FR=BRNFACN_","_BRNPURB,TO=BRNFACN_","_BRNPURE

 K DHIT,DIOEND,DIOBEG

 D EN1^DIP

 G END

BRNAGE2   ; IHS/OIT/LJF - ROI AGING REPORT (BY STAFF ASSIGNMENT) ; 

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

 +2       ;IHS/OIT/LJF 10/11/2007 PATCH 1  Added this routine - new report & driver

 +3       ;

DRIVER    ;EP; entry point from new option

 +1       ; driver calls all 3 aging reports

 +2        NEW DIR,Y,RPT

 +3        WRITE !,"ROI AGING REPORTS"

 +4        SET DIR(0)="S^1:By Request STATUS;2:By AGING Range;3:By STAFF Assignment;4:By PURPOSE"

           SET DIR("A")="Select a Report"

 +5        KILL DA

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               QUIT 

           IF Y<1

               QUIT 

 +7        SET RPT=$SELECT(Y=1:"ASK1^BRNAGE",Y=2:"ASK^BRNAGE1",Y=3:"ASK^BRNAGE2",1:"ASK2^BRNAGE2")

           DO @RPT

 +8        QUIT 

 +9       ;

ASK       ;EP - Restrict a Certain Staff Assignment

 +1        SET BRNSTBD=""

           SET BRNSTED=""

 +2        WRITE !

           SET DIR(0)="Y0"

           SET DIR("A")="Would you like to run this report for ONLY a particular staff member"

           SET DIR("B")="NO"

 +3        SET DIR("?")="To RESTRICT to a particular STAFF ASSIGNMENT  - Answer Yes."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               GOTO END

 +6        IF 'Y

               GOTO PRINT

 +7       ;

STAFF     ;ROI Staff Assignment

 +1        SET DIR(0)="90264,.11"

           SET DIR("A")="Select STAFF ASSIGNED"

 +2        KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO ASK

 +4        SET BRNSTBD=+Y

           SET BRNSTED=+Y

 +5       ;

 +6       ;

PRINT     ;PRINT Report by staff assignment

 +1       ;

 +2       ;select facility

 +3        NEW BRNFAC

           DO ASKFAC^BRNU(.BRNFAC)

           IF BRNFAC=""

               DO END

               QUIT 

 +4       ;

 +5       ;set up print

 +6        SET FLDS="[BRN GS AGING RPT]"

           SET BY(0)="^BRNREC(""AH"","

           SET DIC="^BRNREC("

           SET L=0

           SET L(0)=2

 +7        SET FR(0,1)=BRNSTBD

           SET TO(0,1)=BRNSTED

 +8        IF BRNFAC>0

               SET DIS(0)="I $P(^BRNREC(D0,0),U,22)=BRNFAC"

 +9        KILL DHIT,DIOEND,DIOBEG

 +10       DO EN1^DIP

END       ;

 +1        KILL BRNSTBD,BRNSTED,DD0,B,X,BRNPURB,BRNPURE

 +2        QUIT 

 +3       ;

ASK2      ;EP - Restrict to a certain PURPOSE

 +1        SET BRNPURB=""

           SET BRNPURE=""

 +2        WRITE !

           SET DIR(0)="Y0"

           SET DIR("A")="Would you like to run this report for ONLY one PURPOSE"

           SET DIR("B")="NO"

 +3        SET DIR("?")="To RESTRICT to a particular PURPOSE  - Answer Yes."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               GOTO END

 +6        IF 'Y

               GOTO PRINT2

 +7       ;

PURPOSE   ;ROI Staff Assignment

 +1        SET DIR(0)="90264,.07"

           SET DIR("A")="Select PURPOSE"

 +2        KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO ASK2

 +4        SET BRNPURB=$PIECE(Y,U)

           SET BRNPURE=$PIECE(Y,U)

 +5       ;

 +6       ;

PRINT2    ;PRINT report by purpose

 +1       ;

 +2       ;select facility

 +3        NEW BRNFAC,BRNFACN

           DO ASKFAC^BRNU(.BRNFAC)

           IF BRNFAC=""

               DO END

               QUIT 

 +4        IF BRNFAC>0

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

 +5       ;

 +6       ;set up print

 +7        SET FLDS="[BRN GS AGING RPT]"

           SET BY="FACILITY;S1,.07"

           SET DIC="^BRNREC("

           SET L=0

 +8        IF BRNFAC=0

               SET FR="@,"_BRNPURB

               SET TO="ZZZ,"_BRNPURE

 +9       IF '$TEST

               SET FR=BRNFACN_","_BRNPURB

               SET TO=BRNFACN_","_BRNPURE

 +10       KILL DHIT,DIOEND,DIOBEG

 +11       DO EN1^DIP

 +12       GOTO END