- BRNRUP ; IHS/OIT/LJF - 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
- ;
- START ;EP - Begin processing print logic
- ; if user selected delimited file, go there
- I BRNCTYP="L" D DELIMIT^BRNRUP3 Q
- ;
- ; Otherwise, set up header line, dash line
- NEW I,J,K,X
- S BRNFCNT=0
- S X=0,BRNHEAD="" F S X=$O(^BRNRPT(BRNRPT,12,X)) Q:X'=+X D
- . S BRNHDR=$P(^BRNSORT($P(^BRNRPT(BRNRPT,12,X,0),U),0),U,6) ;column header
- . S BRNLENG=$P(^BRNRPT(BRNRPT,12,X,0),U,2),BRNHDR=$E(BRNHDR,1,BRNLENG) ;print item length
- . S J=$L(BRNHDR),BRNHEAD=BRNHEAD_BRNHDR,K=BRNLENG+1 F I=J:1:K S BRNHEAD=BRNHEAD_" " ;space items across page
- S BRNDASH="",$P(BRNDASH,"-",BRNTCW)="-" ;dash line
- ;
- S BRNTITL=$$GET1^DIQ(90264.8,BRNRPT,1303)
- ;
- D COVPAGE^BRNRUP1 ;print cover page - note: if user ^'s out of cover page, processing continues
- ;
- PROC ;process printing of report
- I BRNCTYP="T" D DONE^BRNRUP2 Q ; if displaying only total, that was done in the cover page - go to done
- ;
- S BRNPG=0 I '$D(^XTMP("BRNVL",BRNJOB,BRNBTH)) D DONE^BRNRUP2 Q
- ;
- S (BRNSRTV,BRNFRST)="" K BRNQUIT
- F S BRNSRTV=$O(^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRTV)) Q:BRNSRTV=""!($D(BRNQUIT)) D V
- I $D(BRNQUIT) D DONE^BRNRUP2 Q
- I $Y>(IOSL-4) D HEAD I $D(BRNQUIT) D DONE^BRNRUP2 Q
- I $D(BRNRCNT) W !!!,"Total Disclosure Requests: ",BRNRCNT
- W !,"Total Patients: ",BRNPTCT
- D DONE^BRNRUP2
- Q
- ;
- V ;GETS DATA HITS
- S BRNSCNT=0
- ;get readable sort value
- K BRNPRNT
- S BRNSRTR="",BRNVIEN=$O(^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRTV,0)) I BRNVIEN]"" S BRNCRIT=BRNSORT D
- . S BRNVREC=^BRNREC(BRNVIEN,0),DFN=$P(BRNVREC,U,3)
- . X:$D(^BRNSORT(BRNSORT,3)) ^(3) S BRNSRTR=BRNPRNT
- ;
- ; if first page or subtotal page, print heading
- I $G(BRNSPAG)!($D(BRNFRST)) K BRNFRST D HEAD Q:$D(BRNQUIT)
- ;
- ; pull each record
- S BRNVIEN=0 F S BRNVIEN=$O(^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRTV,BRNVIEN)) Q:BRNVIEN'=+BRNVIEN!($D(BRNQUIT)) D
- . S BRNVREC=^BRNREC(BRNVIEN,0),DFN=$P(BRNVREC,U,3) D PRINT
- ;
- Q:$D(BRNQUIT)
- I $Y>(IOSL-3) D HEAD Q:$D(BRNQUIT)
- ;
- I $G(BRNSPAG) D
- . W !!,"SUB-TOTAL for ",BRNSORV," ",$S(BRNSRTR]"":BRNSRTR,1:"*Unanswered*"),": ",BRNSCNT
- . W " # of PATIENTS: "
- . W $S($D(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV)):^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV),1:0)
- ;
- I BRNCTYP="S" D
- . W !,?10,$E($S(BRNSRTR]"":BRNSRTR,1:"*Unanswered*"),1,30)
- . W ?43,$J(BRNSCNT,8)," (Records)"
- . W ?53,$S($D(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV)):$J(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV),8),1:0)
- . W " (Patients)"
- Q
- ;
- PRINT ;
- S BRNSCNT=BRNSCNT+1 Q:BRNCTYP="S"
- K ^XTMP("BRNLINE",$J) S ^XTMP("BRNLINE",$J,1)=""
- I $Y>(IOSL-5) D HEAD Q:$D(BRNQUIT)
- S BRNI=0 F S BRNI=$O(^BRNRPT(BRNRPT,12,BRNI)) Q:BRNI'=+BRNI!($D(BRNQUIT)) S BRNCRIT=$P(^BRNRPT(BRNRPT,12,BRNI,0),U) D
- . I '$P(^BRNSORT(BRNCRIT,0),U,8) D SINGLE Q
- . D MULT
- ;
- S BRNX=0 F S BRNX=$O(^XTMP("BRNLINE",$J,BRNX)) Q:BRNX'=+BRNX!($D(BRNQUIT)) D
- . I $Y>(IOSL-4) D HEAD Q:$D(BRNQUIT)
- . W !,^XTMP("BRNLINE",$J,BRNX)
- Q
- ;
- SINGLE ;process single valued item
- K BRNPRNT
- S BRNX=0
- X:$D(^BRNSORT(BRNCRIT,3)) ^(3) ;print logic
- S BRNLENG=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2),BRNPRNT=$E(BRNPRNT,1,BRNLENG) D
- . S J=$L(BRNPRNT),^XTMP("BRNLINE",$J,1)=^XTMP("BRNLINE",$J,1)_BRNPRNT
- . S K=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2)+1 F I=J:1:K S ^XTMP("BRNLINE",$J,1)=^XTMP("BRNLINE",$J,1)_" "
- . S X=1 F S X=$O(^XTMP("BRNLINE",$J,X)) Q:X'=+X D
- . . I $L(^XTMP("BRNLINE",$J,X))<$L(^XTMP("BRNLINE",$J,1)) D
- . . . S K=$L(^XTMP("BRNLINE",$J,X))+1,J=$L(^XTMP("BRNLINE",$J,1)) F I=K:1:J S ^XTMP("BRNLINE",$J,X)=^XTMP("BRNLINE",$J,X)_" "
- Q
- ;
- MULT ;process multiple valued item
- K BRNPRNT,BRNPRNM,BRNY S (BRNX,BRNPCNT)=0
- X:$D(^BRNSORT(BRNCRIT,3)) ^(3) ;set BRNPRNM array
- ;
- ; if user only wants those items that match screening criteria, delete the others in the array
- I $P(^BRNRPT(BRNRPT,12,BRNI,0),U,3) D
- . S X=0 F S X=$O(BRNPRNM(X)) Q:X'=+X D
- . .S Z=$G(BRNPRNM(X,"I")) I Z="" K BRNPRNM(X) Q
- . . I '$D(^BRNRPT(BRNRPT,11,BRNCRIT,11,"B",Z)) K BRNPRNM(X)
- ;
- ;reset array subscripts to account for deleted entries
- K Y S (X,C)=0 F S X=$O(BRNPRNM(X)) Q:X'=+X S C=C+1,Y(C)=BRNPRNM(X)
- K BRNPRNM S X=0 F S X=$O(Y(X)) Q:X'=+X S BRNPRNM(X)=Y(X)
- ;
- ; if nothing to print, use 2 dashes
- I '$D(BRNPRNM) S BRNPRNT="--" D
- . S BRNLENG=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2),BRNPRNT=$E(BRNPRNT,1,BRNLENG) D
- . . S J=$L(BRNPRNT),^XTMP("BRNLINE",$J,1)=^XTMP("BRNLINE",$J,1)_BRNPRNT
- . . S K=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2)+1 F I=J:1:K S ^XTMP("BRNLINE",$J,1)=^XTMP("BRNLINE",$J,1)_" "
- ;
- ; loop through array and set print lines into ^XTMP
- S X=0 F S X=$O(BRNPRNM(X)) Q:X'=+X D
- . I X=1 D Q
- . . S BRNLENG=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2),BRNPRNT=$E(BRNPRNM(1),1,BRNLENG) D
- . . . S J=$L(BRNPRNT),^XTMP("BRNLINE",$J,1)=^XTMP("BRNLINE",$J,1)_BRNPRNT
- . . . S K=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2)+1 F I=J:1:K S ^XTMP("BRNLINE",$J,1)=^XTMP("BRNLINE",$J,1)_" "
- . ;
- . S BRNLENG=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2),BRNPRNT=$E(BRNPRNM(X),1,BRNLENG) D
- . . I '$D(^XTMP("BRNLINE",$J,X)) D
- . . . S ^XTMP("BRNLINE",$J,X)="",K=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2)+1
- . . . S $P(^XTMP("BRNLINE",$J,X)," ",($L(^XTMP("BRNLINE",$J,1))-K))=""
- . . S J=$L(BRNPRNT),^XTMP("BRNLINE",$J,X)=^XTMP("BRNLINE",$J,X)_BRNPRNT
- . . S K=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2)+1 F I=J:1:K S ^XTMP("BRNLINE",$J,X)=^XTMP("BRNLINE",$J,X)_" "
- ;
- S X=1 F S X=$O(^XTMP("BRNLINE",$J,X)) Q:X'=+X D
- . I $L(^XTMP("BRNLINE",$J,X))<$L(^XTMP("BRNLINE",$J,1)) D
- . . S K=$L(^XTMP("BRNLINE",$J,X))+1,J=$L(^XTMP("BRNLINE",$J,1)) F I=K:1:J S ^XTMP("BRNLINE",$J,X)=^XTMP("BRNLINE",$J,X)_" "
- Q
- ;
- DIQ ;EP; called by field PRINT LOGIC in ROI REPORTING UTILITY SORT file
- K BRNPRNT,BRNFILE,BRNFIEL
- S BRNFILE=$P($P(^BRNSORT(BRNCRIT,0),U,4),","),BRNFIEL=$P($P(^(0),U,4),",",2)
- S DIQ(0)="EN",DIQ="BRNPRNT(",DIC=BRNFILE,DR=BRNFIEL D EN^DIQ1 K DIC,DR,DIQ
- I '$D(BRNPRNT(BRNFILE,DA,BRNFIEL,"E")) S BRNPRNT(BRNFILE,DA,BRNFIEL,"E")="--"
- S BRNPRNT=BRNPRNT(BRNFILE,DA,BRNFIEL,"E")
- Q
- ;
- HEAD ;ENTRY POINT
- D HEAD^BRNRUP2
- Q
- BRNRUP ; IHS/OIT/LJF - 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 ;
- START ;EP - Begin processing print logic
- +1 ; if user selected delimited file, go there
- +2 IF BRNCTYP="L"
- DO DELIMIT^BRNRUP3
- QUIT
- +3 ;
- +4 ; Otherwise, set up header line, dash line
- +5 NEW I,J,K,X
- +6 SET BRNFCNT=0
- +7 SET X=0
- SET BRNHEAD=""
- FOR
- SET X=$ORDER(^BRNRPT(BRNRPT,12,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +8 ;column header
- SET BRNHDR=$PIECE(^BRNSORT($PIECE(^BRNRPT(BRNRPT,12,X,0),U),0),U,6)
- +9 ;print item length
- SET BRNLENG=$PIECE(^BRNRPT(BRNRPT,12,X,0),U,2)
- SET BRNHDR=$EXTRACT(BRNHDR,1,BRNLENG)
- +10 ;space items across page
- SET J=$LENGTH(BRNHDR)
- SET BRNHEAD=BRNHEAD_BRNHDR
- SET K=BRNLENG+1
- FOR I=J:1:K
- SET BRNHEAD=BRNHEAD_" "
- End DoDot:1
- +11 ;dash line
- SET BRNDASH=""
- SET $PIECE(BRNDASH,"-",BRNTCW)="-"
- +12 ;
- +13 SET BRNTITL=$$GET1^DIQ(90264.8,BRNRPT,1303)
- +14 ;
- +15 ;print cover page - note: if user ^'s out of cover page, processing continues
- DO COVPAGE^BRNRUP1
- +16 ;
- PROC ;process printing of report
- +1 ; if displaying only total, that was done in the cover page - go to done
- IF BRNCTYP="T"
- DO DONE^BRNRUP2
- QUIT
- +2 ;
- +3 SET BRNPG=0
- IF '$DATA(^XTMP("BRNVL",BRNJOB,BRNBTH))
- DO DONE^BRNRUP2
- QUIT
- +4 ;
- +5 SET (BRNSRTV,BRNFRST)=""
- KILL BRNQUIT
- +6 FOR
- SET BRNSRTV=$ORDER(^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRTV))
- IF BRNSRTV=""!($DATA(BRNQUIT))
- QUIT
- DO V
- +7 IF $DATA(BRNQUIT)
- DO DONE^BRNRUP2
- QUIT
- +8 IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(BRNQUIT)
- DO DONE^BRNRUP2
- QUIT
- +9 IF $DATA(BRNRCNT)
- WRITE !!!,"Total Disclosure Requests: ",BRNRCNT
- +10 WRITE !,"Total Patients: ",BRNPTCT
- +11 DO DONE^BRNRUP2
- +12 QUIT
- +13 ;
- V ;GETS DATA HITS
- +1 SET BRNSCNT=0
- +2 ;get readable sort value
- +3 KILL BRNPRNT
- +4 SET BRNSRTR=""
- SET BRNVIEN=$ORDER(^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRTV,0))
- IF BRNVIEN]""
- SET BRNCRIT=BRNSORT
- Begin DoDot:1
- +5 SET BRNVREC=^BRNREC(BRNVIEN,0)
- SET DFN=$PIECE(BRNVREC,U,3)
- +6 IF $DATA(^BRNSORT(BRNSORT,3))
- XECUTE ^(3)
- SET BRNSRTR=BRNPRNT
- End DoDot:1
- +7 ;
- +8 ; if first page or subtotal page, print heading
- +9 IF $GET(BRNSPAG)!($DATA(BRNFRST))
- KILL BRNFRST
- DO HEAD
- IF $DATA(BRNQUIT)
- QUIT
- +10 ;
- +11 ; pull each record
- +12 SET BRNVIEN=0
- FOR
- SET BRNVIEN=$ORDER(^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRTV,BRNVIEN))
- IF BRNVIEN'=+BRNVIEN!($DATA(BRNQUIT))
- QUIT
- Begin DoDot:1
- +13 SET BRNVREC=^BRNREC(BRNVIEN,0)
- SET DFN=$PIECE(BRNVREC,U,3)
- DO PRINT
- End DoDot:1
- +14 ;
- +15 IF $DATA(BRNQUIT)
- QUIT
- +16 IF $Y>(IOSL-3)
- DO HEAD
- IF $DATA(BRNQUIT)
- QUIT
- +17 ;
- +18 IF $GET(BRNSPAG)
- Begin DoDot:1
- +19 WRITE !!,"SUB-TOTAL for ",BRNSORV," ",$SELECT(BRNSRTR]"":BRNSRTR,1:"*Unanswered*"),": ",BRNSCNT
- +20 WRITE " # of PATIENTS: "
- +21 WRITE $SELECT($DATA(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV)):^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV),1:0)
- End DoDot:1
- +22 ;
- +23 IF BRNCTYP="S"
- Begin DoDot:1
- +24 WRITE !,?10,$EXTRACT($SELECT(BRNSRTR]"":BRNSRTR,1:"*Unanswered*"),1,30)
- +25 WRITE ?43,$JUSTIFY(BRNSCNT,8)," (Records)"
- +26 WRITE ?53,$SELECT($DATA(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV)):$JUSTIFY(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV),8),1:0)
- +27 WRITE " (Patients)"
- End DoDot:1
- +28 QUIT
- +29 ;
- PRINT ;
- +1 SET BRNSCNT=BRNSCNT+1
- IF BRNCTYP="S"
- QUIT
- +2 KILL ^XTMP("BRNLINE",$JOB)
- SET ^XTMP("BRNLINE",$JOB,1)=""
- +3 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(BRNQUIT)
- QUIT
- +4 SET BRNI=0
- FOR
- SET BRNI=$ORDER(^BRNRPT(BRNRPT,12,BRNI))
- IF BRNI'=+BRNI!($DATA(BRNQUIT))
- QUIT
- SET BRNCRIT=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U)
- Begin DoDot:1
- +5 IF '$PIECE(^BRNSORT(BRNCRIT,0),U,8)
- DO SINGLE
- QUIT
- +6 DO MULT
- End DoDot:1
- +7 ;
- +8 SET BRNX=0
- FOR
- SET BRNX=$ORDER(^XTMP("BRNLINE",$JOB,BRNX))
- IF BRNX'=+BRNX!($DATA(BRNQUIT))
- QUIT
- Begin DoDot:1
- +9 IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(BRNQUIT)
- QUIT
- +10 WRITE !,^XTMP("BRNLINE",$JOB,BRNX)
- End DoDot:1
- +11 QUIT
- +12 ;
- SINGLE ;process single valued item
- +1 KILL BRNPRNT
- +2 SET BRNX=0
- +3 ;print logic
- IF $DATA(^BRNSORT(BRNCRIT,3))
- XECUTE ^(3)
- +4 SET BRNLENG=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U,2)
- SET BRNPRNT=$EXTRACT(BRNPRNT,1,BRNLENG)
- Begin DoDot:1
- +5 SET J=$LENGTH(BRNPRNT)
- SET ^XTMP("BRNLINE",$JOB,1)=^XTMP("BRNLINE",$JOB,1)_BRNPRNT
- +6 SET K=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U,2)+1
- FOR I=J:1:K
- SET ^XTMP("BRNLINE",$JOB,1)=^XTMP("BRNLINE",$JOB,1)_" "
- +7 SET X=1
- FOR
- SET X=$ORDER(^XTMP("BRNLINE",$JOB,X))
- IF X'=+X
- QUIT
- Begin DoDot:2
- +8 IF $LENGTH(^XTMP("BRNLINE",$JOB,X))<$LENGTH(^XTMP("BRNLINE",$JOB,1))
- Begin DoDot:3
- +9 SET K=$LENGTH(^XTMP("BRNLINE",$JOB,X))+1
- SET J=$LENGTH(^XTMP("BRNLINE",$JOB,1))
- FOR I=K:1:J
- SET ^XTMP("BRNLINE",$JOB,X)=^XTMP("BRNLINE",$JOB,X)_" "
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 QUIT
- +11 ;
- MULT ;process multiple valued item
- +1 KILL BRNPRNT,BRNPRNM,BRNY
- SET (BRNX,BRNPCNT)=0
- +2 ;set BRNPRNM array
- IF $DATA(^BRNSORT(BRNCRIT,3))
- XECUTE ^(3)
- +3 ;
- +4 ; if user only wants those items that match screening criteria, delete the others in the array
- +5 IF $PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U,3)
- Begin DoDot:1
- +6 SET X=0
- FOR
- SET X=$ORDER(BRNPRNM(X))
- IF X'=+X
- QUIT
- Begin DoDot:2
- +7 SET Z=$GET(BRNPRNM(X,"I"))
- IF Z=""
- KILL BRNPRNM(X)
- QUIT
- +8 IF '$DATA(^BRNRPT(BRNRPT,11,BRNCRIT,11,"B",Z))
- KILL BRNPRNM(X)
- End DoDot:2
- End DoDot:1
- +9 ;
- +10 ;reset array subscripts to account for deleted entries
- +11 KILL Y
- SET (X,C)=0
- FOR
- SET X=$ORDER(BRNPRNM(X))
- IF X'=+X
- QUIT
- SET C=C+1
- SET Y(C)=BRNPRNM(X)
- +12 KILL BRNPRNM
- SET X=0
- FOR
- SET X=$ORDER(Y(X))
- IF X'=+X
- QUIT
- SET BRNPRNM(X)=Y(X)
- +13 ;
- +14 ; if nothing to print, use 2 dashes
- +15 IF '$DATA(BRNPRNM)
- SET BRNPRNT="--"
- Begin DoDot:1
- +16 SET BRNLENG=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U,2)
- SET BRNPRNT=$EXTRACT(BRNPRNT,1,BRNLENG)
- Begin DoDot:2
- +17 SET J=$LENGTH(BRNPRNT)
- SET ^XTMP("BRNLINE",$JOB,1)=^XTMP("BRNLINE",$JOB,1)_BRNPRNT
- +18 SET K=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U,2)+1
- FOR I=J:1:K
- SET ^XTMP("BRNLINE",$JOB,1)=^XTMP("BRNLINE",$JOB,1)_" "
- End DoDot:2
- End DoDot:1
- +19 ;
- +20 ; loop through array and set print lines into ^XTMP
- +21 SET X=0
- FOR
- SET X=$ORDER(BRNPRNM(X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +22 IF X=1
- Begin DoDot:2
- +23 SET BRNLENG=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U,2)
- SET BRNPRNT=$EXTRACT(BRNPRNM(1),1,BRNLENG)
- Begin DoDot:3
- +24 SET J=$LENGTH(BRNPRNT)
- SET ^XTMP("BRNLINE",$JOB,1)=^XTMP("BRNLINE",$JOB,1)_BRNPRNT
- +25 SET K=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U,2)+1
- FOR I=J:1:K
- SET ^XTMP("BRNLINE",$JOB,1)=^XTMP("BRNLINE",$JOB,1)_" "
- End DoDot:3
- End DoDot:2
- QUIT
- +26 ;
- +27 SET BRNLENG=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U,2)
- SET BRNPRNT=$EXTRACT(BRNPRNM(X),1,BRNLENG)
- Begin DoDot:2
- +28 IF '$DATA(^XTMP("BRNLINE",$JOB,X))
- Begin DoDot:3
- +29 SET ^XTMP("BRNLINE",$JOB,X)=""
- SET K=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U,2)+1
- +30 SET $PIECE(^XTMP("BRNLINE",$JOB,X)," ",($LENGTH(^XTMP("BRNLINE",$JOB,1))-K))=""
- End DoDot:3
- +31 SET J=$LENGTH(BRNPRNT)
- SET ^XTMP("BRNLINE",$JOB,X)=^XTMP("BRNLINE",$JOB,X)_BRNPRNT
- +32 SET K=$PIECE(^BRNRPT(BRNRPT,12,BRNI,0),U,2)+1
- FOR I=J:1:K
- SET ^XTMP("BRNLINE",$JOB,X)=^XTMP("BRNLINE",$JOB,X)_" "
- End DoDot:2
- End DoDot:1
- +33 ;
- +34 SET X=1
- FOR
- SET X=$ORDER(^XTMP("BRNLINE",$JOB,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +35 IF $LENGTH(^XTMP("BRNLINE",$JOB,X))<$LENGTH(^XTMP("BRNLINE",$JOB,1))
- Begin DoDot:2
- +36 SET K=$LENGTH(^XTMP("BRNLINE",$JOB,X))+1
- SET J=$LENGTH(^XTMP("BRNLINE",$JOB,1))
- FOR I=K:1:J
- SET ^XTMP("BRNLINE",$JOB,X)=^XTMP("BRNLINE",$JOB,X)_" "
- End DoDot:2
- End DoDot:1
- +37 QUIT
- +38 ;
- DIQ ;EP; called by field PRINT LOGIC in ROI REPORTING UTILITY SORT file
- +1 KILL BRNPRNT,BRNFILE,BRNFIEL
- +2 SET BRNFILE=$PIECE($PIECE(^BRNSORT(BRNCRIT,0),U,4),",")
- SET BRNFIEL=$PIECE($PIECE(^(0),U,4),",",2)
- +3 SET DIQ(0)="EN"
- SET DIQ="BRNPRNT("
- SET DIC=BRNFILE
- SET DR=BRNFIEL
- DO EN^DIQ1
- KILL DIC,DR,DIQ
- +4 IF '$DATA(BRNPRNT(BRNFILE,DA,BRNFIEL,"E"))
- SET BRNPRNT(BRNFILE,DA,BRNFIEL,"E")="--"
- +5 SET BRNPRNT=BRNPRNT(BRNFILE,DA,BRNFIEL,"E")
- +6 QUIT
- +7 ;
- HEAD ;ENTRY POINT
- +1 DO HEAD^BRNRUP2
- +2 QUIT