- 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
