VistA-WorldVistAEHR/r/ACCOUNTS_RECEIVABLE-PRCA-PR.../RCDPEAC.m

207 lines
8.9 KiB
Mathematica

RCDPEAC ;ALB/TMK - ACTIVE BILLS WITH EEOB ON FILE ;27-JAN-2004
;;4.5;Accounts Receivable;**208**;Mar 20, 1995
;
EN ; Entrypoint for producing the report
N RCSORT,RCINS,ZTRTN,ZTDESC,ZTSAVE,ZTSK,%ZIS,POP
Q:'$$SELECT(.RCINS,.RCSORT)
W !
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
. S ZTRTN="ENQ^RCDPEAC",ZTDESC="AR - ACTIVE BILLS WITH EEOB REPORT",ZTSAVE("RCINS")="",ZTSAVE("RCSORT")="",ZTSAVE("RCINS(")=""
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
. K ZTSK,IO("Q") D HOME^%ZIS
U IO
;
ENQ ; Queued entrypoint 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 Z,Z0,RCACT,RCBILL,RCEOB,RCTOT,RCSTOP,RCNEW,RCZ,RCZ0
K ^TMP($J,"RCSORT")
S RCACT=+$O(^PRCA(430.3,"AC",102,0)) ; Get active status ien
G:'RCACT ENOUT
;
S RCBILL=0
F S RCBILL=$O(^PRCA(430,"AC",RCACT,RCBILL)) Q:RCBILL="" I +$G(^PRCA(430,RCBILL,7))>0,$$INCLUDE(.RCINS,RCBILL),$$EEOB(RCBILL,.RCEOB) D
. S (RCTOT,RCEOB)=0 F S RCEOB=$O(RCEOB(RCEOB)) Q:'RCEOB S RCTOT=RCTOT+$G(^IBM(361.1,RCEOB,1)),^TMP($J,"RCSORT",$$INSNM(RCBILL),$$SL1(RCSORT,RCBILL),RCBILL,+RCEOB(RCEOB),RCEOB)=""
. I $O(RCEOB(0)) S ^TMP($J,"RCSORT",$$INSNM(RCBILL),$$SL1(RCSORT,RCBILL),RCBILL)=RCTOT
;
S RCZ="",(RCPG,RCSTOP,RCNEW)=0
F S RCZ=$O(^TMP($J,"RCSORT",RCZ)) Q:RCZ=""!RCSTOP S RCZ0="" S:$G(RCINS)="R"!($G(RCINS)="S") RCNEW=1 D
. I RCSORT'["-" D
.. S RCZ0="" F S RCZ0=$O(^TMP($J,"RCSORT",RCZ,RCZ0)) Q:RCZ0=""!RCSTOP D OUTPUT(RCZ,RCZ0,RCSORT,.RCSTOP,.RCINS,.RCPG,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,.RCPG,.RCNEW) S RCNEW=0
;
I 'RCSTOP,RCPG D ASK(.RCSTOP)
;
ENOUT I $D(ZTQUEUED) S ZTREQ="@"
I '$D(ZTQUEUED) D ^%ZISC
K ^TMP($J,"RCSORT")
Q
;
OUTPUT(RCZ,RCZ0,RCSORT,RCSTOP,RCINS,RCPG,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 RCZ1,RCBILL,RC399,RCPT,RC430,RC0,RCEOB,X,Y
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(RCPG) W !!,"***TASK STOPPED BY USER***" Q
. S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW) S RCNEW=0
. Q:RCSTOP
. S RC399=$G(^DGCR(399,RCBILL,0)),RCPT=+$P(RC399,U,2),RC430=$G(^PRCA(430,RCBILL,0))
. S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW) Q:RCSTOP
. S X=$$GET1^DIQ(430,RCBILL_",",11)
. W !,$E($P(RC399,U)_$J("",8),1,8)_" "_$E($P($G(^DPT(RCPT,0)),U)_$J("",25),1,25)_" "_$E($P($G(^DPT(RCPT,0)),U,9)_$J("",10),1,10)_" ",$E($$INSNM(RCBILL)_$J("",30),1,30)
. W !,$J("",8)_$E($J(+$P(RC430,U,3),"",2)_$J("",13),1,13)_" "_$E($J(+$G(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL)),"",2)_$J("",13),1,13)_" "_$E($J(+X,"",2)_$J("",12),1,12)
. I $P($G(^PRCA(430,RCBILL,6)),U,4) W " "_$$FMTE^XLFDT($P(^PRCA(430,RCBILL,6),U,4),2)
. S RCEOB=0 F S RCEOB=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1,RCEOB)) Q:'RCEOB!RCSTOP D
.. S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW)
.. Q:RCSTOP
.. S RC0=$G(^IBM(361.1,RCEOB,0))
.. S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW) Q:RCSTOP
.. W !,?10,$E($P(RC0,U,7)_$J("",27),1,27)_" "_$E($$FMTE^XLFDT($P(RC0,U,5),"2D")_$J("",8),1,8)_" "_$E($$FMTE^XLFDT($P(RC0,U,6),"2D")_$J("",8),1,8)_" "_$E($S(RCZ1:$$FMTE^XLFDT(RCZ1,"2D"),1:"")_$J("",8),1,8)
.. W " "_$J(+$G(^IBM(361.1,RCEOB,1)),"",2)
;
Q
;
INCLUDE(RCINS,RCZ) ; 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
S OK=0
S RCI=+$$INS(RCZ)
;
I 'RCI G INCQ ; Not a third party bill
;
I RCINS="A" S OK=1
;
I RCINS="S"!(RCINS="R") D
. I RCINS="S" S:$D(RCINS("S",RCI)) OK=1 Q
. S RCINM=$$INSNM(RCZ) ; INS CO NAME
. I $S(RCINM=RCINS("FR")!(RCINM]RCINS("FR")):RCINM']RCINS("TO"),1:0) S OK=1
;
INCQ Q OK
;
INSNM(RCZ) ; Returns the name of the insurance co for bill ien RCZ file 430
N 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(RCPG,RCINS,RCNEW) ; Check for new page needed, output header
; RCINS = ins co selection criteria
; RCNEW = 1 to force new page
; Function returns 1 if user chooses to stop output
I RCNEW!'RCPG!(($Y+5)>IOSL) D
. D:RCPG ASK(.RCSTOP) I RCSTOP Q
. D HDR(.RCPG,.RCINS)
Q RCSTOP
;
EEOB(RCZ,RCEOB) ; 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
K RCEOB
;
S OK=0
S Z=0 F S Z=$O(^IBM(361.1,"B",RCZ,Z)) Q:'Z I $P($G(^IBM(361.1,Z,0)),U,4)'=1 D
. N Z0,Z1,Z00
. S Z0=+$O(^RCY(344.4,"ADET",Z,0)) ; ERA entry received in
. S Z1=+$P($G(^RCY(344.4,Z0,0)),U,8) ; Receipt
. S Z00=$P($G(^RCY(344.4,Z0,0)),U,14)
. I Z1,$S(Z00=1!(Z00=2):1,1:0) S RCEOB(Z)=+$P($G(^RCY(344,Z1,0)),U,8),OK=1
;
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) ; Select insurance co and sort criteria
; Function returns values selected for RCSORT and RCINS - passed by ref
N RCQUIT,DONE,DIR,X,Y
S (RCQUIT,DONE)=0
S DIR(0)="SA^A:ALL;S:SPECIFIC;R:RANGE",DIR("A")="RUN REPORT FOR (A)LL, (S)PECIFIC, OR (R)ANGE OF INSURANCE COMPANIES?: ",DIR("B")="ALL" W ! D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) G SELQ
;
S RCINS=Y
I RCINS="S" D G:RCQUIT SELQ
. W !
. F D LIST(.DIR,.RCINS) S DIR("A")="SELECT "_$S($O(RCINS("S",0)):"ANOTHER ",1:"")_"INSURANCE COMPANY"_$S($O(RCINS("S",0)):" (PRESS RETURN WHEN DONE)",1:"")_": ",DIR(0)="PAO^DIC(36,:AEMQ" D ^DIR K DIR D Q:Y'>0
.. I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
.. I Y>0 S RCINS("S",+Y)=""
. I '$O(RCINS("S",0)) S RCQUIT=1 W !!,"NO INSURANCE COMPANIES SELECTED - NO REPORT GENERATED" S DIR(0)="E" D ^DIR K DIR
;
I RCINS="R" D I RCQUIT W !!,"NO INSURANCE COMPANY NAME RANGE SELECTED - NO REPORT GENERATED" S DIR(0)="E" D ^DIR K DIR G SELQ
. W !
. S DIR("?")="ENTER 1-30 UPPERCASE CHARACTERS OF THE FIRST NAME TO INCLUDE"
. S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="START WITH INSURANCE COMPANY NAME: " D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
. S RCINS("FR")=Y
. S DIR("?")="ENTER 1-30 UPPERCASE CHARACTERS OF THE LAST NAME TO INCLUDE"
. S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="GO TO INSURANCE COMPANY NAME: ",DIR("B")=$E(RCINS("FR"),1,27)_"ZZZ"
. F W ! D ^DIR Q:$S($D(DTOUT)!$D(DUOUT):1,1:RCINS("FR")']Y) W !,"'GO TO' NAME MUST COME AFTER 'START WITH' NAME"
. K DIR
. I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
. S RCINS("TO")=Y
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_";-"
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
;
HDR(RCPG,RCINS) ;Print report hdr
; RCPG = last page #
N Z,Z0,X
I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
S RCPG=$G(RCPG)+1
W !,?5,"EDI LOCKBOX ACTIVE BILLS W/EEOB REPORT",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG
W !!,"INSURANCE SELECTED: "_$S(RCINS="A":"ALL",RCINS="R":"RANGE FROM "_RCINS("FR")_"-"_RCINS("TO"),1:"")
S Z0=""
I RCINS="S" S Z=0,Z0="" F S Z=$O(RCINS("S",Z)) Q:'Z S X=$P($G(^DIC(36,Z,0)),U) D
. I $L(Z0)+$L(X)>79 W Z0 S Z0="" W !
. S Z0=Z0_$S(Z0'="":",",1:"")_X
I Z0'="" W Z0
W !!,"BILL # PATIENT NAME SSN INS CO NAME"
W !," AMOUNT BILLED AMOUNT PAID BALANCE DT REFERRED REG COUNSEL"
W !!,?10,"TRACE #"_$J("",22)_"DT REC'D DT PAID DT POST AMOUNT PAID"
W !,$TR($J("",IOM)," ","=")
Q
;
ASK(RCSTOP) ;
I $E(IOST,1,2)'["C-" Q
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="E" W ! D ^DIR
I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
Q
;