- 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 Apr 23, 2025@17:58:37 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"
