IBCNOR2 ;AITC/TAZ - IBCN BUFFER DAILY REPORT ;15-AUG-2023
;;2.0;INTEGRATED BILLING;**771,778,794**;21-MAR-94;Build 9
;;Per VA Directive 6402, this routine should not be modified.
;
;IB*794/DTG corrected date in line two from 16-SEP-09 to 21-MAR-94
;
; Variables:
; IBCNSPC("IBOUT") = "R" for Report format or "E" for Excel format
; IBCNSPC("TYPE") = report type: "S" - summary, "D" - detailed
;
Q
;
DBR ; Send Daily Buffer Report Email
N LOCALTIME,CURRTIME,MTIME,MSG,MGRP
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
;
I $$GET1^DIQ(350.9,"1,",54.02,"E")="" G DBRX ;No email address to receive the report.
;
S LOCALTIME=$$GET1^DIQ(350.9,"1,",51.03,"I")
I 'LOCALTIME G DBRX ; MM message time is not defined
;
S CURRTIME=$P($H,",",2) ; current $H time
S MTIME=DT_"."_LOCALTIME ; build a FileMan date/time
S MTIME=$$FMTH^XLFDT(MTIME) ; convert to $H format
S MTIME=$P(MTIME,",",2) ; $H time of MM message
;
; If the current time is after the MailMan message time, then schedule the message for tomorrow at that time.
; Otherwise, schedule it for later today.
S ZTDTH=$S(CURRTIME>MTIME:$H+1,1:+$H)_","_MTIME
;
; Set up the other TaskManager variables
S ZTRTN="EMAIL^IBCNOR2"
S ZTDESC="Daily Buffer Report Message"
S ZTIO=""
D ^%ZTLOAD ; Call TaskManager
;
DBRX ; Exit
Q
;
EMAIL ;Email a summary version of the report to a select email group
N EMAIL,IBOUT,MSG,SITE,TYPE,XMSUBJ,XMTO
S EMAIL=$$GET1^DIQ(350.9,"1,",54.02,"E") I EMAIL="" G EMAILX
K ^TMP($J,"IBCNOR2")
S IBOUT="R",TYPE="S"
;
D SNAPSHOT I $G(ZTSTOP) G PROCESSX
;
D PRINT
;
S SITE=$$SITE^VASITE
S XMSUBJ=$P(SITE,U,2)_" (#"_$P(SITE,U,3)_") Daily Buffer Report"
S XMTO(EMAIL)=""
D MSG^IBCNEUT5(,XMSUBJ,"MSG(",,.XMTO) ; Send a MailMan Message
;
EMAILX ; Exit
Q
;
EN ; entry point
N IBCNSPC,STOP,TYPE
;
S STOP=0
W @IOF
W !,"This report displays data from the Process Insurance Buffer option, otherwise"
W !,"known as ""the Buffer"". It is real time data that is constantly changing;"
W !,"therefore, the numbers and dates reflected in this report are never the same"
W !,"minute to minute, hour by hour, or day by day. This report output is only"
W !,"accurate to the exact date and time it is produced. The Insurance Company"
W !,"section of this report is based on free text fields and may not be reflective"
W !,"of actual category counts due to spelling errors in the free text Insurance"
W !,"Company field."
;
; Report Type - Summary or Detailed
TYPE ;Type of Report
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^S:Summary;D:Detailed"
S DIR("A")="Run a (S)ummary or (D)etailed Report: "
S DIR("B")="Summary"
D ^DIR
I $D(DIRUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) G EXIT
S (TYPE,IBCNSPC("TYPE"))=Y
;
IBOUT ;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^E:Excel;R:Report"
S DIR("A")="(E)xcel Format or (R)eport Format: "
S DIR("B")="Report"
D ^DIR
I $D(DIRUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) G EXIT
S IBCNSPC("IBOUT")=Y
I Y="E" D
. W !!,"For CSV output, turn logging or capture on now. To avoid undesired wrapping"
. W !,"of the data saved to the file, please enter "_$S(TYPE="S":"0;132;99999",1:"0;80;99999")_" at the ""DEVICE:"""
. W !,"prompt.",!
;
; Select the output device
DEVICE ; Device Handler and possible TaskManager calls
;
; Output params:
; STOP = Flag to stop routine
;
; Init vars
N POP,ZTDESC,ZTRTN,ZTSAVE
;
S ZTRTN="PROCESS^IBCNOR2(.IBCNSPC)"
S ZTDESC="IBCN Daily Buffer Report"
S ZTSAVE("IBCNSPC(")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
;
EXIT ;
Q
;
PROCESS(IBCNSPC) ;
; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
; Input params:
; IBCNSPC = Array passed by ref of the report params
;
; Init scratch globals
N CRT,DATE,IBOUT,TYPE,ZTQUEUED,ZTREQ,ZTSTOP
K ^TMP($J,"IBCNOR2")
S IBOUT=$G(IBCNSPC("IBOUT"))
S TYPE=$G(IBCNSPC("TYPE"))
I IOST["C-" S CRT=1
;
D SNAPSHOT I $G(ZTSTOP) G PROCESSX
;
;
I TYPE="D" D I $G(ZTSTOP) G PROCESSX
. D INIT I $G(ZTSTOP) Q
. D COMPILE I $G(ZTSTOP) Q
;
D PRINT
;
PROCESSX ; exit
; Kill scratch globals
K ^TMP($J,"IBCNOR2")
;
; Purge task record
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
SNAPSHOT ;Grab a snapshot of the data right now.
N BACKLOG,BCNT,CNT,DATE,IEN,OLDEST,WBACKLOG,WCNT
S BACKLOG=$$BACKLOG(DT,0)
S WBACKLOG=$$BACKLOG($$FMADD^XLFDT(DT,-7),1)
S DATE="",(BCNT,CNT,WCNT)=0,CRT=+$G(CRT)
I CRT W !,"Building Snapshot..."
F S DATE=$O(^IBA(355.33,"AEST","E",DATE)) Q:'DATE D
. ;I CNT<1 S ^TMP($J,"IBCNOR2","SUM","OLDEST DATE")=DATE ;IB*778/DTG moved to avoid bad records.
. ;
. S IEN=""
. F S IEN=$O(^IBA(355.33,"AEST","E",DATE,IEN)) Q:'IEN D
.. ;
.. I '$D(^IBA(355.33,IEN,0)) Q ; IB*778/DTG if node 0 for IEN not there, go back
.. I CNT<1 S ^TMP($J,"IBCNOR2","SUM","OLDEST DATE")=DATE ;IB*778
.. ;
.. N IBARY,IBY,IENS,DFN
.. S IENS=IEN_",",CNT=CNT+1 I CRT,'(CNT#100) W "."
.. I DATE<BACKLOG S BCNT=BCNT+1
.. I DATE<WBACKLOG S WCNT=WCNT+1
.. D GETS^DIQ(355.33,IENS,".01;.03;.04;20.01;60.01","EI","IBARY")
.. M ^TMP($J,"IBCNOR2","DATA")=IBARY(355.33)
.. S DFN=IBARY(355.33,IENS,60.01,"I")
.. S IBY="" D FLAGS^IBCNBLL(DFN,.IBY)
.. S ^TMP($J,"IBCNOR2","DATA",IENS,"FLAGS")=$TR(IBY," ")
S ^TMP($J,"IBCNOR2","SUM","TOTAL ENTRIES")=CNT
S ^TMP($J,"IBCNOR2","SUM","BACKLOG")=BCNT
S ^TMP($J,"IBCNOR2","SUM","WBACKLOG")=WCNT
;
; IB*778/DTG change for oldest date check
; S OLDEST=$G(^TMP($J,"IBCNOR2","SUM","OLDEST DATE")) S ^TMP($J,"IBCNOR2","SUM","AGE")=$S(OLDEST:$$FMDIFF^XLFDT(DT,OLDEST),1:0)
S OLDEST=$S(CNT<1:"",1:$G(^TMP($J,"IBCNOR2","SUM","OLDEST DATE")))
S ^TMP($J,"IBCNOR2","SUM","AGE")=$S(OLDEST:$$FMDIFF^XLFDT(DT,OLDEST),1:0)
;
Q
;
BACKLOG(DATE,WED) ;Calculate Backlog Date to T-6 business days so that T-7 inclusive shows on the report.
N BACKLOG,DOW
S DOW=$E($$DOW^XLFDT(DATE),1,2)
I DOW="Su" S BACKLOG=$$FMADD^XLFDT(DATE,$S(WED:+4,1:-10)) G BACKLOGX
I DOW="Mo" S BACKLOG=$$FMADD^XLFDT(DATE,$S(WED:+3,1:-10)) G BACKLOGX
I DOW="Tu" S BACKLOG=$$FMADD^XLFDT(DATE,$S(WED:+2,1:-8)) G BACKLOGX
I DOW="We" S BACKLOG=$$FMADD^XLFDT(DATE,$S(WED:+1,1:-8)) G BACKLOGX
I DOW="Th" S BACKLOG=$$FMADD^XLFDT(DATE,$S(WED:-0,1:-8)) G BACKLOGX
I DOW="Fr" S BACKLOG=$$FMADD^XLFDT(DATE,$S(WED:-1,1:-8)) G BACKLOGX
I DOW="Sa" S BACKLOG=$$FMADD^XLFDT(DATE,$S(WED:-2,1:-9)) G BACKLOGX
BACKLOGX ;Exit Backlog Date calculation
Q BACKLOG
;
INIT ;Initialize the ^TMP global
;Initialize the Report Global Array
N CAT,CATS,LINE,PCE
F LINE=1:1 S CATS=$P($T(CATNDT+LINE),";;",2) Q:CATS="" D
. F PCE=1:1 S CAT=$P(CATS,U,PCE) Q:CAT="" D
.. S ^TMP($J,"IBCNOR2","DET",CAT)=0
F LINE=1:1 S CATS=$P($T(CATWDT+LINE),";;",2) Q:CATS="" D
. F PCE=1:1 S CAT=$P(CATS,U,PCE) Q:CAT="" D
.. S ^TMP($J,"IBCNOR2","DET",CAT)=0
.. S ^TMP($J,"IBCNOR2","DET",CAT,"DATE")=""
.. I CAT'="MEDICARE" Q
F LINE=1:1 S CATS=$P($T(TOTALS+LINE),";;",2) Q:CATS="" D
. F PCE=1:1 S CAT=$P(CATS,U,PCE) Q:CAT="" D
.. S ^TMP($J,"IBCNOR2","TOT",CAT)=0
;
INITX ;Exit
Q
;
COMPILE ; Compile the report
N CNT,IEN,INSCO,TOT
S (CNT,IEN)=0
I CRT W !,"Compiling Data..."
F CNT=1:1 S IEN=$O(^TMP($J,"IBCNOR2","DATA",IEN)) Q:'IEN D
. I CRT,'(CNT#100) W "."
. N ARRAY
. M ARRAY=^TMP($J,"IBCNOR2","DATA",IEN)
. D UPDATE("TOT","MCCF vs. non-MCCF")
. S INSCO=$$UP^XLFSTR($G(ARRAY(20.01,"E")))
. D ;Process Insurance Company
.. D UPDATE("TOT","Insurance Company Category")
.. I INSCO["TRICARE" D UPDATE("DET","TRICARE"),UPDATE("DET","Non-MCCF") Q
.. I INSCO["CHAMPVA" D UPDATE("DET","CHAMPVA"),UPDATE("DET","Non-MCCF") Q
.. D UPDATE("DET","MCCF")
.. I INSCO["MEDICARE" D Q
... D UPDATE("DET","MEDICARE")
... I INSCO="MEDICARE PART D (WNR)" D UPDATE("DET","MEDICARE PART D (WNR)")
.. I INSCO="NO INSURANCE" D UPDATE("DET","NO INSURANCE") Q
.. I INSCO="PATIENT REFUSED" D UPDATE("DET","PATIENT REFUSED") Q
.. I INSCO="CMS MBI ONLY" D UPDATE("DET","CMS MBI ONLY") Q
.. D UPDATE("DET","ALL OTHER")
. D ;Process Patient Status
.. D UPDATE("TOT","Patient Status")
.. N FLAG,FLAGS,POS
.. S FLAGS=$G(ARRAY("FLAGS"))
.. I FLAGS="" D UPDATE("DET","blank")
.. F POS=1:1:$L(FLAGS) S FLAG=$E(FLAGS,POS) D
... I FLAG="i" D UPDATE("DET","i ACTIVE INSURANCE") Q
... I FLAG="I" D UPDATE("DET","I INPATIENT") Q
... I FLAG="E" D UPDATE("DET","E DECEASED") Q
... I FLAG="Y" D UPDATE("DET","Y COPAY REQUIRED") Q
... I FLAG="H" D UPDATE("DET","H CHARGES ON HOLD") Q
. D ;Process Source of Informtion
.. D UPDATE("TOT","Source of Information")
.. N SOI
.. S SOI=$G(ARRAY(.03,"E"))
.. I '$D(^TMP($J,"IBCNOR2","SOI",SOI)) D
... S ^TMP($J,"IBCNOR2","SOI",SOI)=0
... S ^TMP($J,"IBCNOR2","SOI",SOI,"DATE")=""
.. D UPDATE("SOI",SOI) Q
;
COMPILEX ; Exit Compile
Q
;
UPDATE(LVL,NODE) ;Increase a node
N TOT
I LVL="" G UPDATEX
I NODE="" G UPDATEX
S TOT=^TMP($J,"IBCNOR2",LVL,NODE)+1,^TMP($J,"IBCNOR2",LVL,NODE)=TOT
D OLDDATE(LVL,NODE,ARRAY(.01,"I"))
UPDATEX ;Exit
Q
;
OLDDATE(LVL,NODE,DATE) ; Calculate the oldest date for the categories tracked.
N GDATE
I '$D(^TMP($J,"IBCNOR2",LVL,NODE,"DATE")) G OLDDATEX ;Not calculating
S GDATE=^TMP($J,"IBCNOR2",LVL,NODE,"DATE")
I 'GDATE S GDATE=DATE
I GDATE,(DATE<GDATE) S GDATE=DATE
S ^TMP($J,"IBCNOR2",LVL,NODE,"DATE")=GDATE
;
OLDDATEX ; Exit oldest date calculation
Q
;
PRINT ; Print the report
N CRT,EORMSG,IBPGC,IBPXT,MAXCNT,PL,SLINE,SOI,TSTAMP
S EORMSG="*****END OF REPORT*****"
S TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1) ; time of report
S PL=IOSL-6,(CRT,IBPGC,IBPXT)=0
S:IOST["C-" PL=IOSL-3,CRT=1
S $P(SLINE,"=",14)="",$P(LINE,"=",79)="",TAB=$S(IBOUT="E":"^",1:"?"_53)
D HDR I IBPXT G PRINTX
I IBOUT="E",TYPE="S" D G PRINTX
. S DLINE="OLDEST DATE^AGE OF OLDEST^TOTAL NUMBER OF ENTRIES^*TOTAL T-7 BACKLOG^TOTAL WEDNESDAY BACKLOG" D WRTLNX
. S DATA=$G(^TMP($J,"IBCNOR2","SUM","OLDEST DATE")) S DLINE=$S(DATA:$$FMTDT(DATA),1:"")
. S DATA=$FN(^TMP($J,"IBCNOR2","SUM","AGE"),",") S DLINE=DLINE_U_DATA
. S DATA=$FN(^TMP($J,"IBCNOR2","SUM","TOTAL ENTRIES"),",") S DLINE=DLINE_U_DATA
. S DATA=$FN(^TMP($J,"IBCNOR2","SUM","BACKLOG"),",") S DLINE=DLINE_U_DATA
. S DATA=$FN(^TMP($J,"IBCNOR2","SUM","WBACKLOG"),",") S DLINE=DLINE_U_DATA
. D WRTLNX
D WRTLN("Oldest Date","OLDEST DATE","D","SUM") I IBPXT G PRINTX
D WRTLN("Age of Oldest","AGE","N","SUM") I IBPXT G PRINTX
D WRTLN("Total Number of Entries","TOTAL ENTRIES","N","SUM") I IBPXT G PRINTX
D WRTLN("*Total T-7 Backlog","BACKLOG","N","SUM") I IBPXT G PRINTX
D WRTLN("Total Wednesday Backlog","WBACKLOG","N","SUM") I IBPXT G PRINTX
I TYPE="S" G PRINTX
D WRTLN("Total MCCF vs. non-MCCF","MCCF vs. non-MCCF","N","TOT") I IBPXT G PRINTX
D WRTLN(" MCCF","MCCF","N","DET") I IBPXT G PRINTX
D WRTLN(" Non-MCCF","Non-MCCF","N","DET") I IBPXT G PRINTX
D WRTLN("Total Number of Entries by Insurance Company Category","Insurance Company Category","N","TOT") I IBPXT G PRINTX
D WRTLN(" TRICARE","TRICARE","N","DET") I IBPXT G PRINTX
D WRTLN(" CHAMPVA","CHAMPVA","N","DET") I IBPXT G PRINTX
D WRTLN(" MEDICARE","MEDICARE","N","DET") I IBPXT G PRINTX
D WRTLN(" MEDICARE PART D (WNR)","MEDICARE PART D (WNR)","N","DET") I IBPXT G PRINTX
D WRTLN(" CMS MBI ONLY","CMS MBI ONLY","N","DET") I IBPXT G PRINTX
D WRTLN(" NO INSURANCE","NO INSURANCE","N","DET") I IBPXT G PRINTX
D WRTLN(" PATIENT REFUSED","PATIENT REFUSED","N","DET") I IBPXT G PRINTX
D WRTLN(" All OTHER","ALL OTHER","N","DET") I IBPXT G PRINTX
D WRTLN("Total Number of Entries by Patient Status","Patient Status","N","TOT") I IBPXT G PRINTX
D WRTLN(" i ACTIVE INSURANCE","i ACTIVE INSURANCE","N","DET") I IBPXT G PRINTX
D WRTLN(" I INPATIENT","I INPATIENT","N","DET") I IBPXT G PRINTX
D WRTLN(" E DECEASED","E DECEASED","N","DET") I IBPXT G PRINTX
D WRTLN(" Y CO-PAY REQUIRED","Y COPAY REQUIRED","N","DET") I IBPXT G PRINTX
D WRTLN(" H CHARGES ON HOLD","H CHARGES ON HOLD","N","DET") I IBPXT G PRINTX
D WRTLN(" blank","blank","N","DET") I IBPXT G PRINTX
D WRTLN("Total Number of Entries by Source of Information","Source of Information","N","TOT") I IBPXT G PRINTX
S SOI=""
F S SOI=$O(^TMP($J,"IBCNOR2","SOI",SOI)) Q:SOI="" D I IBPXT Q
. D WRTLN(" "_SOI,SOI,"N","SOI")
;
PRINTX ; Exit Print
I 'IBPXT D EOP(1)
Q
;
FMTDT(DATE) ;Format the date
I $L(DATE) S DATE=$TR($$FMTE^XLFDT(DATE,"5FD")," ","0")
FMTDTX ;Exit
Q DATE
;
WRTLN(TITLE,NODE,DTYPE,LEVEL) ;Write the line
N DATA,DATE,DLINE,NUM,TAB,TAB1
S TAB=$S(TITLE["PART D":35,LEVEL="TOT":55,1:30)
S TAB1=$S(TITLE["PART D":50,1:45)
I $Y+1>PL,IBOUT="R",'$D(EMAIL) D HDR I $G(ZTSTOP)!IBPXT Q
I LEVEL="DET" D G WRTLNX
. S DATA=$G(^TMP($J,"IBCNOR2","DET",NODE))
. S DATA=$FN(+DATA,",") I IBOUT="R" S DATA=$$RJ^XLFSTR(DATA,7)
. S DLINE=TITLE
. I IBOUT="E" S DLINE=DLINE_"^"_DATA
. I IBOUT="R" S $E(DLINE,TAB)=DATA
. S DATA=$G(^TMP($J,"IBCNOR2","DET",NODE,"DATE"))
. I DATA]"" D
.. S DATA=$$FMTDT(DATA)
.. I IBOUT="E" D Q
... D WRTLNX
... S DLINE=TITLE_" OLDEST^"_DATA
.. S $E(DLINE,TAB1)=DATA
I LEVEL="SOI" D G WRTLNX
. S DATA=$G(^TMP($J,"IBCNOR2","SOI",NODE))
. S DATA=$FN(+DATA,",") I IBOUT="R" S DATA=$$RJ^XLFSTR(DATA,7)
. S DLINE=TITLE
. I IBOUT="E" S DLINE=DLINE_"^"_DATA
. I IBOUT="R" S $E(DLINE,TAB)=DATA
. S DATA=$G(^TMP($J,"IBCNOR2","SOI",NODE,"DATE"))
. I DATA]"" D
.. S DATA=$$FMTDT(DATA)
.. I IBOUT="E" D Q
... D WRTLNX
... S DLINE=TITLE_" OLDEST^"_DATA
.. S $E(DLINE,TAB1)=DATA
I LEVEL="SUM" D G WRTLNX
. S DATA=$G(^TMP($J,"IBCNOR2","SUM",NODE))
. I DTYPE="D" S DATA=$$FMTDT(DATA)
. I DTYPE="N" S DATA=$FN(+DATA,",") I IBOUT="R" S DATA=$$RJ^XLFSTR(DATA,7)
. S DLINE=TITLE
. I IBOUT="E" S DLINE=DLINE_"^"_DATA
. I IBOUT="R" S $E(DLINE,TAB)=DATA
I LEVEL="TOT" D G WRTLNX
. S DLINE="" D WRTLNX
. S DATA=$G(^TMP($J,"IBCNOR2","TOT",NODE))
. I NODE="Patient Status" S DATA="N/A"
. I NODE'="Patient Status" S DATA=$FN(+DATA,",")
. I IBOUT="R" S DATA=$$RJ^XLFSTR(DATA,7)
. S DLINE=TITLE
. I IBOUT="E" S DLINE=DLINE_"^"_DATA
. I IBOUT="R" S $E(DLINE,TAB)=DATA
. D WRTLNX
. S DLINE=$S(IBOUT="R":" ",1:"")_SLINE
WRTLNX ;Exit
I $D(EMAIL) S CNT=$G(MSG)+1,MSG=CNT,MSG(CNT)=DLINE Q
W !,DLINE
Q
;
HDR ;Print Header
N STRING,TAB
I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,IBPXT)=1 G HDRX
I CRT,(IBPGC>0),'$D(ZTQUEUED) D EOP(0) I IBPXT G HDRX
S IBPGC=IBPGC+1
I '$D(EMAIL) W @IOF
S STRING=TSTAMP I IBOUT="R" S STRING=STRING_" Page: "_IBPGC
S TAB=$S(IBOUT="E":24,1:80-($L(STRING)+3))
S DLINE="Daily Buffer Report",$E(DLINE,TAB)=STRING D WRTLNX
S DLINE=$S(TYPE="S":"Summary",1:"Detail") D WRTLNX
S DLINE="*Entries > 7 weekdays, where T=1 if weekday. Otherwise, T= previous Friday." D WRTLNX
I IBOUT="E" G HDRX
S DLINE=LINE D WRTLNX
S DLINE="" D WRTLNX
;
HDRX ; Header Exit
Q
;
EOP(END) ; display "end of page" message and set exit flag
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIN
I END D
. S DLINE="" D WRTLNX
. S DLINE="*****END OF REPORT*****" D WRTLNX
I 'CRT!$D(EMAIL) G EOPQ
I PL<51 F LIN=1:1:(PL-$Y)-1 W !
W !
S DIR(0)="E" D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S IBPXT=1
EOPQ ;
Q
;
CATNDT ; Report categories with no oldest date
;;MCCF^Non-MCCF^i ACTIVE INSURANCE^I INPATIENT^E DECEASED^Y COPAY REQUIRED^
;;H CHARGES ON HOLD^blank^
;;
CATWDT ; Report categories with oldest date
;;TRICARE^CHAMPVA^MEDICARE^MEDICARE PART D (WNR)^CMS MBI ONLY^NO INSURANCE^
;;PATIENT REFUSED^ALL OTHER^
;;
TOTALS ;Category Totals
;;MCCF vs. non-MCCF^Insurance Company Category^Patient Status^Source of Information^
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNOR2 15819 printed Nov 22, 2024@17:26:10 Page 2
IBCNOR2 ;AITC/TAZ - IBCN BUFFER DAILY REPORT ;15-AUG-2023
+1 ;;2.0;INTEGRATED BILLING;**771,778,794**;21-MAR-94;Build 9
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;IB*794/DTG corrected date in line two from 16-SEP-09 to 21-MAR-94
+5 ;
+6 ; Variables:
+7 ; IBCNSPC("IBOUT") = "R" for Report format or "E" for Excel format
+8 ; IBCNSPC("TYPE") = report type: "S" - summary, "D" - detailed
+9 ;
+10 QUIT
+11 ;
DBR ; Send Daily Buffer Report Email
+1 NEW LOCALTIME,CURRTIME,MTIME,MSG,MGRP
+2 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
+3 ;
+4 ;No email address to receive the report.
IF $$GET1^DIQ(350.9,"1,",54.02,"E")=""
GOTO DBRX
+5 ;
+6 SET LOCALTIME=$$GET1^DIQ(350.9,"1,",51.03,"I")
+7 ; MM message time is not defined
IF 'LOCALTIME
GOTO DBRX
+8 ;
+9 ; current $H time
SET CURRTIME=$PIECE($HOROLOG,",",2)
+10 ; build a FileMan date/time
SET MTIME=DT_"."_LOCALTIME
+11 ; convert to $H format
SET MTIME=$$FMTH^XLFDT(MTIME)
+12 ; $H time of MM message
SET MTIME=$PIECE(MTIME,",",2)
+13 ;
+14 ; If the current time is after the MailMan message time, then schedule the message for tomorrow at that time.
+15 ; Otherwise, schedule it for later today.
+16 SET ZTDTH=$SELECT(CURRTIME>MTIME:$HOROLOG+1,1:+$HOROLOG)_","_MTIME
+17 ;
+18 ; Set up the other TaskManager variables
+19 SET ZTRTN="EMAIL^IBCNOR2"
+20 SET ZTDESC="Daily Buffer Report Message"
+21 SET ZTIO=""
+22 ; Call TaskManager
DO ^%ZTLOAD
+23 ;
DBRX ; Exit
+1 QUIT
+2 ;
EMAIL ;Email a summary version of the report to a select email group
+1 NEW EMAIL,IBOUT,MSG,SITE,TYPE,XMSUBJ,XMTO
+2 SET EMAIL=$$GET1^DIQ(350.9,"1,",54.02,"E")
IF EMAIL=""
GOTO EMAILX
+3 KILL ^TMP($JOB,"IBCNOR2")
+4 SET IBOUT="R"
SET TYPE="S"
+5 ;
+6 DO SNAPSHOT
IF $GET(ZTSTOP)
GOTO PROCESSX
+7 ;
+8 DO PRINT
+9 ;
+10 SET SITE=$$SITE^VASITE
+11 SET XMSUBJ=$PIECE(SITE,U,2)_" (#"_$PIECE(SITE,U,3)_") Daily Buffer Report"
+12 SET XMTO(EMAIL)=""
+13 ; Send a MailMan Message
DO MSG^IBCNEUT5(,XMSUBJ,"MSG(",,.XMTO)
+14 ;
EMAILX ; Exit
+1 QUIT
+2 ;
EN ; entry point
+1 NEW IBCNSPC,STOP,TYPE
+2 ;
+3 SET STOP=0
+4 WRITE @IOF
+5 WRITE !,"This report displays data from the Process Insurance Buffer option, otherwise"
+6 WRITE !,"known as ""the Buffer"". It is real time data that is constantly changing;"
+7 WRITE !,"therefore, the numbers and dates reflected in this report are never the same"
+8 WRITE !,"minute to minute, hour by hour, or day by day. This report output is only"
+9 WRITE !,"accurate to the exact date and time it is produced. The Insurance Company"
+10 WRITE !,"section of this report is based on free text fields and may not be reflective"
+11 WRITE !,"of actual category counts due to spelling errors in the free text Insurance"
+12 WRITE !,"Company field."
+13 ;
+14 ; Report Type - Summary or Detailed
TYPE ;Type of Report
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^S:Summary;D:Detailed"
+4 SET DIR("A")="Run a (S)ummary or (D)etailed Report: "
+5 SET DIR("B")="Summary"
+6 DO ^DIR
+7 IF $DATA(DIRUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
+8 SET (TYPE,IBCNSPC("TYPE"))=Y
+9 ;
IBOUT ;
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^E:Excel;R:Report"
+4 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+5 SET DIR("B")="Report"
+6 DO ^DIR
+7 IF $DATA(DIRUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
+8 SET IBCNSPC("IBOUT")=Y
+9 IF Y="E"
Begin DoDot:1
+10 WRITE !!,"For CSV output, turn logging or capture on now. To avoid undesired wrapping"
+11 WRITE !,"of the data saved to the file, please enter "_$SELECT(TYPE="S":"0;132;99999",1:"0;80;99999")_" at the ""DEVICE:"""
+12 WRITE !,"prompt.",!
End DoDot:1
+13 ;
+14 ; Select the output device
DEVICE ; Device Handler and possible TaskManager calls
+1 ;
+2 ; Output params:
+3 ; STOP = Flag to stop routine
+4 ;
+5 ; Init vars
+6 NEW POP,ZTDESC,ZTRTN,ZTSAVE
+7 ;
+8 SET ZTRTN="PROCESS^IBCNOR2(.IBCNSPC)"
+9 SET ZTDESC="IBCN Daily Buffer Report"
+10 SET ZTSAVE("IBCNSPC(")=""
+11 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
+12 ;
EXIT ;
+1 QUIT
+2 ;
PROCESS(IBCNSPC) ;
+1 ; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
+2 ; Input params:
+3 ; IBCNSPC = Array passed by ref of the report params
+4 ;
+5 ; Init scratch globals
+6 NEW CRT,DATE,IBOUT,TYPE,ZTQUEUED,ZTREQ,ZTSTOP
+7 KILL ^TMP($JOB,"IBCNOR2")
+8 SET IBOUT=$GET(IBCNSPC("IBOUT"))
+9 SET TYPE=$GET(IBCNSPC("TYPE"))
+10 IF IOST["C-"
SET CRT=1
+11 ;
+12 DO SNAPSHOT
IF $GET(ZTSTOP)
GOTO PROCESSX
+13 ;
+14 ;
+15 IF TYPE="D"
Begin DoDot:1
+16 DO INIT
IF $GET(ZTSTOP)
QUIT
+17 DO COMPILE
IF $GET(ZTSTOP)
QUIT
End DoDot:1
IF $GET(ZTSTOP)
GOTO PROCESSX
+18 ;
+19 DO PRINT
+20 ;
PROCESSX ; exit
+1 ; Kill scratch globals
+2 KILL ^TMP($JOB,"IBCNOR2")
+3 ;
+4 ; Purge task record
+5 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 QUIT
+7 ;
SNAPSHOT ;Grab a snapshot of the data right now.
+1 NEW BACKLOG,BCNT,CNT,DATE,IEN,OLDEST,WBACKLOG,WCNT
+2 SET BACKLOG=$$BACKLOG(DT,0)
+3 SET WBACKLOG=$$BACKLOG($$FMADD^XLFDT(DT,-7),1)
+4 SET DATE=""
SET (BCNT,CNT,WCNT)=0
SET CRT=+$GET(CRT)
+5 IF CRT
WRITE !,"Building Snapshot..."
+6 FOR
SET DATE=$ORDER(^IBA(355.33,"AEST","E",DATE))
if 'DATE
QUIT
Begin DoDot:1
+7 ;I CNT<1 S ^TMP($J,"IBCNOR2","SUM","OLDEST DATE")=DATE ;IB*778/DTG moved to avoid bad records.
+8 ;
+9 SET IEN=""
+10 FOR
SET IEN=$ORDER(^IBA(355.33,"AEST","E",DATE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+11 ;
+12 ; IB*778/DTG if node 0 for IEN not there, go back
IF '$DATA(^IBA(355.33,IEN,0))
QUIT
+13 ;IB*778
IF CNT<1
SET ^TMP($JOB,"IBCNOR2","SUM","OLDEST DATE")=DATE
+14 ;
+15 NEW IBARY,IBY,IENS,DFN
+16 SET IENS=IEN_","
SET CNT=CNT+1
IF CRT
IF '(CNT#100)
WRITE "."
+17 IF DATE<BACKLOG
SET BCNT=BCNT+1
+18 IF DATE<WBACKLOG
SET WCNT=WCNT+1
+19 DO GETS^DIQ(355.33,IENS,".01;.03;.04;20.01;60.01","EI","IBARY")
+20 MERGE ^TMP($JOB,"IBCNOR2","DATA")=IBARY(355.33)
+21 SET DFN=IBARY(355.33,IENS,60.01,"I")
+22 SET IBY=""
DO FLAGS^IBCNBLL(DFN,.IBY)
+23 SET ^TMP($JOB,"IBCNOR2","DATA",IENS,"FLAGS")=$TRANSLATE(IBY," ")
End DoDot:2
End DoDot:1
+24 SET ^TMP($JOB,"IBCNOR2","SUM","TOTAL ENTRIES")=CNT
+25 SET ^TMP($JOB,"IBCNOR2","SUM","BACKLOG")=BCNT
+26 SET ^TMP($JOB,"IBCNOR2","SUM","WBACKLOG")=WCNT
+27 ;
+28 ; IB*778/DTG change for oldest date check
+29 ; S OLDEST=$G(^TMP($J,"IBCNOR2","SUM","OLDEST DATE")) S ^TMP($J,"IBCNOR2","SUM","AGE")=$S(OLDEST:$$FMDIFF^XLFDT(DT,OLDEST),1:0)
+30 SET OLDEST=$SELECT(CNT<1:"",1:$GET(^TMP($JOB,"IBCNOR2","SUM","OLDEST DATE")))
+31 SET ^TMP($JOB,"IBCNOR2","SUM","AGE")=$SELECT(OLDEST:$$FMDIFF^XLFDT(DT,OLDEST),1:0)
+32 ;
+33 QUIT
+34 ;
BACKLOG(DATE,WED) ;Calculate Backlog Date to T-6 business days so that T-7 inclusive shows on the report.
+1 NEW BACKLOG,DOW
+2 SET DOW=$EXTRACT($$DOW^XLFDT(DATE),1,2)
+3 IF DOW="Su"
SET BACKLOG=$$FMADD^XLFDT(DATE,$SELECT(WED:+4,1:-10))
GOTO BACKLOGX
+4 IF DOW="Mo"
SET BACKLOG=$$FMADD^XLFDT(DATE,$SELECT(WED:+3,1:-10))
GOTO BACKLOGX
+5 IF DOW="Tu"
SET BACKLOG=$$FMADD^XLFDT(DATE,$SELECT(WED:+2,1:-8))
GOTO BACKLOGX
+6 IF DOW="We"
SET BACKLOG=$$FMADD^XLFDT(DATE,$SELECT(WED:+1,1:-8))
GOTO BACKLOGX
+7 IF DOW="Th"
SET BACKLOG=$$FMADD^XLFDT(DATE,$SELECT(WED:-0,1:-8))
GOTO BACKLOGX
+8 IF DOW="Fr"
SET BACKLOG=$$FMADD^XLFDT(DATE,$SELECT(WED:-1,1:-8))
GOTO BACKLOGX
+9 IF DOW="Sa"
SET BACKLOG=$$FMADD^XLFDT(DATE,$SELECT(WED:-2,1:-9))
GOTO BACKLOGX
BACKLOGX ;Exit Backlog Date calculation
+1 QUIT BACKLOG
+2 ;
INIT ;Initialize the ^TMP global
+1 ;Initialize the Report Global Array
+2 NEW CAT,CATS,LINE,PCE
+3 FOR LINE=1:1
SET CATS=$PIECE($TEXT(CATNDT+LINE),";;",2)
if CATS=""
QUIT
Begin DoDot:1
+4 FOR PCE=1:1
SET CAT=$PIECE(CATS,U,PCE)
if CAT=""
QUIT
Begin DoDot:2
+5 SET ^TMP($JOB,"IBCNOR2","DET",CAT)=0
End DoDot:2
End DoDot:1
+6 FOR LINE=1:1
SET CATS=$PIECE($TEXT(CATWDT+LINE),";;",2)
if CATS=""
QUIT
Begin DoDot:1
+7 FOR PCE=1:1
SET CAT=$PIECE(CATS,U,PCE)
if CAT=""
QUIT
Begin DoDot:2
+8 SET ^TMP($JOB,"IBCNOR2","DET",CAT)=0
+9 SET ^TMP($JOB,"IBCNOR2","DET",CAT,"DATE")=""
+10 IF CAT'="MEDICARE"
QUIT
End DoDot:2
End DoDot:1
+11 FOR LINE=1:1
SET CATS=$PIECE($TEXT(TOTALS+LINE),";;",2)
if CATS=""
QUIT
Begin DoDot:1
+12 FOR PCE=1:1
SET CAT=$PIECE(CATS,U,PCE)
if CAT=""
QUIT
Begin DoDot:2
+13 SET ^TMP($JOB,"IBCNOR2","TOT",CAT)=0
End DoDot:2
End DoDot:1
+14 ;
INITX ;Exit
+1 QUIT
+2 ;
COMPILE ; Compile the report
+1 NEW CNT,IEN,INSCO,TOT
+2 SET (CNT,IEN)=0
+3 IF CRT
WRITE !,"Compiling Data..."
+4 FOR CNT=1:1
SET IEN=$ORDER(^TMP($JOB,"IBCNOR2","DATA",IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 IF CRT
IF '(CNT#100)
WRITE "."
+6 NEW ARRAY
+7 MERGE ARRAY=^TMP($JOB,"IBCNOR2","DATA",IEN)
+8 DO UPDATE("TOT","MCCF vs. non-MCCF")
+9 SET INSCO=$$UP^XLFSTR($GET(ARRAY(20.01,"E")))
+10 ;Process Insurance Company
Begin DoDot:2
+11 DO UPDATE("TOT","Insurance Company Category")
+12 IF INSCO["TRICARE"
DO UPDATE("DET","TRICARE")
DO UPDATE("DET","Non-MCCF")
QUIT
+13 IF INSCO["CHAMPVA"
DO UPDATE("DET","CHAMPVA")
DO UPDATE("DET","Non-MCCF")
QUIT
+14 DO UPDATE("DET","MCCF")
+15 IF INSCO["MEDICARE"
Begin DoDot:3
+16 DO UPDATE("DET","MEDICARE")
+17 IF INSCO="MEDICARE PART D (WNR)"
DO UPDATE("DET","MEDICARE PART D (WNR)")
End DoDot:3
QUIT
+18 IF INSCO="NO INSURANCE"
DO UPDATE("DET","NO INSURANCE")
QUIT
+19 IF INSCO="PATIENT REFUSED"
DO UPDATE("DET","PATIENT REFUSED")
QUIT
+20 IF INSCO="CMS MBI ONLY"
DO UPDATE("DET","CMS MBI ONLY")
QUIT
+21 DO UPDATE("DET","ALL OTHER")
End DoDot:2
+22 ;Process Patient Status
Begin DoDot:2
+23 DO UPDATE("TOT","Patient Status")
+24 NEW FLAG,FLAGS,POS
+25 SET FLAGS=$GET(ARRAY("FLAGS"))
+26 IF FLAGS=""
DO UPDATE("DET","blank")
+27 FOR POS=1:1:$LENGTH(FLAGS)
SET FLAG=$EXTRACT(FLAGS,POS)
Begin DoDot:3
+28 IF FLAG="i"
DO UPDATE("DET","i ACTIVE INSURANCE")
QUIT
+29 IF FLAG="I"
DO UPDATE("DET","I INPATIENT")
QUIT
+30 IF FLAG="E"
DO UPDATE("DET","E DECEASED")
QUIT
+31 IF FLAG="Y"
DO UPDATE("DET","Y COPAY REQUIRED")
QUIT
+32 IF FLAG="H"
DO UPDATE("DET","H CHARGES ON HOLD")
QUIT
End DoDot:3
End DoDot:2
+33 ;Process Source of Informtion
Begin DoDot:2
+34 DO UPDATE("TOT","Source of Information")
+35 NEW SOI
+36 SET SOI=$GET(ARRAY(.03,"E"))
+37 IF '$DATA(^TMP($JOB,"IBCNOR2","SOI",SOI))
Begin DoDot:3
+38 SET ^TMP($JOB,"IBCNOR2","SOI",SOI)=0
+39 SET ^TMP($JOB,"IBCNOR2","SOI",SOI,"DATE")=""
End DoDot:3
+40 DO UPDATE("SOI",SOI)
QUIT
End DoDot:2
End DoDot:1
+41 ;
COMPILEX ; Exit Compile
+1 QUIT
+2 ;
UPDATE(LVL,NODE) ;Increase a node
+1 NEW TOT
+2 IF LVL=""
GOTO UPDATEX
+3 IF NODE=""
GOTO UPDATEX
+4 SET TOT=^TMP($JOB,"IBCNOR2",LVL,NODE)+1
SET ^TMP($JOB,"IBCNOR2",LVL,NODE)=TOT
+5 DO OLDDATE(LVL,NODE,ARRAY(.01,"I"))
UPDATEX ;Exit
+1 QUIT
+2 ;
OLDDATE(LVL,NODE,DATE) ; Calculate the oldest date for the categories tracked.
+1 NEW GDATE
+2 ;Not calculating
IF '$DATA(^TMP($JOB,"IBCNOR2",LVL,NODE,"DATE"))
GOTO OLDDATEX
+3 SET GDATE=^TMP($JOB,"IBCNOR2",LVL,NODE,"DATE")
+4 IF 'GDATE
SET GDATE=DATE
+5 IF GDATE
IF (DATE<GDATE)
SET GDATE=DATE
+6 SET ^TMP($JOB,"IBCNOR2",LVL,NODE,"DATE")=GDATE
+7 ;
OLDDATEX ; Exit oldest date calculation
+1 QUIT
+2 ;
PRINT ; Print the report
+1 NEW CRT,EORMSG,IBPGC,IBPXT,MAXCNT,PL,SLINE,SOI,TSTAMP
+2 SET EORMSG="*****END OF REPORT*****"
+3 ; time of report
SET TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1)
+4 SET PL=IOSL-6
SET (CRT,IBPGC,IBPXT)=0
+5 if IOST["C-"
SET PL=IOSL-3
SET CRT=1
+6 SET $PIECE(SLINE,"=",14)=""
SET $PIECE(LINE,"=",79)=""
SET TAB=$SELECT(IBOUT="E":"^",1:"?"_53)
+7 DO HDR
IF IBPXT
GOTO PRINTX
+8 IF IBOUT="E"
IF TYPE="S"
Begin DoDot:1
+9 SET DLINE="OLDEST DATE^AGE OF OLDEST^TOTAL NUMBER OF ENTRIES^*TOTAL T-7 BACKLOG^TOTAL WEDNESDAY BACKLOG"
DO WRTLNX
+10 SET DATA=$GET(^TMP($JOB,"IBCNOR2","SUM","OLDEST DATE"))
SET DLINE=$SELECT(DATA:$$FMTDT(DATA),1:"")
+11 SET DATA=$FNUMBER(^TMP($JOB,"IBCNOR2","SUM","AGE"),",")
SET DLINE=DLINE_U_DATA
+12 SET DATA=$FNUMBER(^TMP($JOB,"IBCNOR2","SUM","TOTAL ENTRIES"),",")
SET DLINE=DLINE_U_DATA
+13 SET DATA=$FNUMBER(^TMP($JOB,"IBCNOR2","SUM","BACKLOG"),",")
SET DLINE=DLINE_U_DATA
+14 SET DATA=$FNUMBER(^TMP($JOB,"IBCNOR2","SUM","WBACKLOG"),",")
SET DLINE=DLINE_U_DATA
+15 DO WRTLNX
End DoDot:1
GOTO PRINTX
+16 DO WRTLN("Oldest Date","OLDEST DATE","D","SUM")
IF IBPXT
GOTO PRINTX
+17 DO WRTLN("Age of Oldest","AGE","N","SUM")
IF IBPXT
GOTO PRINTX
+18 DO WRTLN("Total Number of Entries","TOTAL ENTRIES","N","SUM")
IF IBPXT
GOTO PRINTX
+19 DO WRTLN("*Total T-7 Backlog","BACKLOG","N","SUM")
IF IBPXT
GOTO PRINTX
+20 DO WRTLN("Total Wednesday Backlog","WBACKLOG","N","SUM")
IF IBPXT
GOTO PRINTX
+21 IF TYPE="S"
GOTO PRINTX
+22 DO WRTLN("Total MCCF vs. non-MCCF","MCCF vs. non-MCCF","N","TOT")
IF IBPXT
GOTO PRINTX
+23 DO WRTLN(" MCCF","MCCF","N","DET")
IF IBPXT
GOTO PRINTX
+24 DO WRTLN(" Non-MCCF","Non-MCCF","N","DET")
IF IBPXT
GOTO PRINTX
+25 DO WRTLN("Total Number of Entries by Insurance Company Category","Insurance Company Category","N","TOT")
IF IBPXT
GOTO PRINTX
+26 DO WRTLN(" TRICARE","TRICARE","N","DET")
IF IBPXT
GOTO PRINTX
+27 DO WRTLN(" CHAMPVA","CHAMPVA","N","DET")
IF IBPXT
GOTO PRINTX
+28 DO WRTLN(" MEDICARE","MEDICARE","N","DET")
IF IBPXT
GOTO PRINTX
+29 DO WRTLN(" MEDICARE PART D (WNR)","MEDICARE PART D (WNR)","N","DET")
IF IBPXT
GOTO PRINTX
+30 DO WRTLN(" CMS MBI ONLY","CMS MBI ONLY","N","DET")
IF IBPXT
GOTO PRINTX
+31 DO WRTLN(" NO INSURANCE","NO INSURANCE","N","DET")
IF IBPXT
GOTO PRINTX
+32 DO WRTLN(" PATIENT REFUSED","PATIENT REFUSED","N","DET")
IF IBPXT
GOTO PRINTX
+33 DO WRTLN(" All OTHER","ALL OTHER","N","DET")
IF IBPXT
GOTO PRINTX
+34 DO WRTLN("Total Number of Entries by Patient Status","Patient Status","N","TOT")
IF IBPXT
GOTO PRINTX
+35 DO WRTLN(" i ACTIVE INSURANCE","i ACTIVE INSURANCE","N","DET")
IF IBPXT
GOTO PRINTX
+36 DO WRTLN(" I INPATIENT","I INPATIENT","N","DET")
IF IBPXT
GOTO PRINTX
+37 DO WRTLN(" E DECEASED","E DECEASED","N","DET")
IF IBPXT
GOTO PRINTX
+38 DO WRTLN(" Y CO-PAY REQUIRED","Y COPAY REQUIRED","N","DET")
IF IBPXT
GOTO PRINTX
+39 DO WRTLN(" H CHARGES ON HOLD","H CHARGES ON HOLD","N","DET")
IF IBPXT
GOTO PRINTX
+40 DO WRTLN(" blank","blank","N","DET")
IF IBPXT
GOTO PRINTX
+41 DO WRTLN("Total Number of Entries by Source of Information","Source of Information","N","TOT")
IF IBPXT
GOTO PRINTX
+42 SET SOI=""
+43 FOR
SET SOI=$ORDER(^TMP($JOB,"IBCNOR2","SOI",SOI))
if SOI=""
QUIT
Begin DoDot:1
+44 DO WRTLN(" "_SOI,SOI,"N","SOI")
End DoDot:1
IF IBPXT
QUIT
+45 ;
PRINTX ; Exit Print
+1 IF 'IBPXT
DO EOP(1)
+2 QUIT
+3 ;
FMTDT(DATE) ;Format the date
+1 IF $LENGTH(DATE)
SET DATE=$TRANSLATE($$FMTE^XLFDT(DATE,"5FD")," ","0")
FMTDTX ;Exit
+1 QUIT DATE
+2 ;
WRTLN(TITLE,NODE,DTYPE,LEVEL) ;Write the line
+1 NEW DATA,DATE,DLINE,NUM,TAB,TAB1
+2 SET TAB=$SELECT(TITLE["PART D":35,LEVEL="TOT":55,1:30)
+3 SET TAB1=$SELECT(TITLE["PART D":50,1:45)
+4 IF $Y+1>PL
IF IBOUT="R"
IF '$DATA(EMAIL)
DO HDR
IF $GET(ZTSTOP)!IBPXT
QUIT
+5 IF LEVEL="DET"
Begin DoDot:1
+6 SET DATA=$GET(^TMP($JOB,"IBCNOR2","DET",NODE))
+7 SET DATA=$FNUMBER(+DATA,",")
IF IBOUT="R"
SET DATA=$$RJ^XLFSTR(DATA,7)
+8 SET DLINE=TITLE
+9 IF IBOUT="E"
SET DLINE=DLINE_"^"_DATA
+10 IF IBOUT="R"
SET $EXTRACT(DLINE,TAB)=DATA
+11 SET DATA=$GET(^TMP($JOB,"IBCNOR2","DET",NODE,"DATE"))
+12 IF DATA]""
Begin DoDot:2
+13 SET DATA=$$FMTDT(DATA)
+14 IF IBOUT="E"
Begin DoDot:3
+15 DO WRTLNX
+16 SET DLINE=TITLE_" OLDEST^"_DATA
End DoDot:3
QUIT
+17 SET $EXTRACT(DLINE,TAB1)=DATA
End DoDot:2
End DoDot:1
GOTO WRTLNX
+18 IF LEVEL="SOI"
Begin DoDot:1
+19 SET DATA=$GET(^TMP($JOB,"IBCNOR2","SOI",NODE))
+20 SET DATA=$FNUMBER(+DATA,",")
IF IBOUT="R"
SET DATA=$$RJ^XLFSTR(DATA,7)
+21 SET DLINE=TITLE
+22 IF IBOUT="E"
SET DLINE=DLINE_"^"_DATA
+23 IF IBOUT="R"
SET $EXTRACT(DLINE,TAB)=DATA
+24 SET DATA=$GET(^TMP($JOB,"IBCNOR2","SOI",NODE,"DATE"))
+25 IF DATA]""
Begin DoDot:2
+26 SET DATA=$$FMTDT(DATA)
+27 IF IBOUT="E"
Begin DoDot:3
+28 DO WRTLNX
+29 SET DLINE=TITLE_" OLDEST^"_DATA
End DoDot:3
QUIT
+30 SET $EXTRACT(DLINE,TAB1)=DATA
End DoDot:2
End DoDot:1
GOTO WRTLNX
+31 IF LEVEL="SUM"
Begin DoDot:1
+32 SET DATA=$GET(^TMP($JOB,"IBCNOR2","SUM",NODE))
+33 IF DTYPE="D"
SET DATA=$$FMTDT(DATA)
+34 IF DTYPE="N"
SET DATA=$FNUMBER(+DATA,",")
IF IBOUT="R"
SET DATA=$$RJ^XLFSTR(DATA,7)
+35 SET DLINE=TITLE
+36 IF IBOUT="E"
SET DLINE=DLINE_"^"_DATA
+37 IF IBOUT="R"
SET $EXTRACT(DLINE,TAB)=DATA
End DoDot:1
GOTO WRTLNX
+38 IF LEVEL="TOT"
Begin DoDot:1
+39 SET DLINE=""
DO WRTLNX
+40 SET DATA=$GET(^TMP($JOB,"IBCNOR2","TOT",NODE))
+41 IF NODE="Patient Status"
SET DATA="N/A"
+42 IF NODE'="Patient Status"
SET DATA=$FNUMBER(+DATA,",")
+43 IF IBOUT="R"
SET DATA=$$RJ^XLFSTR(DATA,7)
+44 SET DLINE=TITLE
+45 IF IBOUT="E"
SET DLINE=DLINE_"^"_DATA
+46 IF IBOUT="R"
SET $EXTRACT(DLINE,TAB)=DATA
+47 DO WRTLNX
+48 SET DLINE=$SELECT(IBOUT="R":" ",1:"")_SLINE
End DoDot:1
GOTO WRTLNX
WRTLNX ;Exit
+1 IF $DATA(EMAIL)
SET CNT=$GET(MSG)+1
SET MSG=CNT
SET MSG(CNT)=DLINE
QUIT
+2 WRITE !,DLINE
+3 QUIT
+4 ;
HDR ;Print Header
+1 NEW STRING,TAB
+2 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET (ZTSTOP,IBPXT)=1
GOTO HDRX
+3 IF CRT
IF (IBPGC>0)
IF '$DATA(ZTQUEUED)
DO EOP(0)
IF IBPXT
GOTO HDRX
+4 SET IBPGC=IBPGC+1
+5 IF '$DATA(EMAIL)
WRITE @IOF
+6 SET STRING=TSTAMP
IF IBOUT="R"
SET STRING=STRING_" Page: "_IBPGC
+7 SET TAB=$SELECT(IBOUT="E":24,1:80-($LENGTH(STRING)+3))
+8 SET DLINE="Daily Buffer Report"
SET $EXTRACT(DLINE,TAB)=STRING
DO WRTLNX
+9 SET DLINE=$SELECT(TYPE="S":"Summary",1:"Detail")
DO WRTLNX
+10 SET DLINE="*Entries > 7 weekdays, where T=1 if weekday. Otherwise, T= previous Friday."
DO WRTLNX
+11 IF IBOUT="E"
GOTO HDRX
+12 SET DLINE=LINE
DO WRTLNX
+13 SET DLINE=""
DO WRTLNX
+14 ;
HDRX ; Header Exit
+1 QUIT
+2 ;
EOP(END) ; display "end of page" message and set exit flag
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIN
+2 IF END
Begin DoDot:1
+3 SET DLINE=""
DO WRTLNX
+4 SET DLINE="*****END OF REPORT*****"
DO WRTLNX
End DoDot:1
+5 IF 'CRT!$DATA(EMAIL)
GOTO EOPQ
+6 IF PL<51
FOR LIN=1:1:(PL-$Y)-1
WRITE !
+7 WRITE !
+8 SET DIR(0)="E"
DO ^DIR
KILL DIR
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
SET IBPXT=1
EOPQ ;
+1 QUIT
+2 ;
CATNDT ; Report categories with no oldest date
+1 ;;MCCF^Non-MCCF^i ACTIVE INSURANCE^I INPATIENT^E DECEASED^Y COPAY REQUIRED^
+2 ;;H CHARGES ON HOLD^blank^
+3 ;;
CATWDT ; Report categories with oldest date
+1 ;;TRICARE^CHAMPVA^MEDICARE^MEDICARE PART D (WNR)^CMS MBI ONLY^NO INSURANCE^
+2 ;;PATIENT REFUSED^ALL OTHER^
+3 ;;
TOTALS ;Category Totals
+1 ;;MCCF vs. non-MCCF^Insurance Company Category^Patient Status^Source of Information^
+2 ;;
