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

BRNRU11.m

Go to the documentation of this file. 
  1. BRNRU11 ; IHS/OIT/LJF - PROCESS VISIT LIST
  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.  ;
  1. START ;
  1.  ; Known variables:  BRNRPT=ien of temp report, BRNBD & BRNED = date range
  1.  S (BRNBT,BRNBTH)=$H,BRNJOB=$J,BRNRCNT=0
  1.  D XTMP^BRNU("BRNVL",BRNJOB,"ROI REPORTING UTILITY")
  1.  D RUN,END
  1.  Q
  1.  ;
  1. RUN ; Run by date request initiated
  1.  S X1=BRNBD,X2=-1 D C^%DTC S BRNSD=X
  1.  S BRNODAT=BRNSD_".9999" F  S BRNODAT=$O(^BRNREC("B",BRNODAT)) Q:BRNODAT=""!((BRNODAT\1)>BRNED)  D V1
  1.  Q
  1. END ;
  1.  S BRNET=$H
  1.  Q
  1.  ;
  1. V1 ; Within each date, find all disclosure requests
  1.  S BRNVIEN="" F  S BRNVIEN=$O(^BRNREC("B",BRNODAT,BRNVIEN)) Q:BRNVIEN'=+BRNVIEN  I $D(^BRNREC(BRNVIEN,0)) D PROC
  1.  Q
  1.  ;
  1. PROC ; For each disclosure request, does it pass the selection criteria?
  1.  K BRNSPEC
  1.  S BRNVREC=^BRNREC(BRNVIEN,0),DFN=$P(BRNVREC,U,3)
  1.  Q:'$D(^DPT(DFN,0))
  1.  Q:'$D(^AUPNPAT(DFN,0))
  1.  D SCREENS       ; run selection criteria
  1.  Q:$D(BRNSKIP)   ; if it doesn't pass, skip it
  1.  ;
  1.  ; set sort (in printable format) for this entry
  1.  K BRNSRT S BRNCRIT=BRNSORT,BRNX=0
  1.  X:$D(^BRNSORT(BRNSORT,4)) ^BRNSORT(BRNSORT,4)
  1.  I '$D(BRNSRT) S BRNSRT=$P(^DPT(DFN,0),U)
  1.  ;
  1.  ; do subcounts
  1.  D SUBPAT
  1.  ;
  1.  ; set entries into arrays for printing
  1.  S ^XTMP("BRNVL",BRNJOB,BRNBTH,"DATA HITS",BRNSRT,BRNVIEN)="",BRNRCNT=BRNRCNT+1
  1.  Q:$D(^XTMP("BRNVL",BRNJOB,BRNBTH,"PATIENTS",DFN))
  1.  S ^XTMP("BRNVL",BRNJOB,BRNBTH,"PATIENTS",DFN)="",BRNPTCT=BRNPTCT+1
  1.  Q
  1.  ;
  1. SUBPAT ; tally # of patients by sort value on detailed/subtotal
  1.  Q:BRNCTYP="C"
  1.  Q:BRNCTYP="P"
  1.  Q:BRNCTYP="F"
  1.  Q:BRNCTYP="T"
  1.  Q:BRNCTYP="L"
  1.  S:$G(BRNSRT)="" BRNSRT="????"
  1.  Q:$D(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PATIENT HIT",BRNSRT,DFN))
  1.  S:'$D(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT)) ^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT)=0
  1.  S ^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT)=^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PAT COUNT",BRNSRT)+1
  1.  Q:$D(^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PATIENT HIT",BRNSRT,DFN))
  1.  S ^XTMP("BRNVL",BRNJOB,BRNBTH,"SUB PATIENT HIT",BRNSRT,DFN)=""
  1.  Q
  1.  ;
  1. SCREENS ; Check screen logic for this disclosure request
  1.  ; loop through all selection criteria; BRNSKIP means does not meet criteria
  1.  K BRNSKIP
  1.  S BRNI=0 F  S BRNI=$O(^BRNRPT(BRNRPT,11,BRNI)) Q:BRNI'=+BRNI!($D(BRNSKIP))  D
  1.  . I '$P(^BRNSORT(BRNI,0),U,8) D SINGLE Q
  1.  . D MULT
  1.  Q
  1.  ;
  1. 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
  1.  ;         stored individually in the Temp Report global (ex. Age Range)
  1.  K X,BRNRANG S X="",BRNX=0
  1.  X:$D(^BRNSORT(BRNI,1)) ^(1)
  1.  I X="" S BRNSKIP="" Q
  1.  I '$D(BRNRANG),'$D(^BRNRPT(BRNRPT,11,BRNI,11,"B",X)) S BRNSKIP="" Q
  1.  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
  1.  Q
  1.  ;
  1. MULT ; Logic creates array of possible matches then loops thru multiple in temp report to see if any do
  1.  NEW FOUND,Y,X K BRNSKIP S X=""
  1.  X:$D(^BRNSORT(BRNI,1)) ^(1)
  1.  I $O(X(""))="" S BRNSKIP="" Q
  1.  S Y="" F  S Y=$O(X(Y)) Q:Y=""  I $D(^BRNRPT(BRNRPT,11,BRNI,11,"B",Y)) S FOUND="" Q
  1.  S:'$D(FOUND) BRNSKIP=""
  1.  Q
  1.  ;
  1. XIT ;EP - CALLED FROM BRNVL
  1.  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
  1.  K BRNCTYP,BRNFLG,BRNG,BRNNAME,BRNNIFN,BRNSAVE,BRNTITL,BRNQUIT,BRNPCNT,BRNQFLG,BRNPTCT,BRNTL,BRNSRTR,BRNSRTV,BRNFILE,BRNJD,BRNFCNT,BRNX1,BRNX2,BRNSDAT
  1.  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
  1. XIT1 ;EP
  1.  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
  1.  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
  1.  Q