RCDPENR4 ;ALB/SAB - EPay National Reports - ERA/EFT Report Utilities ;12/14/15
;;4.5;Accounts Receivable;**304,321,326,349**;Mar 20, 1995;Build 44
;;Per VA Directive 6402, this routine should not be modified.
;
;Read ^DGCR(399) via Private IA 3820
;Read ^DG(40.8) via Controlled IA 417
;Read ^IBM(361.1) via Private IA 4051
;Use DIV^IBJDF2 via Private IA 3130
Q
;
; Retrieve a single payer from the
SPAY() ;
;
N DIC,X,Y,DTOUT,DUOUT,DINUM,DLAYGO,NAME
;
S DIC="^DIC(36,",DIC(0)="AEQMZ",DIC("S")="I '$G(^(5))"
S DIC("?")="Enter the Payer name to run this report on."
S DIC("A")="Select Payer: "
D ^DIC K DIC
; timeout or user requested exit
I $G(DUOUT)!$G(DTOUT) Q -1
;
;Return the name instead of the IEN
Q $P(Y,U,2)
;
; - Return first/last day of month (if Y=0), previous month (if Y=1),
M1(X,Y) ;
; first/last day of month in MMDDYYYY format (if Y=2), or date in
; external format (if Y=3).
N X1,X2 S:'$G(X)!(X'?7N.1".".6N) X=DT S:'$G(Y) Y=0
S X2="31^"_$S($E(X,1,3)#4=0:29,1:28)_"^31^30^31^30^31^31^30^31^30^31"
I 'Y S X=$E(X,1,5),X=X_"01"_U_X_$P(X2,U,+$E(X,4,5)) Q X
I Y=1 S X=($E(X,1,5)_"00")-$S(+$E(X,4,5)=1:8900,1:100) Q X
I Y=2 D Q X
.S X1=1700+$E(X,1,3),X=$E(X,4,5),X=X_"01"_X1_U_X_$P(X2,U,+X)_X1
S Y=X X ^DD("DD") S X=Y
Q X
;
; Retrieve the needed 835 information.
; PRCA*4.5*349 - Add Closed Claims filter
GETERA(RCSDATE,RCEDATE,RCRATE,RCCLM) ;
;
N OKAY,RCAMTBL,RCAMTPD,RCBDIV,RCBILL,RCDATA,RCDIV,RCDOS,RCDTBILL,RCDTLDT,RCEFTPD,RCEFTST,RCEFTTYP ; PRCA*4.5*349
N RCEOB,RCERAIDX,RCERANUM,RCERARCD,RCIEN,RCINS,RCINSTIN,RCLDATE,RCLIEN,RCMETHOD ; PRCA*4.5*349
N RCPAPER,RCPAYER,RCPOSTED,RCPSTAT,RCRATETP,RCTIN,RCTRACE,RCTRBD,RCTRLN,RCTRNTYP ; PRCA*4.5*349
;
S RCLDATE=RCSDATE-.001
;
F S RCLDATE=$O(^RCY(344.4,"AFD",RCLDATE)) Q:RCLDATE>RCEDATE Q:RCLDATE="" D
. S RCIEN=""
. F S RCIEN=$O(^RCY(344.4,"AFD",RCLDATE,RCIEN)) Q:'RCIEN D Q
.. S RCDATA=$G(^RCY(344.4,RCIEN,0))
.. Q:RCDATA="" ;No data defined in the transaction
.. Q:'$P(RCDATA,U,10) ;Transaction is an MRA
.. ;
.. ; Only calculate if status is NULL, Unmatched or Matched to Paper Check
.. ; GETEFT will have grabbed there rest
.. S RCEFTST=$P(RCDATA,U,9)
.. I (RCEFTST=1)!(RCEFTST>2) Q
.. S RCPSTAT=$$GET1^DIQ(344.4,RCIEN_",",.14,"I") ; PRCA*4.5*349
.. I 'RCPSTAT!("125"'[RCPSTAT) Q ; PRCA*4.5*349 - ERA is not posted
.. ;
.. S RCERARCD=$P($P(RCDATA,U,7),".",1) ;get the date of the ERA
.. S RCTRACE=$P(RCDATA,U,2) ;get the trace number
.. S RCTRLN=$L(RCTRACE),RCTRBD=$S(RCTRLN<11:1,1:RCTRLN-9)
.. S RCTRACE=$E(RCTRACE,RCTRBD,RCTRLN) ; get the last 10 digits of Trace #
.. S RCTIN=$P(RCDATA,U,3) ;Payer TIN
.. S RCINS=$P(RCDATA,U,6) ;Insurance free text
.. I RCPAY="A",RCTYPE'="A" D Q:'OKAY ; PRCA*4.5*326 If all payers included, check by type
... S OKAY=$$ISTYPE^RCDPEU1(344.4,RCIEN,RCTYPE)
.. ;
.. ; Check Payer Name
.. I RCPAY'="A" D Q:'OKAY ; PRCA*4.5*326
... S OKAY=$$ISSEL^RCDPEU1(344.4,RCIEN)
.. S RCERANUM=$P(RCDATA,U,11) ;# EOBs in ERA
.. ;
.. S RCLIEN=0
.. F S RCLIEN=$O(^RCY(344.4,RCIEN,1,RCLIEN)) Q:RCLIEN="" D Q
... S RCDTLDT=$G(^RCY(344.4,RCIEN,1,RCLIEN,0)) ;Get the ERA Detail
... Q:RCDTLDT="" ;Quit if no ERA Detail
... ;
... S RCEOB=$P(RCDTLDT,U,2) ;Get the EOB info
... Q:'RCEOB ;quit if no info
... ;
... ; Get the BILL/CLAIM IEN from the #399 file
... S RCBILL=$$BILLIEN^RCDPENR1(RCEOB)
... Q:RCBILL="" ;EEOB corrupted, quit
... ;
... I RCCLM="C",'$$CLOSEDB^RCDPENR3(RCBILL) Q ; Bill isn't closed PRCA*4.5*349 added line
... ;
... S RCDIV=$$DIV^IBJDF2(RCBILL)
... S RCDIV=$$GET1^DIQ(40.8,RCDIV_",",".01","E")
... ;
... S RCRATETP=$$GET1^DIQ(399,RCBILL_",",.07,"I")
... Q:RCRATETP'=RCRATE ;Not requested Rate Type
... ;
... S RCDOS=$$GET1^DIQ(399,RCBILL_",",.03,"I")
... S RCAMTBL=$$GET1^DIQ(361.1,RCEOB_",",2.04,"I")
... S RCAMTPD=$$GET1^DIQ(361.1,RCEOB_",",1.01,"I")
... S RCDTBILL=$$GET1^DIQ(399,RCBILL_",",12,"I")
... Q:RCDTBILL="" ;cant calculate if date first printed is NULL
... S RCMETHOD=$S($$GET1^DIQ(344.41,RCLIEN_","_RCIEN_",",9)="":"MANUAL",1:"AUTOPOST") ; PRCA*4.5*349
... S RCPAPER=$P($G(^RCY(344.4,RCLIEN,20)),U,3) ; Paper EOB ERA?
... ;ERA not a paper ERA, is the EOB a Paper EOB
... S:'RCPAPER RCPAPER=$S($$GET1^DIQ(361.1,RCEOB_",",.17,"I")=0:"ERA",1:"PAPER")
... S RCEFTTYP=$S(RCEFTST=2:"PAPER",1:"EFT")
... S RCTRNTYP=RCPAPER_"/"_RCEFTTYP
... S RCERAIDX=$S(RCTRNTYP="ERA/EFT":1,RCTRNTYP="ERA/PAPER":2,RCTRNTYP="PAPER/EFT":3,1:4)
... Q:RCERAIDX=4 ;Paper Check Paper EOB not supported
... ;
... S RCPOSTED=$P($G(^RCY(344.4,RCIEN,7)),U)
... S RCINSTIN=RCINS_"/"_RCTIN
... ;
... S RCDATA=RCBILL_U_RCIEN_U_U_RCEOB_U_RCDOS_U_RCAMTBL_U_RCAMTPD_U_RCDTBILL_U_RCERARCD
... S RCDATA=RCDATA_U_U_RCPOSTED_U_RCTRACE_U_RCMETHOD_U
... S RCDATA=RCDATA_RCTRNTYP_U_RCERANUM_U_RCDIV_U_RCINSTIN_U
... S ^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,RCERAIDX,RCBILL)=RCDATA
;
; Compile the list of payers using the payer TIN. The Payer IENS are extracted
TINARY(RCSTART,RCEND) ;
;
;RCSTART - The text to start the search for insurance companies
;RCEND - The text to end the search for insurance companies,
;
N RCI,RCJ,RCFILE
;
; Clear old data out
K ^TMP("RCDPEADP",$J,"TIN")
;
; If start and end are NULL, then User wishes all payers, set flag and quit
I (RCSTART=""),(RCEND="") S ^TMP("RCDPEADP",$J,"TIN","A")="" Q
;
; If single payer, find the IEN if it exists and post it.
I RCSTART=RCEND D Q
. S RCJ=""
. F S RCJ=$O(^RCY(344.6,"C",RCSTART,RCJ)) Q:RCJ="" D
. . S ^TMP("RCDPEADP",$J,"TIN",RCJ)=""
;
; For a range of payers, loop through the Payer name list until
; you reach the last payer in the range (RCEND)
;
S RCI=$O(^RCY(344.6,"C",RCSTART),-1) ; Set the starting location for the loop
; Loop through the index to find the correct entries. Append a space
F S RCI=$O(^RCY(344.6,"C",RCI)) Q:RCI="" Q:RCI]RCEND D
. S RCJ=""
. F S RCJ=$O(^RCY(344.6,"C",RCI,RCJ)) Q:RCJ="" D
. . S ^TMP("RCDPEADP",$J,"TIN",RCJ)=""
;
Q
;
;Look at both Payer and Payer Tin lists and find insurance companies on both lists to report on.
INTRSCT() ;
;
N RCLPIEN,RCPYRFLG
;
; If ALL payers was selected for both the Payer Name and Payer TIN parameters, set the all flag and quit.
I $D(^TMP("RCDPEADP",$J,"TIN","A"))&$D(^TMP("RCDPEADP",$J,"INS","A")) S ^TMP("RCDPENR2",$J,"INS","A")="" Q 1
;
; If All payers was elected for Payer Name and Payer TIN had entries
; Loop through the Payer TIN array and update valid report array and quit
I $D(^TMP("RCDPEADP",$J,"INS","A")) D Q 1
. M ^TMP("RCDPENR2",$J,"INS")=^TMP("RCDPEADP",$J,"TIN")
. K ^TMP("RCDPEADP",$J,"INS","A") ;remove the all flag from the list
;
; If All payers was elected for Payer TIN and Payer NAME had entries
; Loop through the Payer TIN array and update valid report array and quit
I $D(^TMP("RCDPEADP",$J,"TIN","A")) D Q 1
. M ^TMP("RCDPENR2",$J,"INS")=^TMP("RCDPEADP",$J,"INS")
. K ^TMP("RCDPENR2",$J,"TIN","A") ;remove the all flag from the list
;
; A range of payers (1 or more) were selected for both Payer lists (Name and TIN)
; Loop through the TIN array and see if the Payer Name IEN is in the TIN array.
; If so, update the valid report array and quit.
S RCPYRFLG=0,RCLPIEN=""
F S RCLPIEN=$O(^TMP("RCDPEADP",$J,"TIN",RCLPIEN)) Q:'RCLPIEN D
. I $D(^TMP("RCDPEADP",$J,"INS",RCLPIEN)) D
. . S ^TMP("RCDPENR2",$J,"INS",RCLPIEN)=""
. . S:'RCPYRFLG RCPYRFLG=1
;
; No payers found
Q RCPYRFLG
;
;Print the data requested (Volume Statistics Report)
PRINTRP(RCTITLE,RCDATA,RCRPIEN,RCDISP,RCTFLG) ;
;
;Expected "^" delimeted format of RCDATA is:
; Piece 1 - # 837s
; Piece 2 - # NCPDPs
; Piece 3 - # 835s
; Piece 4 - # 837s with 835s
; Piece 5 - # NCPDPs with 835s
; Piece 6 - Avg days from 837 send to 835 receipt
; Piece 7 - Avg days from NCPDP send to 835 receipt
;
; Undeclared parameters RCLINE (line of "-" characters) RCSTOP (user requested stop flag)
;
N RC835,RCNCPDP,RC837,RCNO837,RCNNCPDP,RCANCPDP,RCAVG837,RCSPACE,RCSTR,RCFLG
;
I $Y>(IOSL-12),RCDISP D Q:RCSTOP RCFLG
. D ASK^RCDPEADP(.RCSTOP,0)
. I RCSTOP S RCFLG=-1 Q
. D HEADER^RCDPENR1
;
S RCDISP=$G(RCDISP),RCTFLG=$G(RCTFLG)
I RCDISP,RCTFLG D
. W !,RCTITLE,!!
. W RCLINE,!
;
S RCSPACE=""
S $P(RCSPACE," ",80)=""
;
I RCDISP D Q 1
. W "NUMBER OF 837s TRANSMITTED TO MEDICAL PAYERS",?65,$J(+$P(RCDATA,U),10)
. W !,"NUMBER OF NCPDP CLAIMS TRANSMITTED TO PHARMACY PBMs",?65,$J(+$P(RCDATA,U,2),10)
. W !,"NUMBER OF 835s RECEIVED FROM MEDICAL PAYERS",?65,$J(+$P(RCDATA,U,3),10)
. W !,"NUMBER OF 835s RECEIVED FROM PHARMACY PBMS",?65,$J(+$P(RCDATA,U,4),10)
. W !,"NUMBER OF 837s WITH A CORRESPONDING 835 (MRA Excluded)",?65,$J(+$P(RCDATA,U,5),10)
. W !,"NUMBER OF NCPDP CLAIM WITH A CORRESPONDING 835",?65,$J(+$P(RCDATA,U,6),10)
. W !,"AVG #DAYS BETWEEN 837 TRANSMIT AND 835 RECEIVED",?65,$J(+$P(RCDATA,U,7),10,1)
. W !,"AVG #DAYS BETWEEN NCPDP CLAIM TRANSMIT AND 835 RCVD",?65,$J(+$P(RCDATA,U,8),10,1)
. W !,RCLINE,!
I 'RCDISP D
. S RCSTR="NUMBER OF 837s TRANSMITTED TO MEDICAL PAYERS^"_+$P(RCDATA,U)
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. S RCSTR="NUMBER OF NCPDP CLAIMS TRANSMITTED TO PHARMACY PBMs^"_+$P(RCDATA,U,2)
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. S RCSTR="NUMBER OF 835s RECEIVED FROM MEDICAL PAYERS^"_+$P(RCDATA,U,3)
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. S RCSTR="NUMBER OF 835s RECEIVED FROM PHARMACY PBMS^"_+$P(RCDATA,U,4)
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. S RCSTR="NUMBER OF 837s WITH A CORRESPONDING 835 (MRA Excluded)^"_+$P(RCDATA,U,5)
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. S RCSTR="NUMBER OF NCPDP CLAIM WITH A CORRESPONDING 835^"_+$P(RCDATA,U,6)
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. S RCSTR="AVG #DAYS BETWEEN 837 TRANSMIT AND 835 RECEIVED^"_+$P(RCDATA,U,7)
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. S RCSTR="AVG #DAYS BETWEEN NCPDP CLAIM TRANSMIT AND 835 RCVD^"_+$P(RCDATA,U,8)
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
Q 1
;
PAYSUM(RCINSTIN) ;Print the Payer Summary portion of the report for one payer. New for ; PRCA*4.5*349
; Input: RCINSTIN - Payer Name/TIN combination, key to ^TMP global.
;
N I,J,RCDATA,RCEFT,RCEFTTXT,RCERA,RCERAFLG,RCERATYP,RCERATXT,RCSTRING ; PRCA*4.5*349
;
; Print ERA/EFT combinations for each Insurance Company/Tin combination
S RCINSTIN="",RCSTOP=0
F S RCINSTIN=$O(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN)) Q:RCINSTIN="" D Q:RCSTOP
. I $Y>(IOSL-7) D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER^RCDPENR2
. D PRINTINS^RCDPENR2(RCINSTIN)
. ; Print autoposted and manual for all 3 combinations
. F J="AUTOPOST","MANUAL","TOTAL" Q:RCSTOP F I=1:1:3 D Q:RCSTOP ; PRCA*4.5*349
. . I J="AUTOPOST",I>1 Q ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
. . I (RCAUTO="A"&(J="MANUAL"))!(RCAUTO="N"&(J="AUTOPOST"))!(RCAUTO'="B"&(J="TOTAL")) Q ; PRCA*4.5*349
. . S RCDATA=$G(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,J,I))
. . S RCERATYP=$S(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",1:"EFT/PAPER EOB")
. . S RCERAFLG=0
. . S RCEFTTXT=$P(RCERATYP,"/")
. . S RCERATXT=$P(RCERATYP,"/",2)
. . S RCEFT=$S(RCEFTTXT="EFT":"AN EFT",1:"A PAPER CHECK")
. . S RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_J ; PRCA*4.5*349
. . I (RCEFTTXT="EFT"),(RCERATXT["ERA") S RCERAFLG=1
. . D PRINTGT^RCDPENR3(RCSTRING,RCDATA,RCDISP,RCERAFLG,RCEXCEL)
;
Q RCSTOP
;
DIV(RCDIV) ; build the list of divisions to report on.
; PRCA*4.5*349 - Moved from RCDPENR2 for size
;
N RCI
;
; If all divisions selected, set the all division flag
I $D(RCDIV("A")) S ^TMP("RCDPENR2",$J,"DIVALL")="" Q
;
; Loop through division list and build temp array for it.
S RCI=0
F S RCI=$O(RCDIV(RCI)) Q:'RCI S ^TMP("RCDPENR2",$J,"DIV",RCDIV(RCI))=""
Q
;
GETDIV(RCDIV) ; Retrieve the Division
; PRCA*4.5*349 - Moved from RCDPENR2 for size
;
; The use of DIVISION^VAUTOMA Supported by IA 1077
;
N VAUTD
D DIVISION^VAUTOMA
I VAUTD=1 S RCDIV("A")="" Q 1
I 'VAUTD&($D(VAUTD)'=11) Q -1
M RCDIV=VAUTD
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPENR4 12304 printed Apr 09, 2024@20:44:38 Page 2
RCDPENR4 ;ALB/SAB - EPay National Reports - ERA/EFT Report Utilities ;12/14/15
+1 ;;4.5;Accounts Receivable;**304,321,326,349**;Mar 20, 1995;Build 44
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Read ^DGCR(399) via Private IA 3820
+5 ;Read ^DG(40.8) via Controlled IA 417
+6 ;Read ^IBM(361.1) via Private IA 4051
+7 ;Use DIV^IBJDF2 via Private IA 3130
+8 QUIT
+9 ;
+10 ; Retrieve a single payer from the
SPAY() ;
+1 ;
+2 NEW DIC,X,Y,DTOUT,DUOUT,DINUM,DLAYGO,NAME
+3 ;
+4 SET DIC="^DIC(36,"
SET DIC(0)="AEQMZ"
SET DIC("S")="I '$G(^(5))"
+5 SET DIC("?")="Enter the Payer name to run this report on."
+6 SET DIC("A")="Select Payer: "
+7 DO ^DIC
KILL DIC
+8 ; timeout or user requested exit
+9 IF $GET(DUOUT)!$GET(DTOUT)
QUIT -1
+10 ;
+11 ;Return the name instead of the IEN
+12 QUIT $PIECE(Y,U,2)
+13 ;
+14 ; - Return first/last day of month (if Y=0), previous month (if Y=1),
M1(X,Y) ;
+1 ; first/last day of month in MMDDYYYY format (if Y=2), or date in
+2 ; external format (if Y=3).
+3 NEW X1,X2
if '$GET(X)!(X'?7N.1".".6N)
SET X=DT
if '$GET(Y)
SET Y=0
+4 SET X2="31^"_$SELECT($EXTRACT(X,1,3)#4=0:29,1:28)_"^31^30^31^30^31^31^30^31^30^31"
+5 IF 'Y
SET X=$EXTRACT(X,1,5)
SET X=X_"01"_U_X_$PIECE(X2,U,+$EXTRACT(X,4,5))
QUIT X
+6 IF Y=1
SET X=($EXTRACT(X,1,5)_"00")-$SELECT(+$EXTRACT(X,4,5)=1:8900,1:100)
QUIT X
+7 IF Y=2
Begin DoDot:1
+8 SET X1=1700+$EXTRACT(X,1,3)
SET X=$EXTRACT(X,4,5)
SET X=X_"01"_X1_U_X_$PIECE(X2,U,+X)_X1
End DoDot:1
QUIT X
+9 SET Y=X
XECUTE ^DD("DD")
SET X=Y
+10 QUIT X
+11 ;
+12 ; Retrieve the needed 835 information.
+13 ; PRCA*4.5*349 - Add Closed Claims filter
GETERA(RCSDATE,RCEDATE,RCRATE,RCCLM) ;
+1 ;
+2 ; PRCA*4.5*349
NEW OKAY,RCAMTBL,RCAMTPD,RCBDIV,RCBILL,RCDATA,RCDIV,RCDOS,RCDTBILL,RCDTLDT,RCEFTPD,RCEFTST,RCEFTTYP
+3 ; PRCA*4.5*349
NEW RCEOB,RCERAIDX,RCERANUM,RCERARCD,RCIEN,RCINS,RCINSTIN,RCLDATE,RCLIEN,RCMETHOD
+4 ; PRCA*4.5*349
NEW RCPAPER,RCPAYER,RCPOSTED,RCPSTAT,RCRATETP,RCTIN,RCTRACE,RCTRBD,RCTRLN,RCTRNTYP
+5 ;
+6 SET RCLDATE=RCSDATE-.001
+7 ;
+8 FOR
SET RCLDATE=$ORDER(^RCY(344.4,"AFD",RCLDATE))
if RCLDATE>RCEDATE
QUIT
if RCLDATE=""
QUIT
Begin DoDot:1
+9 SET RCIEN=""
+10 FOR
SET RCIEN=$ORDER(^RCY(344.4,"AFD",RCLDATE,RCIEN))
if 'RCIEN
QUIT
Begin DoDot:2
+11 SET RCDATA=$GET(^RCY(344.4,RCIEN,0))
+12 ;No data defined in the transaction
if RCDATA=""
QUIT
+13 ;Transaction is an MRA
if '$PIECE(RCDATA,U,10)
QUIT
+14 ;
+15 ; Only calculate if status is NULL, Unmatched or Matched to Paper Check
+16 ; GETEFT will have grabbed there rest
+17 SET RCEFTST=$PIECE(RCDATA,U,9)
+18 IF (RCEFTST=1)!(RCEFTST>2)
QUIT
+19 ; PRCA*4.5*349
SET RCPSTAT=$$GET1^DIQ(344.4,RCIEN_",",.14,"I")
+20 ; PRCA*4.5*349 - ERA is not posted
IF 'RCPSTAT!("125"'[RCPSTAT)
QUIT
+21 ;
+22 ;get the date of the ERA
SET RCERARCD=$PIECE($PIECE(RCDATA,U,7),".",1)
+23 ;get the trace number
SET RCTRACE=$PIECE(RCDATA,U,2)
+24 SET RCTRLN=$LENGTH(RCTRACE)
SET RCTRBD=$SELECT(RCTRLN<11:1,1:RCTRLN-9)
+25 ; get the last 10 digits of Trace #
SET RCTRACE=$EXTRACT(RCTRACE,RCTRBD,RCTRLN)
+26 ;Payer TIN
SET RCTIN=$PIECE(RCDATA,U,3)
+27 ;Insurance free text
SET RCINS=$PIECE(RCDATA,U,6)
+28 ; PRCA*4.5*326 If all payers included, check by type
IF RCPAY="A"
IF RCTYPE'="A"
Begin DoDot:3
+29 SET OKAY=$$ISTYPE^RCDPEU1(344.4,RCIEN,RCTYPE)
End DoDot:3
if 'OKAY
QUIT
+30 ;
+31 ; Check Payer Name
+32 ; PRCA*4.5*326
IF RCPAY'="A"
Begin DoDot:3
+33 SET OKAY=$$ISSEL^RCDPEU1(344.4,RCIEN)
End DoDot:3
if 'OKAY
QUIT
+34 ;# EOBs in ERA
SET RCERANUM=$PIECE(RCDATA,U,11)
+35 ;
+36 SET RCLIEN=0
+37 FOR
SET RCLIEN=$ORDER(^RCY(344.4,RCIEN,1,RCLIEN))
if RCLIEN=""
QUIT
Begin DoDot:3
+38 ;Get the ERA Detail
SET RCDTLDT=$GET(^RCY(344.4,RCIEN,1,RCLIEN,0))
+39 ;Quit if no ERA Detail
if RCDTLDT=""
QUIT
+40 ;
+41 ;Get the EOB info
SET RCEOB=$PIECE(RCDTLDT,U,2)
+42 ;quit if no info
if 'RCEOB
QUIT
+43 ;
+44 ; Get the BILL/CLAIM IEN from the #399 file
+45 SET RCBILL=$$BILLIEN^RCDPENR1(RCEOB)
+46 ;EEOB corrupted, quit
if RCBILL=""
QUIT
+47 ;
+48 ; Bill isn't closed PRCA*4.5*349 added line
IF RCCLM="C"
IF '$$CLOSEDB^RCDPENR3(RCBILL)
QUIT
+49 ;
+50 SET RCDIV=$$DIV^IBJDF2(RCBILL)
+51 SET RCDIV=$$GET1^DIQ(40.8,RCDIV_",",".01","E")
+52 ;
+53 SET RCRATETP=$$GET1^DIQ(399,RCBILL_",",.07,"I")
+54 ;Not requested Rate Type
if RCRATETP'=RCRATE
QUIT
+55 ;
+56 SET RCDOS=$$GET1^DIQ(399,RCBILL_",",.03,"I")
+57 SET RCAMTBL=$$GET1^DIQ(361.1,RCEOB_",",2.04,"I")
+58 SET RCAMTPD=$$GET1^DIQ(361.1,RCEOB_",",1.01,"I")
+59 SET RCDTBILL=$$GET1^DIQ(399,RCBILL_",",12,"I")
+60 ;cant calculate if date first printed is NULL
if RCDTBILL=""
QUIT
+61 ; PRCA*4.5*349
SET RCMETHOD=$SELECT($$GET1^DIQ(344.41,RCLIEN_","_RCIEN_",",9)="":"MANUAL",1:"AUTOPOST")
+62 ; Paper EOB ERA?
SET RCPAPER=$PIECE($GET(^RCY(344.4,RCLIEN,20)),U,3)
+63 ;ERA not a paper ERA, is the EOB a Paper EOB
+64 if 'RCPAPER
SET RCPAPER=$SELECT($$GET1^DIQ(361.1,RCEOB_",",.17,"I")=0:"ERA",1:"PAPER")
+65 SET RCEFTTYP=$SELECT(RCEFTST=2:"PAPER",1:"EFT")
+66 SET RCTRNTYP=RCPAPER_"/"_RCEFTTYP
+67 SET RCERAIDX=$SELECT(RCTRNTYP="ERA/EFT":1,RCTRNTYP="ERA/PAPER":2,RCTRNTYP="PAPER/EFT":3,1:4)
+68 ;Paper Check Paper EOB not supported
if RCERAIDX=4
QUIT
+69 ;
+70 SET RCPOSTED=$PIECE($GET(^RCY(344.4,RCIEN,7)),U)
+71 SET RCINSTIN=RCINS_"/"_RCTIN
+72 ;
+73 SET RCDATA=RCBILL_U_RCIEN_U_U_RCEOB_U_RCDOS_U_RCAMTBL_U_RCAMTPD_U_RCDTBILL_U_RCERARCD
+74 SET RCDATA=RCDATA_U_U_RCPOSTED_U_RCTRACE_U_RCMETHOD_U
+75 SET RCDATA=RCDATA_RCTRNTYP_U_RCERANUM_U_RCDIV_U_RCINSTIN_U
+76 SET ^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,RCERAIDX,RCBILL)=RCDATA
End DoDot:3
QUIT
End DoDot:2
QUIT
End DoDot:1
+77 ;
+78 ; Compile the list of payers using the payer TIN. The Payer IENS are extracted
TINARY(RCSTART,RCEND) ;
+1 ;
+2 ;RCSTART - The text to start the search for insurance companies
+3 ;RCEND - The text to end the search for insurance companies,
+4 ;
+5 NEW RCI,RCJ,RCFILE
+6 ;
+7 ; Clear old data out
+8 KILL ^TMP("RCDPEADP",$JOB,"TIN")
+9 ;
+10 ; If start and end are NULL, then User wishes all payers, set flag and quit
+11 IF (RCSTART="")
IF (RCEND="")
SET ^TMP("RCDPEADP",$JOB,"TIN","A")=""
QUIT
+12 ;
+13 ; If single payer, find the IEN if it exists and post it.
+14 IF RCSTART=RCEND
Begin DoDot:1
+15 SET RCJ=""
+16 FOR
SET RCJ=$ORDER(^RCY(344.6,"C",RCSTART,RCJ))
if RCJ=""
QUIT
Begin DoDot:2
+17 SET ^TMP("RCDPEADP",$JOB,"TIN",RCJ)=""
End DoDot:2
End DoDot:1
QUIT
+18 ;
+19 ; For a range of payers, loop through the Payer name list until
+20 ; you reach the last payer in the range (RCEND)
+21 ;
+22 ; Set the starting location for the loop
SET RCI=$ORDER(^RCY(344.6,"C",RCSTART),-1)
+23 ; Loop through the index to find the correct entries. Append a space
+24 FOR
SET RCI=$ORDER(^RCY(344.6,"C",RCI))
if RCI=""
QUIT
if RCI]RCEND
QUIT
Begin DoDot:1
+25 SET RCJ=""
+26 FOR
SET RCJ=$ORDER(^RCY(344.6,"C",RCI,RCJ))
if RCJ=""
QUIT
Begin DoDot:2
+27 SET ^TMP("RCDPEADP",$JOB,"TIN",RCJ)=""
End DoDot:2
End DoDot:1
+28 ;
+29 QUIT
+30 ;
+31 ;Look at both Payer and Payer Tin lists and find insurance companies on both lists to report on.
INTRSCT() ;
+1 ;
+2 NEW RCLPIEN,RCPYRFLG
+3 ;
+4 ; If ALL payers was selected for both the Payer Name and Payer TIN parameters, set the all flag and quit.
+5 IF $DATA(^TMP("RCDPEADP",$JOB,"TIN","A"))&$DATA(^TMP("RCDPEADP",$JOB,"INS","A"))
SET ^TMP("RCDPENR2",$JOB,"INS","A")=""
QUIT 1
+6 ;
+7 ; If All payers was elected for Payer Name and Payer TIN had entries
+8 ; Loop through the Payer TIN array and update valid report array and quit
+9 IF $DATA(^TMP("RCDPEADP",$JOB,"INS","A"))
Begin DoDot:1
+10 MERGE ^TMP("RCDPENR2",$JOB,"INS")=^TMP("RCDPEADP",$JOB,"TIN")
+11 ;remove the all flag from the list
KILL ^TMP("RCDPEADP",$JOB,"INS","A")
End DoDot:1
QUIT 1
+12 ;
+13 ; If All payers was elected for Payer TIN and Payer NAME had entries
+14 ; Loop through the Payer TIN array and update valid report array and quit
+15 IF $DATA(^TMP("RCDPEADP",$JOB,"TIN","A"))
Begin DoDot:1
+16 MERGE ^TMP("RCDPENR2",$JOB,"INS")=^TMP("RCDPEADP",$JOB,"INS")
+17 ;remove the all flag from the list
KILL ^TMP("RCDPENR2",$JOB,"TIN","A")
End DoDot:1
QUIT 1
+18 ;
+19 ; A range of payers (1 or more) were selected for both Payer lists (Name and TIN)
+20 ; Loop through the TIN array and see if the Payer Name IEN is in the TIN array.
+21 ; If so, update the valid report array and quit.
+22 SET RCPYRFLG=0
SET RCLPIEN=""
+23 FOR
SET RCLPIEN=$ORDER(^TMP("RCDPEADP",$JOB,"TIN",RCLPIEN))
if 'RCLPIEN
QUIT
Begin DoDot:1
+24 IF $DATA(^TMP("RCDPEADP",$JOB,"INS",RCLPIEN))
Begin DoDot:2
+25 SET ^TMP("RCDPENR2",$JOB,"INS",RCLPIEN)=""
+26 if 'RCPYRFLG
SET RCPYRFLG=1
End DoDot:2
End DoDot:1
+27 ;
+28 ; No payers found
+29 QUIT RCPYRFLG
+30 ;
+31 ;Print the data requested (Volume Statistics Report)
PRINTRP(RCTITLE,RCDATA,RCRPIEN,RCDISP,RCTFLG) ;
+1 ;
+2 ;Expected "^" delimeted format of RCDATA is:
+3 ; Piece 1 - # 837s
+4 ; Piece 2 - # NCPDPs
+5 ; Piece 3 - # 835s
+6 ; Piece 4 - # 837s with 835s
+7 ; Piece 5 - # NCPDPs with 835s
+8 ; Piece 6 - Avg days from 837 send to 835 receipt
+9 ; Piece 7 - Avg days from NCPDP send to 835 receipt
+10 ;
+11 ; Undeclared parameters RCLINE (line of "-" characters) RCSTOP (user requested stop flag)
+12 ;
+13 NEW RC835,RCNCPDP,RC837,RCNO837,RCNNCPDP,RCANCPDP,RCAVG837,RCSPACE,RCSTR,RCFLG
+14 ;
+15 IF $Y>(IOSL-12)
IF RCDISP
Begin DoDot:1
+16 DO ASK^RCDPEADP(.RCSTOP,0)
+17 IF RCSTOP
SET RCFLG=-1
QUIT
+18 DO HEADER^RCDPENR1
End DoDot:1
if RCSTOP
QUIT RCFLG
+19 ;
+20 SET RCDISP=$GET(RCDISP)
SET RCTFLG=$GET(RCTFLG)
+21 IF RCDISP
IF RCTFLG
Begin DoDot:1
+22 WRITE !,RCTITLE,!!
+23 WRITE RCLINE,!
End DoDot:1
+24 ;
+25 SET RCSPACE=""
+26 SET $PIECE(RCSPACE," ",80)=""
+27 ;
+28 IF RCDISP
Begin DoDot:1
+29 WRITE "NUMBER OF 837s TRANSMITTED TO MEDICAL PAYERS",?65,$JUSTIFY(+$PIECE(RCDATA,U),10)
+30 WRITE !,"NUMBER OF NCPDP CLAIMS TRANSMITTED TO PHARMACY PBMs",?65,$JUSTIFY(+$PIECE(RCDATA,U,2),10)
+31 WRITE !,"NUMBER OF 835s RECEIVED FROM MEDICAL PAYERS",?65,$JUSTIFY(+$PIECE(RCDATA,U,3),10)
+32 WRITE !,"NUMBER OF 835s RECEIVED FROM PHARMACY PBMS",?65,$JUSTIFY(+$PIECE(RCDATA,U,4),10)
+33 WRITE !,"NUMBER OF 837s WITH A CORRESPONDING 835 (MRA Excluded)",?65,$JUSTIFY(+$PIECE(RCDATA,U,5),10)
+34 WRITE !,"NUMBER OF NCPDP CLAIM WITH A CORRESPONDING 835",?65,$JUSTIFY(+$PIECE(RCDATA,U,6),10)
+35 WRITE !,"AVG #DAYS BETWEEN 837 TRANSMIT AND 835 RECEIVED",?65,$JUSTIFY(+$PIECE(RCDATA,U,7),10,1)
+36 WRITE !,"AVG #DAYS BETWEEN NCPDP CLAIM TRANSMIT AND 835 RCVD",?65,$JUSTIFY(+$PIECE(RCDATA,U,8),10,1)
+37 WRITE !,RCLINE,!
End DoDot:1
QUIT 1
+38 IF 'RCDISP
Begin DoDot:1
+39 SET RCSTR="NUMBER OF 837s TRANSMITTED TO MEDICAL PAYERS^"_+$PIECE(RCDATA,U)
+40 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+41 SET RCSTR="NUMBER OF NCPDP CLAIMS TRANSMITTED TO PHARMACY PBMs^"_+$PIECE(RCDATA,U,2)
+42 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+43 SET RCSTR="NUMBER OF 835s RECEIVED FROM MEDICAL PAYERS^"_+$PIECE(RCDATA,U,3)
+44 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+45 SET RCSTR="NUMBER OF 835s RECEIVED FROM PHARMACY PBMS^"_+$PIECE(RCDATA,U,4)
+46 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+47 SET RCSTR="NUMBER OF 837s WITH A CORRESPONDING 835 (MRA Excluded)^"_+$PIECE(RCDATA,U,5)
+48 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+49 SET RCSTR="NUMBER OF NCPDP CLAIM WITH A CORRESPONDING 835^"_+$PIECE(RCDATA,U,6)
+50 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+51 SET RCSTR="AVG #DAYS BETWEEN 837 TRANSMIT AND 835 RECEIVED^"_+$PIECE(RCDATA,U,7)
+52 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+53 SET RCSTR="AVG #DAYS BETWEEN NCPDP CLAIM TRANSMIT AND 835 RCVD^"_+$PIECE(RCDATA,U,8)
+54 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
End DoDot:1
+55 QUIT 1
+56 ;
PAYSUM(RCINSTIN) ;Print the Payer Summary portion of the report for one payer. New for ; PRCA*4.5*349
+1 ; Input: RCINSTIN - Payer Name/TIN combination, key to ^TMP global.
+2 ;
+3 ; PRCA*4.5*349
NEW I,J,RCDATA,RCEFT,RCEFTTXT,RCERA,RCERAFLG,RCERATYP,RCERATXT,RCSTRING
+4 ;
+5 ; Print ERA/EFT combinations for each Insurance Company/Tin combination
+6 SET RCINSTIN=""
SET RCSTOP=0
+7 FOR
SET RCINSTIN=$ORDER(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN))
if RCINSTIN=""
QUIT
Begin DoDot:1
+8 IF $Y>(IOSL-7)
DO ASK^RCDPEADP(.RCSTOP,0)
if RCSTOP
QUIT
DO HEADER^RCDPENR2
+9 DO PRINTINS^RCDPENR2(RCINSTIN)
+10 ; Print autoposted and manual for all 3 combinations
+11 ; PRCA*4.5*349
FOR J="AUTOPOST","MANUAL","TOTAL"
if RCSTOP
QUIT
FOR I=1:1:3
Begin DoDot:2
+12 ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
IF J="AUTOPOST"
IF I>1
QUIT
+13 ; PRCA*4.5*349
IF (RCAUTO="A"&(J="MANUAL"))!(RCAUTO="N"&(J="AUTOPOST"))!(RCAUTO'="B"&(J="TOTAL"))
QUIT
+14 SET RCDATA=$GET(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,J,I))
+15 SET RCERATYP=$SELECT(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",1:"EFT/PAPER EOB")
+16 SET RCERAFLG=0
+17 SET RCEFTTXT=$PIECE(RCERATYP,"/")
+18 SET RCERATXT=$PIECE(RCERATYP,"/",2)
+19 SET RCEFT=$SELECT(RCEFTTXT="EFT":"AN EFT",1:"A PAPER CHECK")
+20 ; PRCA*4.5*349
SET RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_J
+21 IF (RCEFTTXT="EFT")
IF (RCERATXT["ERA")
SET RCERAFLG=1
+22 DO PRINTGT^RCDPENR3(RCSTRING,RCDATA,RCDISP,RCERAFLG,RCEXCEL)
End DoDot:2
if RCSTOP
QUIT
End DoDot:1
if RCSTOP
QUIT
+23 ;
+24 QUIT RCSTOP
+25 ;
DIV(RCDIV) ; build the list of divisions to report on.
+1 ; PRCA*4.5*349 - Moved from RCDPENR2 for size
+2 ;
+3 NEW RCI
+4 ;
+5 ; If all divisions selected, set the all division flag
+6 IF $DATA(RCDIV("A"))
SET ^TMP("RCDPENR2",$JOB,"DIVALL")=""
QUIT
+7 ;
+8 ; Loop through division list and build temp array for it.
+9 SET RCI=0
+10 FOR
SET RCI=$ORDER(RCDIV(RCI))
if 'RCI
QUIT
SET ^TMP("RCDPENR2",$JOB,"DIV",RCDIV(RCI))=""
+11 QUIT
+12 ;
GETDIV(RCDIV) ; Retrieve the Division
+1 ; PRCA*4.5*349 - Moved from RCDPENR2 for size
+2 ;
+3 ; The use of DIVISION^VAUTOMA Supported by IA 1077
+4 ;
+5 NEW VAUTD
+6 DO DIVISION^VAUTOMA
+7 IF VAUTD=1
SET RCDIV("A")=""
QUIT 1
+8 IF 'VAUTD&($DATA(VAUTD)'=11)
QUIT -1
+9 MERGE RCDIV=VAUTD
+10 QUIT 1
+11 ;
