BRNRUP1 ; IHS/OIT/LJF - CONTINUED REPORT UTILITY PRINT LOGIC
;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
;IHS/OIT/LJF 10/25/2007 PATCH 1 Added this routine
;
COVPAGE ;EP
W:$D(IOF) @IOF
W !?20,"ROI REPORT UTILITY ",$S(BRNCTYP="D":"LISTING",1:"COUNT")
W !?34,"SUMMARY PAGE"
W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U),!
W !,"Disclosure Record Selection Criteria"
W !?6,"Request Date range: ",BRNBDD," to ",BRNEDD
;
; if no sleection criteria, show print criteria
I '$D(^BRNRPT(BRNRPT,11)) D SHOWP Q
;
; else, show selection criteria first
NEW BRNI,BRNY,C,BRNQ,X
S BRNI=0 F S BRNI=$O(^BRNRPT(BRNRPT,11,BRNI)) Q:BRNI'=+BRNI D
. I $Y>(IOSL-5) D PAUSE^BRNU W @IOF
. W !?6,$P(^BRNSORT(BRNI,0),U),": "
. S BRNY="",C=0 K BRNQ
. F S BRNY=$O(^BRNRPT(BRNRPT,11,BRNI,11,"B",BRNY)) S C=C+1 W:C'=1&(BRNY'="") " ; " Q:BRNY=""!($D(BRNQ)) D
. . S X=BRNY X:$D(^BRNSORT(BRNI,2)) ^(2) W X ;translation logic
D SHOWP
Q
;
SHOWP ; display what the report will contain based on report type
W !!,"REPORT/OUTPUT TYPE",!
I BRNCTYP="T" D COUNT Q ;totals: display and quit
;
; subtotals
I BRNCTYP="S" D I 1
. I $Y>(IOSL-6) D PAUSE^BRNU W @IOF
. W ?6,"Report will contain sub-totals by ",$P(^BRNSORT(BRNSORT,0),U)," and ",!?6,"total counts."
. I '$D(^XTMP("BRNVL",BRNJOB,BRNBTH)) W !!,"NO DATA TO REPORT.",! D PAUSE^BRNU W:$D(IOF) @IOF
;
I BRNCTYP'="D",BRNCTYP'="L" D PAUSE^BRNU W:$D(IOF) @IOF Q
I $Y>(IOSL-4) D PAUSE^BRNU W @IOF
;
I BRNCTYP="D" W ?6,"Detailed Listing containing"
;
I BRNCTYP="L" D
. W !?5,"PLEASE NOTE: The first column of the delimited output will always"
. W !?5," be the patient internal entry number which uniquely"
. W !?5," identifies the patient. The second column will always"
. W !?5," be the request internal entry number which uniquely"
. W !?5," identifies the disclosure request.",!
. W ?6,"A File of records called ",BRNDELF," will be created."
. W !?6,"Delimited output file will contain:"
;
I '$D(^BRNRPT(BRNRPT,12)) D PAUSE^BRNU Q
;
; loop through print items and display them
NEW BRNI,BRNCRIT
S BRNI=0 F S BRNI=$O(^BRNRPT(BRNRPT,12,BRNI)) Q:BRNI'=+BRNI S BRNCRIT=$P(^BRNRPT(BRNRPT,12,BRNI,0),U) D
. I $Y>(IOSL-4) D PAUSE^BRNU W:$D(IOF) @IOF
. W !?6,$P(^BRNSORT(BRNCRIT,0),U)
. I BRNCTYP="D" W " (" S X=$O(^BRNRPT(BRNRPT,12,"B",BRNCRIT,"")) I X]"" W $P(^BRNRPT(BRNRPT,12,X,0),U,2),")"
;
I $Y>(IOSL-4) D PAUSE^BRNU W:$D(IOF) @IOF
I BRNCTYP="D" W !?10," TOTAL column width: ",BRNTCW
;
Q:'$G(BRNSORT)
I $Y>(IOSL-4) D PAUSE^BRNU W:$D(IOF) @IOF
W !!,"Disclosure Requests will be SORTED by: ",$P(^BRNSORT(BRNSORT,0),U),!
I $Y>(IOSL-4) D PAUSE^BRNU W:$D(IOF) @IOF
I $G(BRNSPAG) W !?6,"Each ",$P(^BRNSORT(BRNSORT,0),U)," will be on a separate page.",!
;
I '$D(^XTMP("BRNVL",BRNJOB,BRNBTH)) W !!,"NO DATA TO REPORT.",!
;
I BRNCTYP="L" D
. I $D(BRNRCNT) W !!!,"Total Disclosure Requests: ",BRNRCNT
. W !,"Total Patients: ",BRNPTCT
;
Q
;
COUNT ;if COUNTING entries only
I $Y>(IOSL-5) D PAUSE^BRNU W:$D(IOF) @IOF
W ?6,"Totals Displayed"
I '$D(^XTMP("BRNVL",BRNJOB,BRNBTH)) W !!!,"NO DATA TO REPORT.",!
W:$D(BRNRCNT) !!!?6,"Total COUNT of Disclosure Requests: ",?34,BRNRCNT
W !?6,"Total COUNT of Patients: ",?34,BRNPTCT
Q
;
WP ;EP - Entry point to print wp fields
; pass file in BRNFILE, entry in BRNDA, subscript in BRNNODE
NEW BRNRLX,BRNG1,BRNG,DIWL,DIWR,DIWF,X,Y,Z
K ^UTILITY($J,"W")
S BRNRLX=0
S BRNG1=^DIC(BRNFILE,0,"GL"),BRNG=BRNG1_BRNDA_","_BRNNODE_",BRNRLX)",BRNGR=BRNG1_BRNDA_","_BRNNODE_",BRNRLX"
S DIWL=1,DIWR=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2) F S BRNRLX=$O(@BRNG) Q:BRNRLX'=+BRNRLX D
.S Y=BRNGR_",0)" S X=@Y D ^DIWP
;
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z S BRNPCNT=BRNPCNT+1,BRNPRNM(BRNPCNT)=^UTILITY($J,"W",DIWL,Z,0)
S BRNPCNT=BRNPCNT+1
K ^UTILITY($J,"W"),BRNNODE,BRNFILE,BRNDA
Q
BRNRUP1 ; IHS/OIT/LJF - CONTINUED REPORT UTILITY PRINT LOGIC
+1 ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
+2 ;IHS/OIT/LJF 10/25/2007 PATCH 1 Added this routine
+3 ;
COVPAGE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !?20,"ROI REPORT UTILITY ",$SELECT(BRNCTYP="D":"LISTING",1:"COUNT")
+3 WRITE !?34,"SUMMARY PAGE"
+4 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U),!
+5 WRITE !,"Disclosure Record Selection Criteria"
+6 WRITE !?6,"Request Date range: ",BRNBDD," to ",BRNEDD
+7 ;
+8 ; if no sleection criteria, show print criteria
+9 IF '$DATA(^BRNRPT(BRNRPT,11))
DO SHOWP
QUIT
+10 ;
+11 ; else, show selection criteria first
+12 NEW BRNI,BRNY,C,BRNQ,X
+13 SET BRNI=0
FOR
SET BRNI=$ORDER(^BRNRPT(BRNRPT,11,BRNI))
IF BRNI'=+BRNI
QUIT
Begin DoDot:1
+14 IF $Y>(IOSL-5)
DO PAUSE^BRNU
WRITE @IOF
+15 WRITE !?6,$PIECE(^BRNSORT(BRNI,0),U),": "
+16 SET BRNY=""
SET C=0
KILL BRNQ
+17 FOR
SET BRNY=$ORDER(^BRNRPT(BRNRPT,11,BRNI,11,"B",BRNY))
SET C=C+1
IF C'=1&(BRNY'="")
WRITE " ; "
IF BRNY=""!($DATA(BRNQ))
QUIT
Begin DoDot:2
+18 ;translation logic
SET X=BRNY
IF $DATA(^BRNSORT(BRNI,2))
XECUTE ^(2)
WRITE X
End DoDot:2
End DoDot:1
+19 DO SHOWP
+20 QUIT
+21 ;
SHOWP ; display what the report will contain based on report type
+1 WRITE !!,"REPORT/OUTPUT TYPE",!
+2 ;totals: display and quit
IF BRNCTYP="T"
DO COUNT
QUIT
+3 ;
+4 ; subtotals
+5 IF BRNCTYP="S"
Begin DoDot:1
+6 IF $Y>(IOSL-6)
DO PAUSE^BRNU
WRITE @IOF
+7 WRITE ?6,"Report will contain sub-totals by ",$PIECE(^BRNSORT(BRNSORT,0),U)," and ",!?6,"total counts."
+8 IF '$DATA(^XTMP("BRNVL",BRNJOB,BRNBTH))
WRITE !!,"NO DATA TO REPORT.",!
DO PAUSE^BRNU
IF $DATA(IOF)
WRITE @IOF
End DoDot:1
IF 1
+9 ;
+10 IF BRNCTYP'="D"
IF BRNCTYP'="L"
DO PAUSE^BRNU
IF $DATA(IOF)
WRITE @IOF
QUIT
+11 IF $Y>(IOSL-4)
DO PAUSE^BRNU
WRITE @IOF
+12 ;
+13 IF BRNCTYP="D"
WRITE ?6,"Detailed Listing containing"
+14 ;
+15 IF BRNCTYP="L"
Begin DoDot:1
+16 WRITE !?5,"PLEASE NOTE: The first column of the delimited output will always"
+17 WRITE !?5," be the patient internal entry number which uniquely"
+18 WRITE !?5," identifies the patient. The second column will always"
+19 WRITE !?5," be the request internal entry number which uniquely"
+20 WRITE !?5," identifies the disclosure request.",!
+21 WRITE ?6,"A File of records called ",BRNDELF," will be created."
+22 WRITE !?6,"Delimited output file will contain:"
End DoDot:1
+23 ;
+24 IF '$DATA(^BRNRPT(BRNRPT,12))
DO PAUSE^BRNU
QUIT
+25 ;
+26 ; loop through print items and display them
+27 NEW BRNI,BRNCRIT
+28 SET BRNI=0
FOR
SET BRNI=$ORDER(^BRNRPT(BRNRPT,12,BRNI))
IF BRNI'=+BRNI
QUIT
SET BRNCRIT=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U)
Begin DoDot:1
+29 IF $Y>(IOSL-4)
DO PAUSE^BRNU
IF $DATA(IOF)
WRITE @IOF
+30 WRITE !?6,$PIECE(^BRNSORT(BRNCRIT,0),U)
+31 IF BRNCTYP="D"
WRITE " ("
SET X=$ORDER(^BRNRPT(BRNRPT,12,"B",BRNCRIT,""))
IF X]""
WRITE $PIECE(^BRNRPT(BRNRPT,12,X,0),U,2),")"
End DoDot:1
+32 ;
+33 IF $Y>(IOSL-4)
DO PAUSE^BRNU
IF $DATA(IOF)
WRITE @IOF
+34 IF BRNCTYP="D"
WRITE !?10," TOTAL column width: ",BRNTCW
+35 ;
+36 IF '$GET(BRNSORT)
QUIT
+37 IF $Y>(IOSL-4)
DO PAUSE^BRNU
IF $DATA(IOF)
WRITE @IOF
+38 WRITE !!,"Disclosure Requests will be SORTED by: ",$PIECE(^BRNSORT(BRNSORT,0),U),!
+39 IF $Y>(IOSL-4)
DO PAUSE^BRNU
IF $DATA(IOF)
WRITE @IOF
+40 IF $GET(BRNSPAG)
WRITE !?6,"Each ",$PIECE(^BRNSORT(BRNSORT,0),U)," will be on a separate page.",!
+41 ;
+42 IF '$DATA(^XTMP("BRNVL",BRNJOB,BRNBTH))
WRITE !!,"NO DATA TO REPORT.",!
+43 ;
+44 IF BRNCTYP="L"
Begin DoDot:1
+45 IF $DATA(BRNRCNT)
WRITE !!!,"Total Disclosure Requests: ",BRNRCNT
+46 WRITE !,"Total Patients: ",BRNPTCT
End DoDot:1
+47 ;
+48 QUIT
+49 ;
COUNT ;if COUNTING entries only
+1 IF $Y>(IOSL-5)
DO PAUSE^BRNU
IF $DATA(IOF)
WRITE @IOF
+2 WRITE ?6,"Totals Displayed"
+3 IF '$DATA(^XTMP("BRNVL",BRNJOB,BRNBTH))
WRITE !!!,"NO DATA TO REPORT.",!
+4 IF $DATA(BRNRCNT)
WRITE !!!?6,"Total COUNT of Disclosure Requests: ",?34,BRNRCNT
+5 WRITE !?6,"Total COUNT of Patients: ",?34,BRNPTCT
+6 QUIT
+7 ;
WP ;EP - Entry point to print wp fields
+1 ; pass file in BRNFILE, entry in BRNDA, subscript in BRNNODE
+2 NEW BRNRLX,BRNG1,BRNG,DIWL,DIWR,DIWF,X,Y,Z
+3 KILL ^UTILITY($JOB,"W")
+4 SET BRNRLX=0
+5 SET BRNG1=^DIC(BRNFILE,0,"GL")
SET BRNG=BRNG1_BRNDA_","_BRNNODE_",BRNRLX)"
SET BRNGR=BRNG1_BRNDA_","_BRNNODE_",BRNRLX"
+6 SET DIWL=1
SET DIWR=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U,2)
FOR
SET BRNRLX=$ORDER(@BRNG)
IF BRNRLX'=+BRNRLX
QUIT
Begin DoDot:1
+7 SET Y=BRNGR_",0)"
SET X=@Y
DO ^DIWP
End DoDot:1
+8 ;
+9 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
SET BRNPCNT=BRNPCNT+1
SET BRNPRNM(BRNPCNT)=^UTILITY($JOB,"W",DIWL,Z,0)
+10 SET BRNPCNT=BRNPCNT+1
+11 KILL ^UTILITY($JOB,"W"),BRNNODE,BRNFILE,BRNDA
+12 QUIT
