BRNRU11 ; IHS/OIT/LJF - PROCESS VISIT LIST
;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
;IHS/OIT/LJF 10/25/2007 PATCH 1 Added this routine
;
;
START ;
; Known variables: BRNRPT=ien of temp report, BRNBD & BRNED = date range
S (BRNBT,BRNBTH)=$H,BRNJOB=$J,BRNRCNT=0
D XTMP^BRNU("BRNVL",BRNJOB,"ROI REPORTING UTILITY")
D RUN,END
Q
;
RUN ; Run by date request initiated
S X1=BRNBD,X2=-1 D C^%DTC S BRNSD=X
S BRNODAT=BRNSD_".9999" F S BRNODAT=$O(^BRNREC("B",BRNODAT)) Q:BRNODAT=""!((BRNODAT\1)>BRNED) D V1
Q
END ;
S BRNET=$H
Q
;
V1 ; Within each date, find all disclosure requests
S BRNVIEN="" F S BRNVIEN=$O(^BRNREC("B",BRNODAT,BRNVIEN)) Q:BRNVIEN'=+BRNVIEN I $D(^BRNREC(BRNVIEN,0)) D PROC
Q
;
PROC ; For each disclosure request, does it pass the selection criteria?
K BRNSPEC
S BRNVREC=^BRNREC(BRNVIEN,0),DFN=$P(BRNVREC,U,3)
Q:'$D(^DPT(DFN,0))
Q:'$D(^AUPNPAT(DFN,0))
D SCREENS ; run selection criteria
Q:$D(BRNSKIP) ; if it doesn't pass, skip it
;
; set sort (in printable format) for this entry
K BRNSRT S BRNCRIT=BRNSORT,BRNX=0
X:$D(^BRNSORT(BRNSORT,4)) ^BRNSORT(BRNSORT,4)
I '$D(BRNSRT) S BRNSRT=$P(^DPT(DFN,0),U)
;
; do subcounts
D SUBPAT
;
; set entries into arrays for printing
S ^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRT,BRNVIEN)="",BRNRCNT=BRNRCNT+1
Q:$D(^XTMP("BRNVL",BRNJOB,BRNBTH,"PATIENTS",DFN))
S ^XTMP("BRNVL",BRNJOB,BRNBTH,"PATIENTS",DFN)="",BRNPTCT=BRNPTCT+1
Q
;
SUBPAT ; tally # of patients by sort value on detailed/subtotal
Q:BRNCTYP="C"
Q:BRNCTYP="P"
Q:BRNCTYP="F"
Q:BRNCTYP="T"
Q:BRNCTYP="L"
S:$G(BRNSRT)="" BRNSRT="????"
Q:$D(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PATIENT HIT",BRNSRT,DFN))
S:'$D(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT)) ^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT)=0
S ^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT)=^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT)+1
Q:$D(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PATIENT HIT",BRNSRT,DFN))
S ^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PATIENT HIT",BRNSRT,DFN)=""
Q
;
SCREENS ; Check screen logic for this disclosure request
; loop through all selection criteria; BRNSKIP means does not meet criteria
K BRNSKIP
S BRNI=0 F S BRNI=$O(^BRNRPT(BRNRPT,11,BRNI)) Q:BRNI'=+BRNI!($D(BRNSKIP)) D
. I '$P(^BRNSORT(BRNI,0),U,8) D SINGLE Q
. D MULT
Q
;
SINGLE ; Logic sets X if this record (BRNVIEN) meets this criteria (BRNI)
; BRNRANG can be set by screen logic if screen is a range and not
; stored individually in the Temp Report global (ex. Age Range)
K X,BRNRANG S X="",BRNX=0
X:$D(^BRNSORT(BRNI,1)) ^(1)
I X="" S BRNSKIP="" Q
I '$D(BRNRANG),'$D(^BRNRPT(BRNRPT,11,BRNI,11,"B",X)) S BRNSKIP="" Q
I $G(BRNRANG) I ($P(^BRNRPT(BRNRPT,11,BRNI,11,1,0),U)>X)!(X>$P(^BRNRPT(BRNRPT,11,BRNI,11,1,0),U,2)) S BRNSKIP="" Q
Q
;
MULT ; Logic creates array of possible matches then loops thru multiple in temp report to see if any do
NEW FOUND,Y,X K BRNSKIP S X=""
X:$D(^BRNSORT(BRNI,1)) ^(1)
I $O(X(""))="" S BRNSKIP="" Q
S Y="" F S Y=$O(X(Y)) Q:Y="" I $D(^BRNRPT(BRNRPT,11,BRNI,11,"B",Y)) S FOUND="" Q
S:'$D(FOUND) BRNSKIP=""
Q
;
XIT ;EP - CALLED FROM BRNVL
K BRNBD,BRNBDD,BRNED,BRNEDD,BRNSD,BRNSORT,BRNSORV,BRNTCW,BRNRPT,BRNLHDR,BRNDISP,%H,BRNET,BRNLINE,BRNPRNM,BRNPRNT,BRNSKIP,BRNTYPE,BRNSPAG,BRNEN1,BRNSEAT,BRN,BRNCAND,BRNHDR,BRNHEAD,BRNSPEC,BRNOPT
K BRNCTYP,BRNFLG,BRNG,BRNNAME,BRNNIFN,BRNSAVE,BRNTITL,BRNQUIT,BRNPCNT,BRNQFLG,BRNPTCT,BRNTL,BRNSRTR,BRNSRTV,BRNFILE,BRNJD,BRNFCNT,BRNX1,BRNX2,BRNSDAT
K C,D,D0,DA,DIC,DD,DFN,DIADD,DLAYGO,DICR,DIE,DIK,DINUM,DIQ,DIR,DIRUT,DUOUT,DTOUT,DR,J,I,J,K,M,S,TS,X,Y,DIG,DIH,DIV,DQ,DDH,AMQQEN3,AMQQLX
XIT1 ;EP
K BRNANS,BRNBTH,BRNC,BRNCNT,BRNCRIT,BRNCUT,BRND,BRNDISP,BRNDONE,BRNHIGH,BRNI,BRNJOB,BRNQMAN,BRNSEL,BRNTEXT,BRNVAR,BRNSKIP,BRNPRNT,BRNPRNM,BRNLINE,BRNRCNT,BRNSCNT,BRNDFET,BRNY,DFN
K X,X1,X2,IO("Q"),%,Y,POP,DIRUT,H,S,TS,M,DUOUT,DIR,DTOUT,V,Z,I,DIC,DIK,DIADD,DLAYGO,DA,DR,DIE,DIU,AMQQTAX,DINUM,BRNPACK,BRNEP1,BRNEP2,D,BRNLENG,BRNLHDR,BRNSAVE,AMQQND
Q
BRNRU11 ; IHS/OIT/LJF - PROCESS VISIT LIST
+1 ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
+2 ;IHS/OIT/LJF 10/25/2007 PATCH 1 Added this routine
+3 ;
+4 ;
START ;
+1 ; Known variables: BRNRPT=ien of temp report, BRNBD & BRNED = date range
+2 SET (BRNBT,BRNBTH)=$HOROLOG
SET BRNJOB=$JOB
SET BRNRCNT=0
+3 DO XTMP^BRNU("BRNVL",BRNJOB,"ROI REPORTING UTILITY")
+4 DO RUN
DO END
+5 QUIT
+6 ;
RUN ; Run by date request initiated
+1 SET X1=BRNBD
SET X2=-1
DO C^%DTC
SET BRNSD=X
+2 SET BRNODAT=BRNSD_".9999"
FOR
SET BRNODAT=$ORDER(^BRNREC("B",BRNODAT))
IF BRNODAT=""!((BRNODAT\1)>BRNED)
QUIT
DO V1
+3 QUIT
END ;
+1 SET BRNET=$HOROLOG
+2 QUIT
+3 ;
V1 ; Within each date, find all disclosure requests
+1 SET BRNVIEN=""
FOR
SET BRNVIEN=$ORDER(^BRNREC("B",BRNODAT,BRNVIEN))
IF BRNVIEN'=+BRNVIEN
QUIT
IF $DATA(^BRNREC(BRNVIEN,0))
DO PROC
+2 QUIT
+3 ;
PROC ; For each disclosure request, does it pass the selection criteria?
+1 KILL BRNSPEC
+2 SET BRNVREC=^BRNREC(BRNVIEN,0)
SET DFN=$PIECE(BRNVREC,U,3)
+3 IF '$DATA(^DPT(DFN,0))
QUIT
+4 IF '$DATA(^AUPNPAT(DFN,0))
QUIT
+5 ; run selection criteria
DO SCREENS
+6 ; if it doesn't pass, skip it
IF $DATA(BRNSKIP)
QUIT
+7 ;
+8 ; set sort (in printable format) for this entry
+9 KILL BRNSRT
SET BRNCRIT=BRNSORT
SET BRNX=0
+10 IF $DATA(^BRNSORT(BRNSORT,4))
XECUTE ^BRNSORT(BRNSORT,4)
+11 IF '$DATA(BRNSRT)
SET BRNSRT=$PIECE(^DPT(DFN,0),U)
+12 ;
+13 ; do subcounts
+14 DO SUBPAT
+15 ;
+16 ; set entries into arrays for printing
+17 SET ^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRT,BRNVIEN)=""
SET BRNRCNT=BRNRCNT+1
+18 IF $DATA(^XTMP("BRNVL",BRNJOB,BRNBTH,"PATIENTS",DFN))
QUIT
+19 SET ^XTMP("BRNVL",BRNJOB,BRNBTH,"PATIENTS",DFN)=""
SET BRNPTCT=BRNPTCT+1
+20 QUIT
+21 ;
SUBPAT ; tally # of patients by sort value on detailed/subtotal
+1 IF BRNCTYP="C"
QUIT
+2 IF BRNCTYP="P"
QUIT
+3 IF BRNCTYP="F"
QUIT
+4 IF BRNCTYP="T"
QUIT
+5 IF BRNCTYP="L"
QUIT
+6 IF $GET(BRNSRT)=""
SET BRNSRT="????"
+7 IF $DATA(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PATIENT HIT",BRNSRT,DFN))
QUIT
+8 IF '$DATA(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT))
SET ^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT)=0
+9 SET ^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT)=^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT)+1
+10 IF $DATA(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PATIENT HIT",BRNSRT,DFN))
QUIT
+11 SET ^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PATIENT HIT",BRNSRT,DFN)=""
+12 QUIT
+13 ;
SCREENS ; Check screen logic for this disclosure request
+1 ; loop through all selection criteria; BRNSKIP means does not meet criteria
+2 KILL BRNSKIP
+3 SET BRNI=0
FOR
SET BRNI=$ORDER(^BRNRPT(BRNRPT,11,BRNI))
IF BRNI'=+BRNI!($DATA(BRNSKIP))
QUIT
Begin DoDot:1
+4 IF '$PIECE(^BRNSORT(BRNI,0),U,8)
DO SINGLE
QUIT
+5 DO MULT
End DoDot:1
+6 QUIT
+7 ;
SINGLE ; Logic sets X if this record (BRNVIEN) meets this criteria (BRNI)
+1 ; BRNRANG can be set by screen logic if screen is a range and not
+2 ; stored individually in the Temp Report global (ex. Age Range)
+3 KILL X,BRNRANG
SET X=""
SET BRNX=0
+4 IF $DATA(^BRNSORT(BRNI,1))
XECUTE ^(1)
+5 IF X=""
SET BRNSKIP=""
QUIT
+6 IF '$DATA(BRNRANG)
IF '$DATA(^BRNRPT(BRNRPT,11,BRNI,11,"B",X))
SET BRNSKIP=""
QUIT
+7 IF $GET(BRNRANG)
IF ($PIECE(^BRNRPT(BRNRPT,11,BRNI,11,1,0),U)>X)!(X>$PIECE(^BRNRPT(BRNRPT,11,BRNI,11,1,0),U,2))
SET BRNSKIP=""
QUIT
+8 QUIT
+9 ;
MULT ; Logic creates array of possible matches then loops thru multiple in temp report to see if any do
+1 NEW FOUND,Y,X
KILL BRNSKIP
SET X=""
+2 IF $DATA(^BRNSORT(BRNI,1))
XECUTE ^(1)
+3 IF $ORDER(X(""))=""
SET BRNSKIP=""
QUIT
+4 SET Y=""
FOR
SET Y=$ORDER(X(Y))
IF Y=""
QUIT
IF $DATA(^BRNRPT(BRNRPT,11,BRNI,11,"B",Y))
SET FOUND=""
QUIT
+5 IF '$DATA(FOUND)
SET BRNSKIP=""
+6 QUIT
+7 ;
XIT ;EP - CALLED FROM BRNVL
+1 KILL BRNBD,BRNBDD,BRNED,BRNEDD,BRNSD,BRNSORT,BRNSORV,BRNTCW,BRNRPT,BRNLHDR,BRNDISP,%H,BRNET,BRNLINE,BRNPRNM,BRNPRNT,BRNSKIP,BRNTYPE,BRNSPAG,BRNEN1,BRNSEAT,BRN,BRNCAND,BRNHDR,BRNHEAD,BRNSPEC,BRNOPT
+2 KILL BRNCTYP,BRNFLG,BRNG,BRNNAME,BRNNIFN,BRNSAVE,BRNTITL,BRNQUIT,BRNPCNT,BRNQFLG,BRNPTCT,BRNTL,BRNSRTR,BRNSRTV,BRNFILE,BRNJD,BRNFCNT,BRNX1,BRNX2,BRNSDAT
+3 KILL C,D,D0,DA,DIC,DD,DFN,DIADD,DLAYGO,DICR,DIE,DIK,DINUM,DIQ,DIR,DIRUT,DUOUT,DTOUT,DR,J,I,J,K,M,S,TS,X,Y,DIG,DIH,DIV,DQ,DDH,AMQQEN3,AMQQLX
XIT1 ;EP
+1 KILL BRNANS,BRNBTH,BRNC,BRNCNT,BRNCRIT,BRNCUT,BRND,BRNDISP,BRNDONE,BRNHIGH,BRNI,BRNJOB,BRNQMAN,BRNSEL,BRNTEXT,BRNVAR,BRNSKIP,BRNPRNT,BRNPRNM,BRNLINE,BRNRCNT,BRNSCNT,BRNDFET,BRNY,DFN
+2 KILL X,X1,X2,IO("Q"),%,Y,POP,DIRUT,H,S,TS,M,DUOUT,DIR,DTOUT,V,Z,I,DIC,DIK,DIADD,DLAYGO,DA,DR,DIE,DIU,AMQQTAX,DINUM,BRNPACK,BRNEP1,BRNEP2,D,BRNLENG,BRNLHDR,BRNSAVE,AMQQND
+3 QUIT
