RCDPEAC ;ALB/TMK/PJH - ACTIVE BILLS WITH EEOB ON FILE ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**208,269,276,298,303,326,332,432**;Mar 20, 1995;Build 16
;Per VA Directive 6402, this routine should not be modified.
;
EN ; Entry point for Active Bills With EEOB Report [RCDPE ACTIVE WITH EEOB REPORT]
N %ZIS,CHAM,DTOUT,DUOUT,END,HDR,POP,RCCT,RCDISPTY,RCHDR,RCINS,RCLSTMGR,RCPAR,RCPGNUM,RCSORT,RCSTOP,RCTMPND,RCZRO
N START,TRIC,VAUTD,X,Y
; PRCA*4.5*276 - IA 1077 - Query Division
D DIVISION^VAUTOMA
I 'VAUTD&($D(VAUTD)'=11) Q
; PRCA*4.5*276 - select report format
Q:'$$SELECT(.RCINS,.RCSORT,.RCZRO,.RCTYPE)
;
S RCTMPND="",RCPGNUM=0,RCSTOP=0
I RCLSTMGR D G ENOUT
. S RCTMPND=$T(+0)_"^AR - ACTIVE BILLS WITH EEOB REPORT" K ^TMP($J,RCTMPND) ; clean any residue
. D ENQ
. M HDR=RCHDR
. D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,RCTMPND))) ; generate ListMan display
. I $D(RCTMPND) K ^TMP($J,RCTMPND)
;
W !
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
.N ZTDESC,ZTRTN,ZTSAVE,ZTSK
.S ZTRTN="ENQ^RCDPEAC",ZTDESC="AR - ACTIVE BILLS WITH EEOB REPORT"
.S ZTSAVE("*")=""
.D ^%ZTLOAD
.W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
.K IO("Q") D HOME^%ZIS
U IO
;
ENQ ; Queued entry point for the report
; RCSORT and array RCINS must exist
; RCINS = "A" for all ins co, "R" for range, "S" for selected individual
; for RCINS="R" ("FR")=from payer name and ("TR")=to payer name
; for RCINS="S" ("S",INS CO IEN IN FILE 36)=""
; RCSORT = "PN" for sort by patient name followed by ;- if reverse order
; "L4" for sort by patient SSN followed by ;- if reverse order
;
N POSTDT,RC0,RC399,RC399M1,RC430,RCACT,RCBILL,RCEIEN,RCEOB,RCEX,RCEXT,RCINC,RCKEY2,RCKEY4,RCNEW
N RCPAYNAM,RCPT,RCSSN,RCSTOP,RCTOT,RCZ,RCZ0,RCZ1,SN,X,Y,Z,Z0
K ^TMP($J,"RCSORT")
S RCCT=0 ;Page count for List Manager
S RCEXT=0 ; Set Excel page 1 count
I 'RCLSTMGR D HDRBLD
I RCLSTMGR D HDRLM
S RCACT=+$O(^PRCA(430.3,"AC",102,0)) ; Get active status ien
G:'RCACT ENOUT
;
I 'RCLSTMGR D HDRLST^RCDPEARL(0,.RCHDR) ; initial report header
S RCBILL=0,RCDT=START-.0001
; PRCA*4.5*303 - Changed loop to use the "AD" index on 361.1 so that the number of records checked is limited by
; the START and END dates of when the EEOB was recieved in VistA
; PRCA*4.5*326 - Start modified block. Change INCLUDE params and shorten line lengths.
F S RCDT=$O(^IBM(361.1,"AD",RCDT)) Q:(RCDT>(END_".24"))!(RCDT="") D
. S RCEIEN="" F S RCEIEN=$O(^IBM(361.1,"AD",RCDT,RCEIEN)) Q:RCEIEN="" D ;
. . S RCBILL=$P(^IBM(361.1,RCEIEN,0),U,1)
. . S RCINC=$$INCLUDE(RCBILL,RCEIEN,RCTYPE) ; PRCA*4.5*326 - Inclusion by payer or payer type
. . I RCINC,($P(^PRCA(430,RCBILL,0),U,8)=RCACT),$$EEOB(RCBILL,.RCEOB,RCZRO) D ; PRCA*4.5*326
. . . S (RCTOT,RCEOB,SN)=0
. . . F S RCEOB=$O(RCEOB(RCEOB)) Q:'RCEOB F S SN=$O(RCEOB(RCEOB,SN)) Q:'SN D
. . . . S RCTOT=RCTOT+$G(^IBM(361.1,RCEOB,1))
. . . . ; PRCA*4.5*326 - Begin block - Change insurance co. name (file 36) to payer name (file 344.6)
. . . . S RCPAYNAM=$$INSNM(RCBILL,RCEIEN)
. . . . S RCKEY2=$$SL1(RCSORT,RCBILL),RCKEY4=+RCEOB(RCEOB,SN)_"_"_RCEOB_"_"_SN
. . . . S ^TMP($J,"RCSORT",RCPAYNAM,RCKEY2,RCBILL,RCKEY4,RCEOB)=$P(RCEOB(RCEOB,SN),U,2) ; PRCA*4.5.303 add ERA PD AMOUNT
. . . . I $O(RCEOB(0)) S ^TMP($J,"RCSORT",RCPAYNAM,RCKEY2,RCBILL)=RCTOT ;This is from the eob and will be the same for each line
. . . . ; PRCA*4.5*326 - End block
;
S RCZ="",(RCSTOP,RCNEW)=0
F S RCZ=$O(^TMP($J,"RCSORT",RCZ)) Q:RCZ=""!RCSTOP D S:($G(RCINS)="R")!($G(RCINS)="S")&(RCPGNUM>1) RCNEW=1
. I RCSORT'["-" D
.. S RCZ0="" F S RCZ0=$O(^TMP($J,"RCSORT",RCZ,RCZ0)) Q:RCZ0=""!RCSTOP D OUTPUT(RCZ,RCZ0,RCSORT,.RCSTOP,.RCINS,RCNEW) S RCNEW=0
. I RCSORT["-" D
.. S RCZ0="" F S RCZ0=$O(^TMP($J,"RCSORT",RCZ,RCZ0),-1) Q:RCZ0=""!RCSTOP D OUTPUT(RCZ,RCZ0,RCSORT,.RCSTOP,.RCINS,.RCNEW) S RCNEW=0
;
I '$D(^TMP($J,"RCSORT")) S $P(Z," ",25)="",Z=Z_"*** NO RECORDS TO PRINT ***" D SL^RCDPEARL(Z,.RCCT,RCTMPND)
I $D(^TMP($J,"RCSORT")),'RCSTOP D SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCCT,RCTMPND)
; PRCA*4.5*303 - If regular report (no listmanager or queued) ask user to quit
I 'RCSTOP,'RCLSTMGR,'$D(ZTQUEUED) D ASK^RCDPEARL(.RCSTOP)
;
ENOUT I $D(ZTQUEUED) S ZTREQ="@"
I '$D(ZTQUEUED) D ^%ZISC
K ^TMP($J,"RCSORT"),RCDT
Q
;
OUTPUT(RCZ,RCZ0,RCSORT,RCSTOP,RCINS,RCNEW) ; Output the data
; RCZ, RCZ0 are the first 2 sort levels for the array
; RCINS = insurance co info array
; RCSTOP passed by ref - returned if user chooses to stop
; RCNEW = 1 if the header should be forced to print
N ZZ,RCEPD
S RCBILL=0 F S RCBILL=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL)) Q:'RCBILL!RCSTOP S RCZ1="" F S RCZ1=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1)) Q:RCZ1=""!RCSTOP D
. I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCSTOP) W !!,"***TASK STOPPED BY USER***" Q
. ; IA 1992 - BILL/CLAIMS file (#399)
. S RC399=$G(^DGCR(399,RCBILL,0)),RC399M1=$G(^DGCR(399,RCBILL,"M1")),RCPT=+$P(RC399,U,2),RC430=$G(^PRCA(430,RCBILL,0)) ;RC430 is from the top level
. ; PRCA*4.5*276 - Check for Division
. I VAUTD=0 Q:$P(RC399,U,22)="" Q:$G(VAUTD($P(RC399,U,22)))=""
. ; PRCA*4.5*326 remove phamacy check. Now in $$INCLUDE logic
. S RCSTOP=$$NEWPG(.RCINS,RCNEW) S RCNEW=0 Q:RCSTOP
. S X=$$GET1^DIQ(430,RCBILL_",",11)
. ; PRCA*4.5*276 - Row #1: Print last 4 SSN only - Move Bill Number to end
. S RCSSN=$P($G(^DPT(RCPT,0)),U,9),RCSSN=$E(RCSSN,$L(RCSSN)-3,$L(RCSSN))
. I $G(RCDISPTY) S RCEX=$P($G(^DPT(RCPT,0)),U)_"^"_RCSSN_"^"_$TR($P(RC430,U),"-","")
. E D
. . S Z=$E($P($G(^DPT(RCPT,0)),U)_$J("",25),1,25)_" "_$E(RCSSN_$J("",5),1,5)_" "_$TR($P(RC430,U),"-","")
. . D SL^RCDPEARL(Z,.RCCT,RCTMPND)
. ; PRCA*4.5*276 - Row #2: Move Ins Name, Balance, Amt Bill, Amt Paid
. S Y=+$G(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL))
. I $G(RCDISPTY) S RCEX=RCEX_"^"_RCZ_"^"_+X_"^"_+$P(RC430,U,3)_"^"_Y ; PRCA*4.5*326 - Use RCZ for insurance name
. E D
. . ; PRCA*4.5*326 - Use RCZ for insurance name
. . S Z=$E(RCZ_$J("",30),1,30)_$E($J("",12)_$J(+X,"",2),1+$L($J(+X,"",2)),12+$L($J(+X,"",2)))_$E($J("",13)_$J(+$P(RC430,U,3),"",2),1+$L($J(+$P(RC430,U,3),"",2)),13+$L($J(+$P(RC430,U,3),"",2)))_$E($J("",13),1,13-$L(Y))_$J(Y,"",2)
. . D SL^RCDPEARL(Z,.RCCT,RCTMPND)
. ; PRCA*4.5*276 Do not display Date Referred
. S RCEOB=0,RCEPD="" F S RCEOB=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1,RCEOB)) Q:'RCEOB!RCSTOP S RCEPD=$G(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1,RCEOB)) D
. . S RCSTOP=$$NEWPG(.RCINS,RCNEW,2)
. . Q:RCSTOP
. . S RC0=$G(^IBM(361.1,RCEOB,0))
. . ; PRCA*4.5*276 - Row #3: Trace#, Date Rec'd, Date Posted
. . I $G(RCDISPTY) W !,RCEX_"^"_$P(RC0,U,7)_"^"_$$FMTE^XLFDT($P(RC0,U,5),"2D")_"^"_$S(RCZ1:$$FMTE^XLFDT(+RCZ1,"2D"),1:"")_"^"_RCEPD
. . E D
. . . S Z=" "_$P(RC0,U,7)_$J("",50-$L($P(RC0,U,7)))_$J(RCEPD,10,2)_" "_$E($$FMTE^XLFDT($P(RC0,U,5),"2D")_$J("",8),1,8)_" "_$E($S(RCZ1:$$FMTE^XLFDT(+RCZ1,"2D"),1:"")_$J("",8),1,8)
. . . D SL^RCDPEARL(Z,.RCCT,RCTMPND)
. I '$G(RCDISPTY) S Z="" D SL^RCDPEARL(Z,.RCCT,RCTMPND)
;
Q
;
INCLUDE(RCZ,EOBIEN,RCTYPE) ; PRCA*4.5*326 change parameters
; Function returns 1 if record should be included based on ins co
; RCINS = array containing insurance co information
; RCZ = ien of the entry in file 430
N OK,RCI,RCINM,RCAINP,XX ; PRCA*4.5*326
S OK=1
S RCI=+$$INS(RCZ)
;
I 'RCI S OK=0 G INCQ ; Not a third party bill
;
; PRCA*4.5*326 - Start modified block - Check for payer match
I RCINS'="A" D ;
. S OK=$$ISSEL^RCDPEU1(361.1,EOBIEN)
E I RCTYPE'="A" D ;
. S OK=$$ISTYPE^RCDPEU1(361.1,EOBIEN,RCTYPE)
; PRCA*4.5*326 - End modified block
;
INCQ Q OK
;
INSNM(RCZ,EOBIEN) ; Returns the name of payer from the ERA associated with the EOB
; If that is null, return the insurance co for bill ien RCZ file 430
; Input: RCZ = Point to bill, file #430
; EOBIEN = Pointer to EOB file 361.1
; Returns: NM = Free text name of Payer from ERA or insurance on bill if ERA not found.
;
N ERAIEN,FILE,NM
S NM=""
S ERAIEN=$$EOBERA^RCDPEU1(EOBIEN)
I ERAIEN S NM=$$GETNAME^RCDPEU1(344.4,ERAIEN)
I NM="" S NM=$P($G(^DIC(36,+$$INS(RCZ),0)),U)
Q NM
;
INS(RCZ) ; Returns ien of insurance co for bill ien RCZ from file 430
N RC
S RC=$P($G(^PRCA(430,RCZ,0)),U,9) ;DEBTOR
Q $S($P($G(^RCD(340,+RC,0)),U)'["DIC(36":"",1:+^(0))
;
NEWPG(RCINS,RCNEW,RCLINES) ; Check for new page needed, output header
; RCINS = ins co selection criteria
; RCNEW = 1 to force new page
; RCLINES = Number of lines before IOSL to force new page
; Function returns 1 if user chooses to stop output
S RCLINES=$G(RCLINES,5)
I RCNEW!(($Y+RCLINES)>IOSL) D
. D:'$G(RCDISPTY) HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
Q RCSTOP
;
EEOB(RCZ,RCEOB,RCZRO) ; Find all non-MRA EEOBs for bill ien RCZ
; Function returns 1 if any valid EEOBs found, 0 if none
; RCEOB(eob ien)=date posted returned for valid EEOBs found -
; pass by reference
N OK,Z,Z0,Z00,DET,SN,ZPD,ZINC
K RCEOB
;
S (Z,OK,SN,ZINC)=0
; IA 4051 for File #361.1
F S Z=$O(^IBM(361.1,"B",RCZ,Z)) Q:'Z I $P($G(^IBM(361.1,Z,0)),U,4)'=1 D
. ; retrieve the EEOB data from ERA Detail sub-entry
. S (Z0,DET)=0
. F S Z0=$O(^RCY(344.4,"ADET",Z,Z0)) Q:'Z0 F S DET=$O(^RCY(344.4,"ADET",Z,Z0,DET)) Q:'DET D ; ERA Detail
. . ; PRCA*4.5*303 - added check for Zero paid or Paid > 0 check for report.
. . S ZINC=0,ZPD=+$P($G(^RCY(344.4,Z0,1,DET,0)),U,3)
. . I (RCZRO="A") S ZINC=1 ; PRCA*4.5*332
. . I (RCZRO="Z"),(ZPD=0) S ZINC=1
. . I (RCZRO="P"),(ZPD>0) S ZINC=1 ; PRCA*4.5*332
. . ; PRCA*4.5*303 - Removed looking for Receipt, include record based on ERA DETAIL POST STATUS
. . ; PRCA*4.5*303 - Removed check for Receipt (If Z1 is not empty) Changed date to Piece 7 and
. . ; added check for either 0 paid or paid >0 depending on selection. Added ERA PD AMOUNT as second piece of RCEOB array
. . I ZINC S SN=SN+1,RCEOB(Z,SN)=+$P($G(^RCY(344.4,Z0,0)),U,7)_U_ZPD,OK=1 ; PRCA*4.5*332
;
Q OK
;
SL1(RCSORT,RCZ) ; Function returns 1st sort level data from ien RCZ in file 430
; RCSORT = "PN" for patient name sort = "L4" for SSN last 4 sort
N DAT
I RCSORT="PN" S DAT=$P($G(^DPT(+$P($G(^PRCA(430,RCZ,0)),U,7),0)),U)
I RCSORT="L4" S DAT=$P($G(^DPT(+$P($G(^PRCA(430,RCZ,0)),U,7),0)),U,9),DAT=$E(DAT,$L(DAT)-3,$L(DAT))
Q $S($G(DAT)'="":DAT,1:" ")
;
SELECT(RCINS,RCSORT,RCZRO,RCTYPE) ; Select insurance co, sort criteria, Zero Payment, Bill type (Med/RX) and if output for EXCEL format is selected
; Function returns values selected for RCSORT and RCINS - passed by ref
N RCQUIT,DONE,DIR,X,Y,%DT
S (RCQUIT,DONE,RCLSTMGR)=0
; PRCA*4.5*326 - Begin changed block - Ask to show Medical/Pharmacy Tricare, CHAMPVA or All
S RCTYPE=$$RTYPE^RCDPEU1("")
I RCTYPE=-1 G SELQ
;
S RCINS=$$PAYRNG^RCDPEU1()
I RCINS=-1 G SELQ
;
I RCINS'="A" D I XX=-1 G SELQ
. S RCPAR("TYPE")=RCTYPE
. S RCPAR("SELC")=RCINS
. S RCPAR("DICA")="SELECT INSURANCE COMPANY: "
. S XX=$$SELPAY^RCDPEU1(.RCPAR)
; PRCA*4.5*326 - End changed block
;
; PRCA*4.5*303 - Add Zero $ Prompt and Medical/Pharmacy EEOBs Prompt
S DIR(0)="SA^P:PAYMENT EEOBs;Z:ZERO PAYMENT EEOBs;A:ALL"
S DIR("A")="RUN REPORT FOR (P)AYMENT EEOBs or (Z)ERO PAYMENT EEOBs or (A)LL: ",DIR("B")="ALL"
W ! D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) G SELQ
S RCZRO=$E(Y,1)
;
S DIR(0)="SA^P:PATIENT NAME;L:LAST 4 OF PATIENT SSN",DIR("A")="WITHIN INS CO, SORT BY (P)ATIENT NAME OR (L)AST 4 OF SSN?: ",DIR("B")="PATIENT NAME" W ! D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) G SELQ
S RCSORT=$S(Y="P":"PN",1:"L4")
S DIR(0)="SA^F:FIRST TO LAST;L:LAST TO FIRST",DIR("A")="SORT "_$S(RCSORT="PN":"PATIENT NAME",1:"LAST 4")_" (F)IRST TO LAST OR (L)AST TO FIRST?: ",DIR("B")="FIRST TO LAST" D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) G SELQ
I Y="L" S RCSORT=RCSORT_";-"
;
; PRCA*4.5*298 - Add Date Range Prompts
K DIR
S DIR("?")="ENTER THE EARLIEST RECEIVED DATE TO INCLUDE ON THE REPORT"
S DIR(0)="DAO^:"_DT_":APE",DIR("A")="START DATE (RECEIVED): ",DIR("B")="T" D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") G SELQ
S START=Y
K DIR
S DIR("?")="ENTER THE LATEST RECEIVED DATE TO INCLUDE ON THE REPORT"
S DIR("B")="T"
S DIR(0)="DAO^"_START_":"_DT_":APE",DIR("A")="END DATE (RECEIVED): " D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") G SELQ
S END=Y
; PRCA*4.5*326 - Remove old Tricare and CHAMPVA prompts
;
; PRCA*4.5*276 - Determine whether to gather data for Excel report.
S RCDISPTY=$$DISPTY^RCDPEM3 G SELQ:RCDISPTY<0
I RCDISPTY D INFO^RCDPEM6 S DONE=1 G SELQ
;
; PRCA*4.5*298 - Add ListManager Prompts
S RCLSTMGR=$$ASKLM^RCDPEARL G:RCLSTMGR<0 SELQ
;
S DONE=1
;
SELQ ;
Q DONE
;
LIST(DIR,RCINS) ; Sets up help array for ins co selected in DIR("?")
N CT,Z
S CT=1
I '$O(RCINS("S",0)) S DIR("?")="NO INSURANCE COMPANIES SELECTED" Q
S DIR("?",1)="INSURANCE COMPANIES ALREADY SELECTED:"
S Z=0 F S Z=$O(RCINS("S",Z)) Q:'Z S CT=CT+1,DIR("?",CT)=" "_$P($G(^DIC(36,Z,0)),U)
S DIR("?")=" "
Q
;
HDRBLD ; create the report header
; returns RCHDR,RCPGNUM,RCSTOP
; RCHDR(0) = header text line count
; RCHDR("PGNUM") = page number
; RCHDR("XECUTE") = M code for page number
; RCHDR("RUNDATE") = date/time report generated
; RCPGNUM - page counter
; RCSTOP - flag to stop listing
; INPUT:
; RCDTRNG - date range filter value to be printed as part of the header
; RCPAY - Payer filter value(s)
; RCLSTMGR
;
N Z0
S Z0=""
K RCHDR S RCHDR("RUNDATE")=$$NOW^RCDPEARL,RCPGNUM=0,RCSTOP=0
;
I RCDISPTY D Q ; Excel format, xecute code is QUIT, null page number
. S RCHDR(0)=1,RCHDR("XECUTE")="Q",RCPGNUM=""
. S RCHDR(1)="PATIENT NAME^SSN^BILL#^INS CO NAME^BALANCE^AMT BILLE^AMT PAID^TRACE#^DT REC'D^DT POST^ERA PD AMT"
;
N MSG,DATE,Y,DIV,HCNT
S RCHDR(1)=$$HDRNM,HCNT=1 ; line 1 will be replaced by XECUTE code below
S RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDRNM^"_$T(+0)_"_$S(RCLSTMGR:"""",1:$J(""Page: ""_RCPGNUM,12)),RCHDR(1)=$J("" "",80-$L(Y)\2)_Y"
;
S Y="RUN DATE: "_RCHDR("RUNDATE"),HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y
I VAUTD=1 S Y="DIVISIONS: ALL"
I VAUTD=0 D
. S Z0=0,Y="DIVISIONS: " F X=1:1 S Z0=$O(VAUTD(Z0)) Q:Z0="" S:X>1 Y=Y_", " S Y=Y_VAUTD(Z0)
S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y
I RCINS="S" S Z=0,Z0="" F S Z=$O(RCINS("S",Z)) Q:'Z S Z0=Z0_$S(Z0'="":",",1:"")_$P($G(^DIC(36,Z,0)),U)
; PRCA*4.5*326 - Start modified block
S Z0="PAYERS: "_$S(RCINS="A":"ALL ",RCINS="R":"RANGE",1:"SELECTED")
S Z0=Z0_$J("",16)_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: "_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL") ;PRCA*4.5*432 Add CHAMPVA
S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Z0)\2)_Z0,Z0=""
; PRCA*4.5*326 modify next two lines for tricare filter
S Z0=Z0_"DATE RANGE: "_$$FMTE^XLFDT(START,"2Z")_"-"_$$FMTE^XLFDT(END,"2Z")
S Z0=Z0_$J("",16)_" PAYMENT TYPE: "_$S(RCZRO="Z":"ZERO PAYMENT",RCZRO="P":"PAYMENT",1:"ALL") ; PRCA*4.5*332
; PRCA*4.5*326 - End modified block
;
S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Z0)\2)_Z0
;
S HCNT=HCNT+1,RCHDR(HCNT)=""
S Y="PATIENT NAME SSN BILL#",HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y="INS CO NAME BALANCE AMT BILLED AMT PAID",HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y=" TRACE# ERA PD AMT REC'D DT POST",HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y=$TR($J("",IOM)," ","="),HCNT=HCNT+1,RCHDR(HCNT)=Y
S RCHDR(0)=HCNT
Q
;
HDRLM ; create the list manager version of the report header
; returns RCHDR,RCPGNUM,RCSTOP
; RCHDR(0) = header text line count
; RCHDR("PGNUM") = page number
; RCHDR("XECUTE") = M code for page number
; RCHDR("RUNDATE") = date/time report generated
; RCPGNUM - page counter
; RCSTOP - flag to stop listing
;INPUT:
; RCDTRNG - date range filter value to be printed as part of the header
; RCPAY - Payer filter value(s)
; RCLSTMGR
;
N Z0 S Z0=""
K RCHDR S RCPGNUM=0,RCSTOP=0
N MSG,DATE,Y,DIV,HCNT
; PRCA*4.5*326 Start modified code block
S HCNT=1
S RCHDR("TITLE")=$$HDRNM,RCHDR("XECUTE")="Q"
S RCHDR(1)="DATE RANGE: "_$$FMTE^XLFDT(START,"2Z")_"-"_$$FMTE^XLFDT(END,"2Z")_$J("",16)
S RCHDR(1)=RCHDR(1)_" PAYMENT TYPE: "_$S(RCZRO="Z":"ZERO PAYMENT",RCZRO="P":"PAYMENT",1:"ALL") ; PRCA*4.5*332
I VAUTD=1 S Y="DIVISIONS: ALL"
I VAUTD=0 D
. S Z0=0,Y="DIVISIONS: " F X=1:1 S Z0=$O(VAUTD(Z0)) Q:Z0="" S:X>1 Y=Y_", " S Y=Y_VAUTD(Z0)
S HCNT=HCNT+1,RCHDR(HCNT)=Y
I RCINS="S" S Z=0,Z0="" F S Z=$O(RCINS("S",Z)) Q:'Z S Z0=Z0_$S(Z0'="":",",1:"")_$P($G(^DIC(36,Z,0)),U)
S Z0="PAYERS: "_$S(RCINS="A":"ALL ",RCINS="R":"RANGE",1:"SELECTED")
S Z0=Z0_$J("",38-$L(Z0))_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: "_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL") ;PRCA*4.5*432 Add CHAMPVA
; PRCA*4.5*326 End modified code block
S HCNT=HCNT+1,RCHDR(HCNT)=Z0
I RCINS="A" S HCNT=HCNT+1,RCHDR(HCNT)=""
;
S Y="PATIENT NAME SSN BILL#",HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y="INS CO NAME BALANCE AMT BILLED AMT PAID",HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y=" TRACE# ERA PD AMT REC'D DT POST",HCNT=HCNT+1,RCHDR(HCNT)=Y
S RCHDR(0)=HCNT
Q
;
; extrinsic variable, name for header PRCA*4.5*298
HDRNM() Q "EDI LOCKBOX ACTIVE BILLS W/EEOB REPORT"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAC 17546 printed Sep 23, 2025@19:20:11 Page 2
RCDPEAC ;ALB/TMK/PJH - ACTIVE BILLS WITH EEOB ON FILE ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**208,269,276,298,303,326,332,432**;Mar 20, 1995;Build 16
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Entry point for Active Bills With EEOB Report [RCDPE ACTIVE WITH EEOB REPORT]
+1 NEW %ZIS,CHAM,DTOUT,DUOUT,END,HDR,POP,RCCT,RCDISPTY,RCHDR,RCINS,RCLSTMGR,RCPAR,RCPGNUM,RCSORT,RCSTOP,RCTMPND,RCZRO
+2 NEW START,TRIC,VAUTD,X,Y
+3 ; PRCA*4.5*276 - IA 1077 - Query Division
+4 DO DIVISION^VAUTOMA
+5 IF 'VAUTD&($DATA(VAUTD)'=11)
QUIT
+6 ; PRCA*4.5*276 - select report format
+7 if '$$SELECT(.RCINS,.RCSORT,.RCZRO,.RCTYPE)
QUIT
+8 ;
+9 SET RCTMPND=""
SET RCPGNUM=0
SET RCSTOP=0
+10 IF RCLSTMGR
Begin DoDot:1
+11 ; clean any residue
SET RCTMPND=$TEXT(+0)_"^AR - ACTIVE BILLS WITH EEOB REPORT"
KILL ^TMP($JOB,RCTMPND)
+12 DO ENQ
+13 MERGE HDR=RCHDR
+14 ; generate ListMan display
DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP($JOB,RCTMPND)))
+15 IF $DATA(RCTMPND)
KILL ^TMP($JOB,RCTMPND)
End DoDot:1
GOTO ENOUT
+16 ;
+17 WRITE !
+18 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+19 IF $DATA(IO("Q"))
Begin DoDot:1
+20 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+21 SET ZTRTN="ENQ^RCDPEAC"
SET ZTDESC="AR - ACTIVE BILLS WITH EEOB REPORT"
+22 SET ZTSAVE("*")=""
+23 DO ^%ZTLOAD
+24 WRITE !!,$SELECT($DATA(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
+25 KILL IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+26 USE IO
+27 ;
ENQ ; Queued entry point for the report
+1 ; RCSORT and array RCINS must exist
+2 ; RCINS = "A" for all ins co, "R" for range, "S" for selected individual
+3 ; for RCINS="R" ("FR")=from payer name and ("TR")=to payer name
+4 ; for RCINS="S" ("S",INS CO IEN IN FILE 36)=""
+5 ; RCSORT = "PN" for sort by patient name followed by ;- if reverse order
+6 ; "L4" for sort by patient SSN followed by ;- if reverse order
+7 ;
+8 NEW POSTDT,RC0,RC399,RC399M1,RC430,RCACT,RCBILL,RCEIEN,RCEOB,RCEX,RCEXT,RCINC,RCKEY2,RCKEY4,RCNEW
+9 NEW RCPAYNAM,RCPT,RCSSN,RCSTOP,RCTOT,RCZ,RCZ0,RCZ1,SN,X,Y,Z,Z0
+10 KILL ^TMP($JOB,"RCSORT")
+11 ;Page count for List Manager
SET RCCT=0
+12 ; Set Excel page 1 count
SET RCEXT=0
+13 IF 'RCLSTMGR
DO HDRBLD
+14 IF RCLSTMGR
DO HDRLM
+15 ; Get active status ien
SET RCACT=+$ORDER(^PRCA(430.3,"AC",102,0))
+16 if 'RCACT
GOTO ENOUT
+17 ;
+18 ; initial report header
IF 'RCLSTMGR
DO HDRLST^RCDPEARL(0,.RCHDR)
+19 SET RCBILL=0
SET RCDT=START-.0001
+20 ; PRCA*4.5*303 - Changed loop to use the "AD" index on 361.1 so that the number of records checked is limited by
+21 ; the START and END dates of when the EEOB was recieved in VistA
+22 ; PRCA*4.5*326 - Start modified block. Change INCLUDE params and shorten line lengths.
+23 FOR
SET RCDT=$ORDER(^IBM(361.1,"AD",RCDT))
if (RCDT>(END_".24"))!(RCDT="")
QUIT
Begin DoDot:1
+24 ;
SET RCEIEN=""
FOR
SET RCEIEN=$ORDER(^IBM(361.1,"AD",RCDT,RCEIEN))
if RCEIEN=""
QUIT
Begin DoDot:2
+25 SET RCBILL=$PIECE(^IBM(361.1,RCEIEN,0),U,1)
+26 ; PRCA*4.5*326 - Inclusion by payer or payer type
SET RCINC=$$INCLUDE(RCBILL,RCEIEN,RCTYPE)
+27 ; PRCA*4.5*326
IF RCINC
IF ($PIECE(^PRCA(430,RCBILL,0),U,8)=RCACT)
IF $$EEOB(RCBILL,.RCEOB,RCZRO)
Begin DoDot:3
+28 SET (RCTOT,RCEOB,SN)=0
+29 FOR
SET RCEOB=$ORDER(RCEOB(RCEOB))
if 'RCEOB
QUIT
FOR
SET SN=$ORDER(RCEOB(RCEOB,SN))
if 'SN
QUIT
Begin DoDot:4
+30 SET RCTOT=RCTOT+$GET(^IBM(361.1,RCEOB,1))
+31 ; PRCA*4.5*326 - Begin block - Change insurance co. name (file 36) to payer name (file 344.6)
+32 SET RCPAYNAM=$$INSNM(RCBILL,RCEIEN)
+33 SET RCKEY2=$$SL1(RCSORT,RCBILL)
SET RCKEY4=+RCEOB(RCEOB,SN)_"_"_RCEOB_"_"_SN
+34 ; PRCA*4.5.303 add ERA PD AMOUNT
SET ^TMP($JOB,"RCSORT",RCPAYNAM,RCKEY2,RCBILL,RCKEY4,RCEOB)=$PIECE(RCEOB(RCEOB,SN),U,2)
+35 ;This is from the eob and will be the same for each line
IF $ORDER(RCEOB(0))
SET ^TMP($JOB,"RCSORT",RCPAYNAM,RCKEY2,RCBILL)=RCTOT
+36 ; PRCA*4.5*326 - End block
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+37 ;
+38 SET RCZ=""
SET (RCSTOP,RCNEW)=0
+39 FOR
SET RCZ=$ORDER(^TMP($JOB,"RCSORT",RCZ))
if RCZ=""!RCSTOP
QUIT
Begin DoDot:1
+40 IF RCSORT'["-"
Begin DoDot:2
+41 SET RCZ0=""
FOR
SET RCZ0=$ORDER(^TMP($JOB,"RCSORT",RCZ,RCZ0))
if RCZ0=""!RCSTOP
QUIT
DO OUTPUT(RCZ,RCZ0,RCSORT,.RCSTOP,.RCINS,RCNEW)
SET RCNEW=0
End DoDot:2
+42 IF RCSORT["-"
Begin DoDot:2
+43 SET RCZ0=""
FOR
SET RCZ0=$ORDER(^TMP($JOB,"RCSORT",RCZ,RCZ0),-1)
if RCZ0=""!RCSTOP
QUIT
DO OUTPUT(RCZ,RCZ0,RCSORT,.RCSTOP,.RCINS,.RCNEW)
SET RCNEW=0
End DoDot:2
End DoDot:1
if ($GET(RCINS)="R")!($GET(RCINS)="S")&(RCPGNUM>1)
SET RCNEW=1
+44 ;
+45 IF '$DATA(^TMP($JOB,"RCSORT"))
SET $PIECE(Z," ",25)=""
SET Z=Z_"*** NO RECORDS TO PRINT ***"
DO SL^RCDPEARL(Z,.RCCT,RCTMPND)
+46 IF $DATA(^TMP($JOB,"RCSORT"))
IF 'RCSTOP
DO SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCCT,RCTMPND)
+47 ; PRCA*4.5*303 - If regular report (no listmanager or queued) ask user to quit
+48 IF 'RCSTOP
IF 'RCLSTMGR
IF '$DATA(ZTQUEUED)
DO ASK^RCDPEARL(.RCSTOP)
+49 ;
ENOUT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+2 KILL ^TMP($JOB,"RCSORT"),RCDT
+3 QUIT
+4 ;
OUTPUT(RCZ,RCZ0,RCSORT,RCSTOP,RCINS,RCNEW) ; Output the data
+1 ; RCZ, RCZ0 are the first 2 sort levels for the array
+2 ; RCINS = insurance co info array
+3 ; RCSTOP passed by ref - returned if user chooses to stop
+4 ; RCNEW = 1 if the header should be forced to print
+5 NEW ZZ,RCEPD
+6 SET RCBILL=0
FOR
SET RCBILL=$ORDER(^TMP($JOB,"RCSORT",RCZ,RCZ0,RCBILL))
if 'RCBILL!RCSTOP
QUIT
SET RCZ1=""
FOR
SET RCZ1=$ORDER(^TMP($JOB,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1))
if RCZ1=""!RCSTOP
QUIT
Begin DoDot:1
+7 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (RCSTOP,ZTSTOP)=1
KILL ZTREQ
IF +$GET(RCSTOP)
WRITE !!,"***TASK STOPPED BY USER***"
QUIT
+8 ; IA 1992 - BILL/CLAIMS file (#399)
+9 ;RC430 is from the top level
SET RC399=$GET(^DGCR(399,RCBILL,0))
SET RC399M1=$GET(^DGCR(399,RCBILL,"M1"))
SET RCPT=+$PIECE(RC399,U,2)
SET RC430=$GET(^PRCA(430,RCBILL,0))
+10 ; PRCA*4.5*276 - Check for Division
+11 IF VAUTD=0
if $PIECE(RC399,U,22)=""
QUIT
if $GET(VAUTD($PIECE(RC399,U,22)))=""
QUIT
+12 ; PRCA*4.5*326 remove phamacy check. Now in $$INCLUDE logic
+13 SET RCSTOP=$$NEWPG(.RCINS,RCNEW)
SET RCNEW=0
if RCSTOP
QUIT
+14 SET X=$$GET1^DIQ(430,RCBILL_",",11)
+15 ; PRCA*4.5*276 - Row #1: Print last 4 SSN only - Move Bill Number to end
+16 SET RCSSN=$PIECE($GET(^DPT(RCPT,0)),U,9)
SET RCSSN=$EXTRACT(RCSSN,$LENGTH(RCSSN)-3,$LENGTH(RCSSN))
+17 IF $GET(RCDISPTY)
SET RCEX=$PIECE($GET(^DPT(RCPT,0)),U)_"^"_RCSSN_"^"_$TRANSLATE($PIECE(RC430,U),"-","")
+18 IF '$TEST
Begin DoDot:2
+19 SET Z=$EXTRACT($PIECE($GET(^DPT(RCPT,0)),U)_$JUSTIFY("",25),1,25)_" "_$EXTRACT(RCSSN_$JUSTIFY("",5),1,5)_" "_$TRANSLATE($PIECE(RC430,U),"-","")
+20 DO SL^RCDPEARL(Z,.RCCT,RCTMPND)
End DoDot:2
+21 ; PRCA*4.5*276 - Row #2: Move Ins Name, Balance, Amt Bill, Amt Paid
+22 SET Y=+$GET(^TMP($JOB,"RCSORT",RCZ,RCZ0,RCBILL))
+23 ; PRCA*4.5*326 - Use RCZ for insurance name
IF $GET(RCDISPTY)
SET RCEX=RCEX_"^"_RCZ_"^"_+X_"^"_+$PIECE(RC430,U,3)_"^"_Y
+24 IF '$TEST
Begin DoDot:2
+25 ; PRCA*4.5*326 - Use RCZ for insurance name
+26 SET Z=$EXTRACT(RCZ_$JUSTIFY("",30),1,30)_$EXTRACT($JUSTIFY("",12)_...
SET $JUSTIFY(+X,"",2),1+$LENGTH($JUSTIFY(+X,"",2)),12+$LENGTH($JUSTIFY(+X,"",2)))_$EXTRACT($JUSTIFY("",13)_$JUSTIFY(+$PIECE(RC430,U,3),"",2),1+$LENGTH($JUSTIFY(+$PIECE(RC430,U,3),"",2)),13+...
... $LENGTH($JUSTIFY(+$PIECE(RC430,U,3),"",2)))_$EXTRACT($JUSTIFY("",13),1,13-$LENGTH(Y))_$JUSTIFY(Y,"",2)
+27 DO SL^RCDPEARL(Z,.RCCT,RCTMPND)
End DoDot:2
+28 ; PRCA*4.5*276 Do not display Date Referred
+29 SET RCEOB=0
SET RCEPD=""
FOR
SET RCEOB=$ORDER(^TMP($JOB,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1,RCEOB))
if 'RCEOB!RCSTOP
QUIT
SET RCEPD=$GET(^TMP($JOB,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1,RCEOB))
Begin DoDot:2
+30 SET RCSTOP=$$NEWPG(.RCINS,RCNEW,2)
+31 if RCSTOP
QUIT
+32 SET RC0=$GET(^IBM(361.1,RCEOB,0))
+33 ; PRCA*4.5*276 - Row #3: Trace#, Date Rec'd, Date Posted
+34 IF $GET(RCDISPTY)
WRITE !,RCEX_"^"_$PIECE(RC0,U,7)_"^"_$$FMTE^XLFDT($PIECE(RC0,U,5),"2D")_"^"_$SELECT(RCZ1:$$FMTE^XLFDT(+RCZ1,"2D"),1:"")_"^"_RCEPD
+35 IF '$TEST
Begin DoDot:3
+36 SET Z=" "_$PIECE(RC0,U,7)_$JUSTIFY("",50-$LENGTH($PIECE(RC0,U,7)))_$JUSTIFY(RCEPD,10,2)_" "_$EXTRACT($$FMTE^XLFDT($PIECE(RC0,U,5),"2D")_$JUSTIFY("",8),1,8)_" "_$EXTRACT($SELECT(RCZ1:$$FMTE^XLFDT(+RCZ1,"2D"),1:"")_$J
USTIFY("",8),1,8)
+37 DO SL^RCDPEARL(Z,.RCCT,RCTMPND)
End DoDot:3
End DoDot:2
+38 IF '$GET(RCDISPTY)
SET Z=""
DO SL^RCDPEARL(Z,.RCCT,RCTMPND)
End DoDot:1
+39 ;
+40 QUIT
+41 ;
INCLUDE(RCZ,EOBIEN,RCTYPE) ; PRCA*4.5*326 change parameters
+1 ; Function returns 1 if record should be included based on ins co
+2 ; RCINS = array containing insurance co information
+3 ; RCZ = ien of the entry in file 430
+4 ; PRCA*4.5*326
NEW OK,RCI,RCINM,RCAINP,XX
+5 SET OK=1
+6 SET RCI=+$$INS(RCZ)
+7 ;
+8 ; Not a third party bill
IF 'RCI
SET OK=0
GOTO INCQ
+9 ;
+10 ; PRCA*4.5*326 - Start modified block - Check for payer match
+11 ;
IF RCINS'="A"
Begin DoDot:1
+12 SET OK=$$ISSEL^RCDPEU1(361.1,EOBIEN)
End DoDot:1
+13 ;
IF '$TEST
IF RCTYPE'="A"
Begin DoDot:1
+14 SET OK=$$ISTYPE^RCDPEU1(361.1,EOBIEN,RCTYPE)
End DoDot:1
+15 ; PRCA*4.5*326 - End modified block
+16 ;
INCQ QUIT OK
+1 ;
INSNM(RCZ,EOBIEN) ; Returns the name of payer from the ERA associated with the EOB
+1 ; If that is null, return the insurance co for bill ien RCZ file 430
+2 ; Input: RCZ = Point to bill, file #430
+3 ; EOBIEN = Pointer to EOB file 361.1
+4 ; Returns: NM = Free text name of Payer from ERA or insurance on bill if ERA not found.
+5 ;
+6 NEW ERAIEN,FILE,NM
+7 SET NM=""
+8 SET ERAIEN=$$EOBERA^RCDPEU1(EOBIEN)
+9 IF ERAIEN
SET NM=$$GETNAME^RCDPEU1(344.4,ERAIEN)
+10 IF NM=""
SET NM=$PIECE($GET(^DIC(36,+$$INS(RCZ),0)),U)
+11 QUIT NM
+12 ;
INS(RCZ) ; Returns ien of insurance co for bill ien RCZ from file 430
+1 NEW RC
+2 ;DEBTOR
SET RC=$PIECE($GET(^PRCA(430,RCZ,0)),U,9)
+3 QUIT $SELECT($PIECE($GET(^RCD(340,+RC,0)),U)'["DIC(36":"",1:+^(0))
+4 ;
NEWPG(RCINS,RCNEW,RCLINES) ; Check for new page needed, output header
+1 ; RCINS = ins co selection criteria
+2 ; RCNEW = 1 to force new page
+3 ; RCLINES = Number of lines before IOSL to force new page
+4 ; Function returns 1 if user chooses to stop output
+5 SET RCLINES=$GET(RCLINES,5)
+6 IF RCNEW!(($Y+RCLINES)>IOSL)
Begin DoDot:1
+7 if '$GET(RCDISPTY)
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
End DoDot:1
+8 QUIT RCSTOP
+9 ;
EEOB(RCZ,RCEOB,RCZRO) ; Find all non-MRA EEOBs for bill ien RCZ
+1 ; Function returns 1 if any valid EEOBs found, 0 if none
+2 ; RCEOB(eob ien)=date posted returned for valid EEOBs found -
+3 ; pass by reference
+4 NEW OK,Z,Z0,Z00,DET,SN,ZPD,ZINC
+5 KILL RCEOB
+6 ;
+7 SET (Z,OK,SN,ZINC)=0
+8 ; IA 4051 for File #361.1
+9 FOR
SET Z=$ORDER(^IBM(361.1,"B",RCZ,Z))
if 'Z
QUIT
IF $PIECE($GET(^IBM(361.1,Z,0)),U,4)'=1
Begin DoDot:1
+10 ; retrieve the EEOB data from ERA Detail sub-entry
+11 SET (Z0,DET)=0
+12 ; ERA Detail
FOR
SET Z0=$ORDER(^RCY(344.4,"ADET",Z,Z0))
if 'Z0
QUIT
FOR
SET DET=$ORDER(^RCY(344.4,"ADET",Z,Z0,DET))
if 'DET
QUIT
Begin DoDot:2
+13 ; PRCA*4.5*303 - added check for Zero paid or Paid > 0 check for report.
+14 SET ZINC=0
SET ZPD=+$PIECE($GET(^RCY(344.4,Z0,1,DET,0)),U,3)
+15 ; PRCA*4.5*332
IF (RCZRO="A")
SET ZINC=1
+16 IF (RCZRO="Z")
IF (ZPD=0)
SET ZINC=1
+17 ; PRCA*4.5*332
IF (RCZRO="P")
IF (ZPD>0)
SET ZINC=1
+18 ; PRCA*4.5*303 - Removed looking for Receipt, include record based on ERA DETAIL POST STATUS
+19 ; PRCA*4.5*303 - Removed check for Receipt (If Z1 is not empty) Changed date to Piece 7 and
+20 ; added check for either 0 paid or paid >0 depending on selection. Added ERA PD AMOUNT as second piece of RCEOB array
+21 ; PRCA*4.5*332
IF ZINC
SET SN=SN+1
SET RCEOB(Z,SN)=+$PIECE($GET(^RCY(344.4,Z0,0)),U,7)_U_ZPD
SET OK=1
End DoDot:2
End DoDot:1
+22 ;
+23 QUIT OK
+24 ;
SL1(RCSORT,RCZ) ; Function returns 1st sort level data from ien RCZ in file 430
+1 ; RCSORT = "PN" for patient name sort = "L4" for SSN last 4 sort
+2 NEW DAT
+3 IF RCSORT="PN"
SET DAT=$PIECE($GET(^DPT(+$PIECE($GET(^PRCA(430,RCZ,0)),U,7),0)),U)
+4 IF RCSORT="L4"
SET DAT=$PIECE($GET(^DPT(+$PIECE($GET(^PRCA(430,RCZ,0)),U,7),0)),U,9)
SET DAT=$EXTRACT(DAT,$LENGTH(DAT)-3,$LENGTH(DAT))
+5 QUIT $SELECT($GET(DAT)'="":DAT,1:" ")
+6 ;
SELECT(RCINS,RCSORT,RCZRO,RCTYPE) ; Select insurance co, sort criteria, Zero Payment, Bill type (Med/RX) and if output for EXCEL format is selected
+1 ; Function returns values selected for RCSORT and RCINS - passed by ref
+2 NEW RCQUIT,DONE,DIR,X,Y,%DT
+3 SET (RCQUIT,DONE,RCLSTMGR)=0
+4 ; PRCA*4.5*326 - Begin changed block - Ask to show Medical/Pharmacy Tricare, CHAMPVA or All
+5 SET RCTYPE=$$RTYPE^RCDPEU1("")
+6 IF RCTYPE=-1
GOTO SELQ
+7 ;
+8 SET RCINS=$$PAYRNG^RCDPEU1()
+9 IF RCINS=-1
GOTO SELQ
+10 ;
+11 IF RCINS'="A"
Begin DoDot:1
+12 SET RCPAR("TYPE")=RCTYPE
+13 SET RCPAR("SELC")=RCINS
+14 SET RCPAR("DICA")="SELECT INSURANCE COMPANY: "
+15 SET XX=$$SELPAY^RCDPEU1(.RCPAR)
End DoDot:1
IF XX=-1
GOTO SELQ
+16 ; PRCA*4.5*326 - End changed block
+17 ;
+18 ; PRCA*4.5*303 - Add Zero $ Prompt and Medical/Pharmacy EEOBs Prompt
+19 SET DIR(0)="SA^P:PAYMENT EEOBs;Z:ZERO PAYMENT EEOBs;A:ALL"
+20 SET DIR("A")="RUN REPORT FOR (P)AYMENT EEOBs or (Z)ERO PAYMENT EEOBs or (A)LL: "
SET DIR("B")="ALL"
+21 WRITE !
DO ^DIR
KILL DIR
+22 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO SELQ
+23 SET RCZRO=$EXTRACT(Y,1)
+24 ;
+25 SET DIR(0)="SA^P:PATIENT NAME;L:LAST 4 OF PATIENT SSN"
SET DIR("A")="WITHIN INS CO, SORT BY (P)ATIENT NAME OR (L)AST 4 OF SSN?: "
SET DIR("B")="PATIENT NAME"
WRITE !
DO ^DIR
KILL DIR
+26 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO SELQ
+27 SET RCSORT=$SELECT(Y="P":"PN",1:"L4")
+28 SET DIR(0)="SA^F:FIRST TO LAST;L:LAST TO FIRST"
SET DIR("A")="SORT "_$SELECT(RCSORT="PN":"PATIENT NAME",1:"LAST 4")_" (F)IRST TO LAST OR (L)AST TO FIRST?: "
SET DIR("B")="FIRST TO LAST"
DO ^DIR
KILL DIR
+29 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO SELQ
+30 IF Y="L"
SET RCSORT=RCSORT_";-"
+31 ;
+32 ; PRCA*4.5*298 - Add Date Range Prompts
+33 KILL DIR
+34 SET DIR("?")="ENTER THE EARLIEST RECEIVED DATE TO INCLUDE ON THE REPORT"
+35 SET DIR(0)="DAO^:"_DT_":APE"
SET DIR("A")="START DATE (RECEIVED): "
SET DIR("B")="T"
DO ^DIR
KILL DIR
+36 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
GOTO SELQ
+37 SET START=Y
+38 KILL DIR
+39 SET DIR("?")="ENTER THE LATEST RECEIVED DATE TO INCLUDE ON THE REPORT"
+40 SET DIR("B")="T"
+41 SET DIR(0)="DAO^"_START_":"_DT_":APE"
SET DIR("A")="END DATE (RECEIVED): "
DO ^DIR
KILL DIR
+42 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
GOTO SELQ
+43 SET END=Y
+44 ; PRCA*4.5*326 - Remove old Tricare and CHAMPVA prompts
+45 ;
+46 ; PRCA*4.5*276 - Determine whether to gather data for Excel report.
+47 SET RCDISPTY=$$DISPTY^RCDPEM3
if RCDISPTY<0
GOTO SELQ
+48 IF RCDISPTY
DO INFO^RCDPEM6
SET DONE=1
GOTO SELQ
+49 ;
+50 ; PRCA*4.5*298 - Add ListManager Prompts
+51 SET RCLSTMGR=$$ASKLM^RCDPEARL
if RCLSTMGR<0
GOTO SELQ
+52 ;
+53 SET DONE=1
+54 ;
SELQ ;
+1 QUIT DONE
+2 ;
LIST(DIR,RCINS) ; Sets up help array for ins co selected in DIR("?")
+1 NEW CT,Z
+2 SET CT=1
+3 IF '$ORDER(RCINS("S",0))
SET DIR("?")="NO INSURANCE COMPANIES SELECTED"
QUIT
+4 SET DIR("?",1)="INSURANCE COMPANIES ALREADY SELECTED:"
+5 SET Z=0
FOR
SET Z=$ORDER(RCINS("S",Z))
if 'Z
QUIT
SET CT=CT+1
SET DIR("?",CT)=" "_$PIECE($GET(^DIC(36,Z,0)),U)
+6 SET DIR("?")=" "
+7 QUIT
+8 ;
HDRBLD ; create the report header
+1 ; returns RCHDR,RCPGNUM,RCSTOP
+2 ; RCHDR(0) = header text line count
+3 ; RCHDR("PGNUM") = page number
+4 ; RCHDR("XECUTE") = M code for page number
+5 ; RCHDR("RUNDATE") = date/time report generated
+6 ; RCPGNUM - page counter
+7 ; RCSTOP - flag to stop listing
+8 ; INPUT:
+9 ; RCDTRNG - date range filter value to be printed as part of the header
+10 ; RCPAY - Payer filter value(s)
+11 ; RCLSTMGR
+12 ;
+13 NEW Z0
+14 SET Z0=""
+15 KILL RCHDR
SET RCHDR("RUNDATE")=$$NOW^RCDPEARL
SET RCPGNUM=0
SET RCSTOP=0
+16 ;
+17 ; Excel format, xecute code is QUIT, null page number
IF RCDISPTY
Begin DoDot:1
+18 SET RCHDR(0)=1
SET RCHDR("XECUTE")="Q"
SET RCPGNUM=""
+19 SET RCHDR(1)="PATIENT NAME^SSN^BILL#^INS CO NAME^BALANCE^AMT BILLE^AMT PAID^TRACE#^DT REC'D^DT POST^ERA PD AMT"
End DoDot:1
QUIT
+20 ;
+21 NEW MSG,DATE,Y,DIV,HCNT
+22 ; line 1 will be replaced by XECUTE code below
SET RCHDR(1)=$$HDRNM
SET HCNT=1
+23 SET RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDRNM^"_$TEXT(+0)_"_$S(RCLSTMGR:"""",1:$J(""Page: ""_RCPGNUM,12)),RCHDR(1)=$J("" "",80-$L(Y)\2)_Y"
+24 ;
+25 SET Y="RUN DATE: "_RCHDR("RUNDATE")
SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+26 IF VAUTD=1
SET Y="DIVISIONS: ALL"
+27 IF VAUTD=0
Begin DoDot:1
+28 SET Z0=0
SET Y="DIVISIONS: "
FOR X=1:1
SET Z0=$ORDER(VAUTD(Z0))
if Z0=""
QUIT
if X>1
SET Y=Y_", "
SET Y=Y_VAUTD(Z0)
End DoDot:1
+29 SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+30 IF RCINS="S"
SET Z=0
SET Z0=""
FOR
SET Z=$ORDER(RCINS("S",Z))
if 'Z
QUIT
SET Z0=Z0_$SELECT(Z0'="":",",1:"")_$PIECE($GET(^DIC(36,Z,0)),U)
+31 ; PRCA*4.5*326 - Start modified block
+32 SET Z0="PAYERS: "_$SELECT(RCINS="A":"ALL ",RCINS="R":"RANGE",1:"SELECTED")
+33 ;PRCA*4.5*432 Add CHAMPVA
SET Z0=Z0_$JUSTIFY("",16)_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: "_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")
+34 SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Z0)\2)_Z0
SET Z0=""
+35 ; PRCA*4.5*326 modify next two lines for tricare filter
+36 SET Z0=Z0_"DATE RANGE: "_$$FMTE^XLFDT(START,"2Z")_"-"_$$FMTE^XLFDT(END,"2Z")
+37 ; PRCA*4.5*332
SET Z0=Z0_$JUSTIFY("",16)_" PAYMENT TYPE: "_$SELECT(RCZRO="Z":"ZERO PAYMENT",RCZRO="P":"PAYMENT",1:"ALL")
+38 ; PRCA*4.5*326 - End modified block
+39 ;
+40 SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Z0)\2)_Z0
+41 ;
+42 SET HCNT=HCNT+1
SET RCHDR(HCNT)=""
+43 SET Y="PATIENT NAME SSN BILL#"
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+44 SET Y="INS CO NAME BALANCE AMT BILLED AMT PAID"
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+45 SET Y=" TRACE# ERA PD AMT REC'D DT POST"
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+46 SET Y=$TRANSLATE($JUSTIFY("",IOM)," ","=")
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+47 SET RCHDR(0)=HCNT
+48 QUIT
+49 ;
HDRLM ; create the list manager version of the report header
+1 ; returns RCHDR,RCPGNUM,RCSTOP
+2 ; RCHDR(0) = header text line count
+3 ; RCHDR("PGNUM") = page number
+4 ; RCHDR("XECUTE") = M code for page number
+5 ; RCHDR("RUNDATE") = date/time report generated
+6 ; RCPGNUM - page counter
+7 ; RCSTOP - flag to stop listing
+8 ;INPUT:
+9 ; RCDTRNG - date range filter value to be printed as part of the header
+10 ; RCPAY - Payer filter value(s)
+11 ; RCLSTMGR
+12 ;
+13 NEW Z0
SET Z0=""
+14 KILL RCHDR
SET RCPGNUM=0
SET RCSTOP=0
+15 NEW MSG,DATE,Y,DIV,HCNT
+16 ; PRCA*4.5*326 Start modified code block
+17 SET HCNT=1
+18 SET RCHDR("TITLE")=$$HDRNM
SET RCHDR("XECUTE")="Q"
+19 SET RCHDR(1)="DATE RANGE: "_$$FMTE^XLFDT(START,"2Z")_"-"_$$FMTE^XLFDT(END,"2Z")_$JUSTIFY("",16)
+20 ; PRCA*4.5*332
SET RCHDR(1)=RCHDR(1)_" PAYMENT TYPE: "_$SELECT(RCZRO="Z":"ZERO PAYMENT",RCZRO="P":"PAYMENT",1:"ALL")
+21 IF VAUTD=1
SET Y="DIVISIONS: ALL"
+22 IF VAUTD=0
Begin DoDot:1
+23 SET Z0=0
SET Y="DIVISIONS: "
FOR X=1:1
SET Z0=$ORDER(VAUTD(Z0))
if Z0=""
QUIT
if X>1
SET Y=Y_", "
SET Y=Y_VAUTD(Z0)
End DoDot:1
+24 SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+25 IF RCINS="S"
SET Z=0
SET Z0=""
FOR
SET Z=$ORDER(RCINS("S",Z))
if 'Z
QUIT
SET Z0=Z0_$SELECT(Z0'="":",",1:"")_$PIECE($GET(^DIC(36,Z,0)),U)
+26 SET Z0="PAYERS: "_$SELECT(RCINS="A":"ALL ",RCINS="R":"RANGE",1:"SELECTED")
+27 ;PRCA*4.5*432 Add CHAMPVA
SET Z0=Z0_$JUSTIFY("",38-$LENGTH(Z0))_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: "_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")
+28 ; PRCA*4.5*326 End modified code block
+29 SET HCNT=HCNT+1
SET RCHDR(HCNT)=Z0
+30 IF RCINS="A"
SET HCNT=HCNT+1
SET RCHDR(HCNT)=""
+31 ;
+32 SET Y="PATIENT NAME SSN BILL#"
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+33 SET Y="INS CO NAME BALANCE AMT BILLED AMT PAID"
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+34 SET Y=" TRACE# ERA PD AMT REC'D DT POST"
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+35 SET RCHDR(0)=HCNT
+36 QUIT
+37 ;
+38 ; extrinsic variable, name for header PRCA*4.5*298
HDRNM() QUIT "EDI LOCKBOX ACTIVE BILLS W/EEOB REPORT"
