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

RCDPEAPQ.m

Go to the documentation of this file. 
  1. RCDPEAPQ ;AITC/CJE - AUTO POST REPORT -CONTINUED ;Dec 20, 2014@18:42
  1.  ;;4.5;Accounts Receivable;**298,304,326,345,424**;Mar 20, 1995;Build 11
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ; PRCA*4.5*326 - Routine created as an overflow for RCDPEAPP due to size
  1.  Q
  1. SAVE(ERAIEN,RCRZ,RCTYPE,APDATE,RCSORT) ; EP - Save to ^TMP global
  1.  ; Input:   ERAIEN  - Internal IEN into file 344.4
  1.  ;          RCRZ    - Internal IEN into sub-file 344.41
  1.  ;          RCTYPE  - 'D' for detail report, 'S' for summary
  1.  ;          APDATE  - Internal Auto-Posting date
  1.  ;          RCSORT  - 0 - Sort by Payer Name, 1 - Sort by Payer TIN
  1.  ;          STNAM   - Division Name (Primary Sort)
  1.  ;          STNUM   - Station Number
  1.  ;          ^TMP("RCDPEAPP2",$J,ERAIEN,RCRZ) - Array of detail lines
  1.  ; Output:   GTOTAL  - A1^A2^A3^A4 Where:
  1.  ;                     A1 - Total Count
  1.  ;                     A2 - Total Original Amounts
  1.  ;                     A3 - Total Payment Amounts
  1.  ;                     A4 - Total Balance
  1.  N BALANCE,BAMT,BILL,CLAIMIEN,COLLECT,DATE,DEPNO,EFTIEN,EFTNUM,EOBIEN,ERADATE,ERANUM ; PRCA*4.5*345
  1.  N PAMT,PAYIX1,PAYIX2,PAYNAM,PTNAM,RECEIPT,SEQ,SEQ1,SEQ2,STIX
  1.  N TIN,TOTBAL,TOTBAMT,TOTPAMT,TRACE,XX
  1.  S PAYNAM=$$GET1^DIQ(344.4,ERAIEN,.06,"E")          ; Payer Name from ERA Record
  1.  S TIN=$$GET1^DIQ(344.4,ERAIEN,.03,"E")             ; Payer TIN from ERA Record
  1.  S:RCSORT=0 PAYIX1=PAYNAM,PAYIX2=TIN
  1.  S:RCSORT=1 PAYIX1=TIN,PAYIX2=PAYNAM
  1.  S:PAYNAM="" PAYNAM="UNKNOWN"
  1.  S STIX=STNAM_"/"_STNUM
  1.  S (TOTBAMT,TOTBAL,TOTPAMT)=0
  1.  ;
  1.  ; Detail mode, get these extra fields
  1.  I RCTYPE="D" D
  1.  . S TRACE=$$GET1^DIQ(344.4,ERAIEN,.02,"E")         ; Trace Number
  1.  . S PTNAM=$$PNM4^RCDPEWL1(ERAIEN,RCRZ)             ; Patient name from claim file #399
  1.  . S ERANUM=$$GET1^DIQ(344.4,ERAIEN,.01,"E")        ; ERA Number
  1.  . S ERADATE=$$GET1^DIQ(344.4,ERAIEN,.07,"I")       ; Date received (file date/time)
  1.  . S ERADATE=$$FMTE^XLFDT(ERADATE,"2DZ")
  1.  . S DATE=$$FMTE^XLFDT(APDATE,"2DZ")                ; Auto-Posting DATE
  1.  . S EFTNUM=$O(^RCY(344.31,"AERA",ERANUM,""))       ; EFT Number
  1.  . S EFTIEN="" I EFTNUM D                           ; PRCA*4.5*345
  1.  . . S EFTIEN=$$GET1^DIQ(344.31,EFTNUM,.01,"I")
  1.  . . S EFTNUM=$$GET1^DIQ(344.31,EFTNUM,.01,"E")
  1.  . S XX=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.25,"I")  ; Receipt IEN
  1.  . S RECEIPT=$$EXTERNAL^DILFD(344.41,.25,,XX)
  1.  . S DEPNO=""                                        ; PRCA*4.5*345 Deposit ticket number
  1.  . I EFTIEN S DEPNO=$$GET1^DIQ(344.3,EFTIEN_",",.03,"E") ; PRCA*4.5*345
  1.  ;
  1.  ; Get link to the scratchpad detail line. If the worklist detail records exist, 
  1.  ; loop through the ones with the same prefix to get the data (this will have split-edits)
  1.  S SEQ=$G(^TMP("RCDPEAPP2",$J,ERAIEN,RCRZ))
  1.  I SEQ D
  1.  . S SEQ1=SEQ
  1.  . F  S SEQ1=$O(^RCY(344.49,ERAIEN,1,"B",SEQ1)) Q:'SEQ1!(SEQ1\1'=SEQ)  D
  1.  . . S SEQ2=$O(^RCY(344.49,ERAIEN,1,"B",SEQ1,""))
  1.  . . Q:SEQ2=""
  1.  . . S (BAMT,BALANCE,COLLECT)=""
  1.  . . S CLAIMIEN=$$GET1^DIQ(344.491,SEQ2_","_ERAIEN,.07,"I") ; AR Bill
  1.  . . S BILL=$$GET1^DIQ(344.491,SEQ2_","_ERAIEN,.02,"I")     ; Claim #
  1.  . . I BILL="" S BILL="<blank>"
  1.  . . S PAMT=$$GET1^DIQ(344.491,SEQ2_","_ERAIEN,.06,"I")     ; Amount Paid on Claim
  1.  . . ;
  1.  . . ; If there is a claim, get billed amount and balance from the claim
  1.  . . I CLAIMIEN D
  1.  . . . S BAMT=$J(+$$GET1^DIQ(430,CLAIMIEN,3,"I"),0,2)       ; Original Amount
  1.  . . . S BALANCE=$J(+$$GET1^DIQ(430,CLAIMIEN,71,"I"),0,2)   ; Principal Balance
  1.  . . ;
  1.  . . ; Update total amounts
  1.  . . S TOTBAMT=TOTBAMT+BAMT,TOTBAL=TOTBAL+BALANCE,TOTPAMT=TOTPAMT+PAMT
  1.  . . I RCTYPE="D" D                         ; Get extra data for detail report
  1.  . . . S PTNAM=$S('CLAIMIEN:"",1:$$PNM4^RCDPEWL1(ERAIEN,RCRZ))
  1.  . . . S:BAMT COLLECT=$J(PAMT/BAMT*100,0,2)_"%"
  1.  . . . S CNT=CNT+1
  1.  . . . S XX=STNAM_U_STNUM_U_$S(RCSORT:TIN_"/"_PAYNAM,1:PAYNAM_"/"_TIN)_U ; PRCA*4.5*326 add TIN
  1.  . . . S XX=XX_PTNAM_U_ERANUM_U_ERADATE_U_DATE_U_EFTNUM
  1.  . . . S XX=XX_U_RECEIPT_U_BILL_U_BAMT_U_PAMT_U_BALANCE_U_COLLECT_U_TRACE_U_DEPNO ; PRCA*4.5*345
  1.  . . . S @GLOB@(STIX,PAYIX1,PAYIX2,CNT)=XX ; Add data for detail report
  1.  ;
  1.  ; If the worklist detail record does not exist, get data from ERA detail
  1.  I 'SEQ D
  1.  . S (TOTBAMT,TOTBAL,COLLECT,CLAIMIEN)=0
  1.  . S EOBIEN=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.02,"I")  ; IEN for 361.1
  1.  . S:EOBIEN CLAIMIEN=$$GET1^DIQ(361.1,EOBIEN,.01,"I")   ; IEN for 399
  1.  . S BILL=$$EXTERNAL^DILFD(344.41,.02,,EOBIEN)          ; Bill Number
  1.  . ;
  1.  . ; Get Billed Amount from AR (Original Balance)
  1.  . I CLAIMIEN D
  1.  . . S TOTBAMT=$J(+$$GET1^DIQ(430,CLAIMIEN,3,"I"),0,2)   ; Original Amount
  1.  . S TOTPAMT=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.03,"I") ; Amount Paid on Claim
  1.  . ;
  1.  . ; Balance from AR (Principal Balance)
  1.  . S:CLAIMIEN TOTBAL=$J(+$$GET1^DIQ(430,CLAIMIEN,71,"I"),0,2) ; Principal Balance
  1.  . ;
  1.  . ; Detail Report, get extra data and then update the detail global
  1.  . I RCTYPE="D" D
  1.  . . S PTNAM=$S('CLAIMIEN:"",1:$$PNM4^RCDPEWL1(ERAIEN,RCRZ))
  1.  . . S:TOTBAMT COLLECT=$J(TOTPAMT/TOTBAMT*100,0,2)_"%"
  1.  . . S CNT=CNT+1
  1.  . . S XX=STNAM_U_STNUM_U_PAYNAM_U_PTNAM_U_ERANUM_U_ERADATE_U_DATE_U_EFTNUM
  1.  . . S XX=XX_U_RECEIPT_U_BILL_U_TOTBAMT_U_TOTPAMT_U_TOTBAL_U_COLLECT_U_TRACE_U_DEPNO ; PRCA*4.5*345
  1.  . . S @GLOB@(STIX,PAYIX1,PAYIX2,CNT)=XX
  1.  ;
  1.  ; Update totals for individual division
  1.  S $P(@GLOB@(STIX),U,1)=$P($G(@GLOB@(STIX)),U,1)+1
  1.  S $P(@GLOB@(STIX),U,2)=$P($G(@GLOB@(STIX)),U,2)+TOTBAMT
  1.  S $P(@GLOB@(STIX),U,3)=$P($G(@GLOB@(STIX)),U,3)+TOTPAMT
  1.  S $P(@GLOB@(STIX),U,4)=$P($G(@GLOB@(STIX)),U,4)+TOTBAL
  1.  ;
  1.  ; Update totals for individual division/payer
  1.  S $P(@GLOB@(STIX,PAYIX1,PAYIX2),U,1)=$P($G(@GLOB@(STIX,PAYIX1,PAYIX2)),U,1)+1
  1.  S $P(@GLOB@(STIX,PAYIX1,PAYIX2),U,2)=$P($G(@GLOB@(STIX,PAYIX1,PAYIX2)),U,2)+TOTBAMT
  1.  S $P(@GLOB@(STIX,PAYIX1,PAYIX2),U,3)=$P($G(@GLOB@(STIX,PAYIX1,PAYIX2)),U,3)+TOTPAMT
  1.  S $P(@GLOB@(STIX,PAYIX1,PAYIX2),U,4)=$P($G(@GLOB@(STIX,PAYIX1,PAYIX2)),U,4)+TOTBAL
  1.  ;
  1.  ; Update grand totals
  1.  S $P(GTOTAL,U,1)=$P($G(GTOTAL),U,1)+1,$P(GTOTAL,U,2)=$P($G(GTOTAL),U,2)+TOTBAMT
  1.  S $P(GTOTAL,U,3)=$P($G(GTOTAL),U,3)+TOTPAMT,$P(GTOTAL,U,4)=$P($G(GTOTAL),U,4)+TOTBAL
  1.  Q
  1.  ;
  1. ERASTA(ERAIEN,STA,STNUM,STNAM) ; EP - Get the station (Division) for this ERA
  1.  ; Input:   ERAIEN  -
  1.  ; Output:  STA     - Internal Division IEN
  1.  ;          STNUM   - Division Number
  1.  ;          STNAME  - Division Name
  1.  N ERAEOB,ERABILL,FOUND,STAIEN
  1.  S (ERAEOB,ERABILL,FOUND)=""
  1.  S (STA,STNUM,STNAM)="UNKNOWN"
  1.  D
  1.  . S ERAEOB=$$GET1^DIQ(344.41,"1,"_ERAIEN_",",.02,"I") Q:'ERAEOB
  1.  . S ERABILL=$$GET1^DIQ(361.1,ERAEOB,.01,"I") Q:'ERABILL
  1.  . S STAIEN=$$GET1^DIQ(399,ERABILL,.22,"I") Q:'STAIEN
  1.  . S STA=STAIEN
  1.  . S STNAM=$$EXTERNAL^DILFD(399,.22,,STA)
  1.  . S STNUM=$$GET1^DIQ(40.8,STAIEN,1,"E")
  1.  Q
  1.  ;
  1. COMPILE ; Generate the Auto Posting report ^TMP array
  1.  ; Input:   GLOB    - "^TMP("RCDPEAPP",$J)"
  1.  ;          RCDISP  - 0 - Output to paper or screen, 1 - Output to Excel
  1.  ;          RCDIV   - 1 - All divisions, 2 - Selected divisions
  1.  ;          RCDIVS()- Array of selected divisions if RCDIV=2
  1.  ;          RCRANGE - 1^Start Date^End Date
  1.  ;          RCJOB   - $J
  1.  ;          RCLAIM  - "M" - Medical Claims, "P" - Pharmacy Claims, "B" - Both
  1.  ;          RCPAGE  - Initialized to 0
  1.  ;          RCPARRAY- Array of selected payers 
  1.  ;          RCPROG  - "RCDPEAPP"
  1.  ;          RCSORT  - 0 - Sort by Payer Name, 1 - Sort by Payer TIN
  1.  ;          RCWHICH - 1 - Filter by Payer Name, 2 - Filter by Payer TIN
  1.  ;          RCTYPE  - 'D' for detail report, 'S' for summary
  1.  ;          RCPAYMNT - 'Z' - Zero pay ERAs only, 'P' - Non-Zero ERAs only, 'A' All - PRCA*4.5*424
  1.  ;          ^TMP("RCSELPAY",RCJOB) - Selected Payer Names or TINs
  1.  ; Ouput:   GTOTAL  - A1^A2^A3^A4 Where:
  1.  ;                     A1 - Total Count
  1.  ;                     A2 - Total Original Amounts
  1.  ;                     A3 - Total Payment Amounts
  1.  ;                     A4 - Total Balance
  1.  ;          ^TMP("RCSELPAY",RCJOB,A1)=A2/A3 Where:
  1.  ;                      A1 - CTR
  1.  ;                      A2 - Payer Name if RCWHICH=1 else Payer TIN
  1.  ;                      A3 - Payer TIN if RCWHICH=1 else Payer Name
  1.  N APDATE,CNT,END,ERAIEN,IEN,OKAY,RCECME,RCAMT,RCRZ,STA,STNAM,STNUM ; PRCA*4.5*424 add RCAMT
  1.  S APDATE=$$FMADD^XLFDT($P(RCRANGE,U,2),-1)
  1.  S END=$P(RCRANGE,U,3),CNT=0
  1.  ;
  1.  ; Scan F index for ERA within date range
  1.  F  S APDATE=$O(^RCY(344.4,"F",APDATE)) Q:'APDATE  Q:(APDATE\1)>END  D
  1.  . S ERAIEN=""
  1.  . F  S ERAIEN=$O(^RCY(344.4,"F",APDATE,ERAIEN)) Q:'ERAIEN  D
  1.  . . ;
  1.  . . ; Check division - Note return values are set to UNKNOWN if not available
  1.  . . D ERASTA(ERAIEN,.STA,.STNUM,.STNAM)
  1.  . . I RCDIV=2,'$D(RCDIVS(STA)) Q
  1.  . . ; 
  1.  . . ; PRCA*4.5*424 - Filter by payment type
  1.  . . S RCAMT=+$P($G(^RCY(344.4,ERAIEN,0)),"^",5)
  1.  . . I RCPAYMNT'="A",(RCAMT=0&(RCPAYMNT="P"))!(RCAMT&(RCPAYMNT="Z")) Q
  1.  . . ;
  1.  . . ; PRCA*4.5*304 - Check if we include this ERA in report
  1.  . . I RCPAY="A",RCLAIM'="A" D  Q:'OKAY  ; PRCA*4.5*326 If all payers included, check by type
  1.  . . . S OKAY=$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCLAIM)
  1.  . . ;
  1.  . . ; Check Payer Name
  1.  . . I RCPAY'="A" D  Q:'OKAY               ; PRCA*4.5*326 
  1.  . . . S OKAY=$$ISSEL^RCDPEU1(344.4,ERAIEN)
  1.  . . ;
  1.  . . ; If it does not already exist for this ERA, build X-ref of ERA detail lines to the lines in the worklist
  1.  . . I '$D(^TMP("RCDPEAPP2",$J,ERAIEN)) D BUILD(ERAIEN)
  1.  . . ;
  1.  . . ; Scan index for auto posted claim lines within the ERA
  1.  . . S RCRZ=""
  1.  . . F  S RCRZ=$O(^RCY(344.4,"F",APDATE,ERAIEN,RCRZ)) Q:'RCRZ  D
  1.  . . . D SAVE(ERAIEN,RCRZ,RCTYPE,APDATE,RCSORT)     ; Save claim line detail to ^TMP global
  1.  Q
  1.  ;
  1. BUILD(RCSCR) ; Build cross-reference of ERA detail lines to ERA scratch-pad lines
  1.  ; Input:   RCSCR   - Internal IEN of file 344.4/344.49
  1.  N CNT,ERADET,ERALINE,SUB,SUB1
  1.  Q:'$G(RCSCR)                               ; No ERA IEN
  1.  Q:'$D(^RCY(344.49,RCSCR))                  ; No scratch pad entry for ERA
  1.  S SUB=0
  1.  F  S SUB=$O(^RCY(344.49,RCSCR,1,"B",SUB)) Q:SUB=""  D
  1.  . Q:SUB["."                                ; Skip split edit lines
  1.  . S SUB1=$O(^RCY(344.49,RCSCR,1,"B",SUB,"")) ; Get scratchpad ^RCY(344.49,RCSCR,1) node
  1.  . Q:'SUB1
  1.  . ;
  1.  . ; Get pointer back to ERA detail line(s) - This can be a set of comma pieces
  1.  . S ERALINE=$P($G(^RCY(344.49,RCSCR,1,SUB1,0)),U,9)
  1.  . F CNT=1:1:$L(ERALINE,",") D
  1.  . . S ERADET=$P(ERALINE,",",CNT)
  1.  . . I ERADET S ^TMP("RCDPEAPP2",$J,RCSCR,ERADET)=+$G(^RCY(344.49,RCSCR,1,SUB1,0))
  1.  Q
  1.  ;
  1.  ; PRCA*4.5*424 - Subroutine added
  1. PAYMNT() ; Payment Type (Zero/Payment or Both) Selection. EP from RCDPEAPP
  1.  ; Input:   None
  1.  ; Output:  None
  1.  ; Returns: A - All ERAs, P - ERAs with payments, Z - Zero payment ERAs
  1.  N DIR,DTOUT,DUOUT,RCTYPEDF
  1.  K DIR S DIR(0)="SA^A:ALL;P:PAYMENT;Z:ZERO;"
  1.  S DIR("A")="Display (A)ll ERAs, those with (P)ayments or (Z)ero Dollar ERAs?: "
  1.  S DIR("B")="B"
  1.  S DIR("?",1)="Select (A)ALL to see both zero and non-zero amount ERAs."
  1.  S DIR("?",2)="Select (P)AYMENT to only see ERAs with a non-zero amount paid."
  1.  S DIR("?")="Select (Z)ERO to only see ERAs with a zero total amount paid."
  1.  S DIR("B")="A"     ; Default is all ERAs
  1.  W !
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT) Q -1
  1.  Q Y