Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPENR4

RCDPENR4.m

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