- 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
