Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BRNRUP

BRNRUP.m

Go to the documentation of this file.
  1. BRNRUP ; IHS/OIT/LJF - REPORT UTILITY PRINT LOGIC
  1. ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
  1. ;IHS/OIT/LJF 10/25/2007 PATCH 1 Added this routine
  1. ;
  1. START ;EP - Begin processing print logic
  1. ; if user selected delimited file, go there
  1. I BRNCTYP="L" D DELIMIT^BRNRUP3 Q
  1. ;
  1. ; Otherwise, set up header line, dash line
  1. NEW I,J,K,X
  1. S BRNFCNT=0
  1. S X=0,BRNHEAD="" F S X=$O(^BRNRPT(BRNRPT,12,X)) Q:X'=+X D
  1. . S BRNHDR=$P(^BRNSORT($P(^BRNRPT(BRNRPT,12,X,0),U),0),U,6) ;column header
  1. . S BRNLENG=$P(^BRNRPT(BRNRPT,12,X,0),U,2),BRNHDR=$E(BRNHDR,1,BRNLENG) ;print item length
  1. . S J=$L(BRNHDR),BRNHEAD=BRNHEAD_BRNHDR,K=BRNLENG+1 F I=J:1:K S BRNHEAD=BRNHEAD_" " ;space items across page
  1. S BRNDASH="",$P(BRNDASH,"-",BRNTCW)="-" ;dash line
  1. ;
  1. S BRNTITL=$$GET1^DIQ(90264.8,BRNRPT,1303)
  1. ;
  1. D COVPAGE^BRNRUP1 ;print cover page - note: if user ^'s out of cover page, processing continues
  1. ;
  1. PROC ;process printing of report
  1. I BRNCTYP="T" D DONE^BRNRUP2 Q ; if displaying only total, that was done in the cover page - go to done
  1. ;
  1. S BRNPG=0 I '$D(^XTMP("BRNVL",BRNJOB,BRNBTH)) D DONE^BRNRUP2 Q
  1. ;
  1. S (BRNSRTV,BRNFRST)="" K BRNQUIT
  1. F S BRNSRTV=$O(^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRTV)) Q:BRNSRTV=""!($D(BRNQUIT)) D V
  1. I $D(BRNQUIT) D DONE^BRNRUP2 Q
  1. I $Y>(IOSL-4) D HEAD I $D(BRNQUIT) D DONE^BRNRUP2 Q
  1. I $D(BRNRCNT) W !!!,"Total Disclosure Requests: ",BRNRCNT
  1. W !,"Total Patients: ",BRNPTCT
  1. D DONE^BRNRUP2
  1. Q
  1. ;
  1. V ;GETS DATA HITS
  1. S BRNSCNT=0
  1. ;get readable sort value
  1. K BRNPRNT
  1. S BRNSRTR="",BRNVIEN=$O(^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRTV,0)) I BRNVIEN]"" S BRNCRIT=BRNSORT D
  1. . S BRNVREC=^BRNREC(BRNVIEN,0),DFN=$P(BRNVREC,U,3)
  1. . X:$D(^BRNSORT(BRNSORT,3)) ^(3) S BRNSRTR=BRNPRNT
  1. ;
  1. ; if first page or subtotal page, print heading
  1. I $G(BRNSPAG)!($D(BRNFRST)) K BRNFRST D HEAD Q:$D(BRNQUIT)
  1. ;
  1. ; pull each record
  1. S BRNVIEN=0 F S BRNVIEN=$O(^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRTV,BRNVIEN)) Q:BRNVIEN'=+BRNVIEN!($D(BRNQUIT)) D
  1. . S BRNVREC=^BRNREC(BRNVIEN,0),DFN=$P(BRNVREC,U,3) D PRINT
  1. ;
  1. Q:$D(BRNQUIT)
  1. I $Y>(IOSL-3) D HEAD Q:$D(BRNQUIT)
  1. ;
  1. I $G(BRNSPAG) D
  1. . W !!,"SUB-TOTAL for ",BRNSORV," ",$S(BRNSRTR]"":BRNSRTR,1:"*Unanswered*"),": ",BRNSCNT
  1. . W " # of PATIENTS: "
  1. . W $S($D(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV)):^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV),1:0)
  1. ;
  1. I BRNCTYP="S" D
  1. . W !,?10,$E($S(BRNSRTR]"":BRNSRTR,1:"*Unanswered*"),1,30)
  1. . W ?43,$J(BRNSCNT,8)," (Records)"
  1. . W ?53,$S($D(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV)):$J(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRTV),8),1:0)
  1. . W " (Patients)"
  1. Q
  1. ;
  1. PRINT ;
  1. S BRNSCNT=BRNSCNT+1 Q:BRNCTYP="S"
  1. K ^XTMP("BRNLINE",$J) S ^XTMP("BRNLINE",$J,1)=""
  1. I $Y>(IOSL-5) D HEAD Q:$D(BRNQUIT)
  1. 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
  1. . I '$P(^BRNSORT(BRNCRIT,0),U,8) D SINGLE Q
  1. . D MULT
  1. ;
  1. S BRNX=0 F S BRNX=$O(^XTMP("BRNLINE",$J,BRNX)) Q:BRNX'=+BRNX!($D(BRNQUIT)) D
  1. . I $Y>(IOSL-4) D HEAD Q:$D(BRNQUIT)
  1. . W !,^XTMP("BRNLINE",$J,BRNX)
  1. Q
  1. ;
  1. SINGLE ;process single valued item
  1. K BRNPRNT
  1. S BRNX=0
  1. X:$D(^BRNSORT(BRNCRIT,3)) ^(3) ;print logic
  1. S BRNLENG=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2),BRNPRNT=$E(BRNPRNT,1,BRNLENG) D
  1. . S J=$L(BRNPRNT),^XTMP("BRNLINE",$J,1)=^XTMP("BRNLINE",$J,1)_BRNPRNT
  1. . 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)_" "
  1. . S X=1 F S X=$O(^XTMP("BRNLINE",$J,X)) Q:X'=+X D
  1. . . I $L(^XTMP("BRNLINE",$J,X))<$L(^XTMP("BRNLINE",$J,1)) D
  1. . . . 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)_" "
  1. Q
  1. ;
  1. MULT ;process multiple valued item
  1. K BRNPRNT,BRNPRNM,BRNY S (BRNX,BRNPCNT)=0
  1. X:$D(^BRNSORT(BRNCRIT,3)) ^(3) ;set BRNPRNM array
  1. ;
  1. ; if user only wants those items that match screening criteria, delete the others in the array
  1. I $P(^BRNRPT(BRNRPT,12,BRNI,0),U,3) D
  1. . S X=0 F S X=$O(BRNPRNM(X)) Q:X'=+X D
  1. . .S Z=$G(BRNPRNM(X,"I")) I Z="" K BRNPRNM(X) Q
  1. . . I '$D(^BRNRPT(BRNRPT,11,BRNCRIT,11,"B",Z)) K BRNPRNM(X)
  1. ;
  1. ;reset array subscripts to account for deleted entries
  1. K Y S (X,C)=0 F S X=$O(BRNPRNM(X)) Q:X'=+X S C=C+1,Y(C)=BRNPRNM(X)
  1. K BRNPRNM S X=0 F S X=$O(Y(X)) Q:X'=+X S BRNPRNM(X)=Y(X)
  1. ;
  1. ; if nothing to print, use 2 dashes
  1. I '$D(BRNPRNM) S BRNPRNT="--" D
  1. . S BRNLENG=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2),BRNPRNT=$E(BRNPRNT,1,BRNLENG) D
  1. . . S J=$L(BRNPRNT),^XTMP("BRNLINE",$J,1)=^XTMP("BRNLINE",$J,1)_BRNPRNT
  1. . . 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)_" "
  1. ;
  1. ; loop through array and set print lines into ^XTMP
  1. S X=0 F S X=$O(BRNPRNM(X)) Q:X'=+X D
  1. . I X=1 D Q
  1. . . S BRNLENG=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2),BRNPRNT=$E(BRNPRNM(1),1,BRNLENG) D
  1. . . . S J=$L(BRNPRNT),^XTMP("BRNLINE",$J,1)=^XTMP("BRNLINE",$J,1)_BRNPRNT
  1. . . . 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)_" "
  1. . ;
  1. . S BRNLENG=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2),BRNPRNT=$E(BRNPRNM(X),1,BRNLENG) D
  1. . . I '$D(^XTMP("BRNLINE",$J,X)) D
  1. . . . S ^XTMP("BRNLINE",$J,X)="",K=$P(^BRNRPT(BRNRPT,12,BRNI,0),U,2)+1
  1. . . . S $P(^XTMP("BRNLINE",$J,X)," ",($L(^XTMP("BRNLINE",$J,1))-K))=""
  1. . . S J=$L(BRNPRNT),^XTMP("BRNLINE",$J,X)=^XTMP("BRNLINE",$J,X)_BRNPRNT
  1. . . 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)_" "
  1. ;
  1. S X=1 F S X=$O(^XTMP("BRNLINE",$J,X)) Q:X'=+X D
  1. . I $L(^XTMP("BRNLINE",$J,X))<$L(^XTMP("BRNLINE",$J,1)) D
  1. . . 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)_" "
  1. Q
  1. ;
  1. DIQ ;EP; called by field PRINT LOGIC in ROI REPORTING UTILITY SORT file
  1. K BRNPRNT,BRNFILE,BRNFIEL
  1. S BRNFILE=$P($P(^BRNSORT(BRNCRIT,0),U,4),","),BRNFIEL=$P($P(^(0),U,4),",",2)
  1. S DIQ(0)="EN",DIQ="BRNPRNT(",DIC=BRNFILE,DR=BRNFIEL D EN^DIQ1 K DIC,DR,DIQ
  1. I '$D(BRNPRNT(BRNFILE,DA,BRNFIEL,"E")) S BRNPRNT(BRNFILE,DA,BRNFIEL,"E")="--"
  1. S BRNPRNT=BRNPRNT(BRNFILE,DA,BRNFIEL,"E")
  1. Q
  1. ;
  1. D HEAD^BRNRUP2
  1. Q