- 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 Feb 18, 2025@23:11:28 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 ;