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

BARRPSRA.m

Go to the documentation of this file. 
  1. BARRPSRA ; IHS/SD/PKD - New Period Summary Report ; 03/28/2011
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,6,7,21,23**;OCT 26, 2005
  1.  ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
  1.  ; IHS/SD/LSL - 02/20/03 - V1.7 Patch 1
  1.  ;      Routine created to replace previous PSR
  1.  ;
  1.  ; IHS/SD/LSL - 08/01/03 - V1.7 Patch 2
  1.  ;     Add Location IEN to Location level of summary data for EISS
  1.  ; MAR 2013 P.OTTIS ADDED NEW VA billing
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EN ; EP
  1.  K BARY,BAR
  1.  D:'$D(BARUSR) INIT^BARUTL           ; Set up basic A/R Variables
  1.  S BARP("RTN")="BARRPSRA"             ; Routine used to gather data
  1.  S BAR("PRIVACY")=1                  ; Privacy act applies (used BARRHD)
  1.  S BAR("LOC")="VISIT"                ; PSR should always be VISIT
  1.  D ASK^BARRASMA                      ; Ask all question (From ASM rtn)
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) D XIT Q
  1.  D DATES                             ; Ask transaction date range
  1.  I +BARSTART<1 D XIT Q               ; Dates answered wrong
  1.  D SETHDR                            ; Build header array
  1.  S BARQ("RC")="COMPUTE^BARRPSRA"      ; Build tmp global with data
  1.  S BARQ("RP")="PRINT^BARRPSRB"       ; Print reports from tmp global
  1.  S BARQ("NS")="BAR"                  ; Namespace for variables
  1.  S BARQ("RX")="POUT^BARRUTL"         ; Clean-up routine
  1.  D ^BARDBQUE                         ; Double queuing
  1.  D PAZ^BARRUTL                       ; Press return to continue
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DATES ;
  1.  ; Ask beginning and ending Transaction Dates.
  1.  W !!," ============ Entry of TRANSACTION DATE Range =============",!
  1.  S BARSTART=$$DATE^BARDUTL(1)
  1.  I BARSTART<1 Q
  1.  S BAREND=$$DATE^BARDUTL(2)
  1.  I BAREND<1 W ! G DATES
  1.  I BAREND<BARSTART D  G DATES
  1.  .W *7
  1.  .W !!,"The END date must not be before the START date.",!
  1.  S BARY("DT",1)=BARSTART
  1.  S BARY("DT",2)=BAREND
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. SETHDR ;
  1.  ; Build header array
  1.  S BAR("OPT")="PSR"
  1.  S BARY("DT")="T"
  1.  S BAR("LVL")=0
  1.  S BAR("HD",0)="Period Summary Report"
  1.  I ",1,2,3,4,"[(","_BARY("STCR")_",") S BAR("HD",0)=BAR("HD",0)_" by "_BARY("STCR","NM")
  1.  I BARY("STCR")=5 D ALLOW^BARRHD,CHK^BARRHD
  1.  I BARY("STCR")=6 D BIL^BARRHD,CHK^BARRHD
  1.  I BARY("STCR")=7 D ITYP^BARRHD,CHK^BARRHD
  1.  I $G(BARY("RTYP"))=2 D
  1.  . S BAR("LVL")=$G(BAR("LVL"))+1
  1.  . S BAR("HD",BAR("LVL"))=""
  1.  . S BAR("TXT")="PAYER"
  1.  . S BAR("CONJ")="Sorted by "
  1.  . D CHK^BARRHD
  1.  I $G(BARY("RTYP"))=3 D
  1.  . S BAR("TXT")="BILL w/in PAYER"
  1.  . S BAR("CONJ")="Sorted by "
  1.  . D CHK^BARRHD
  1.  D DT^BARRHD
  1.  S BAR("LVL")=$G(BAR("LVL"))+1
  1.  S BAR("HD",BAR("LVL"))=""
  1.  S BAR("TXT")="ALL"
  1.  I $D(BARY("LOC")) S BAR("TXT")=$P(^DIC(4,BARY("LOC"),0),U)
  1.  I BAR("LOC")="BILLING" D
  1.  . S BAR("TXT")=BAR("TXT")_" Visit location(s) under "
  1.  . S BAR("TXT")=BAR("TXT")_$P(^DIC(4,DUZ(2),0),U)
  1.  . S BAR("TXT")=BAR("TXT")_" Billing Location"
  1.  E  S BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
  1.  S BAR("CONJ")="at "
  1.  D CHK^BARRHD
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. COMPUTE ; EP
  1.  S BAR("SUBR")="BAR-PSR"
  1.  K ^TMP($J,"BAR-PSR")
  1.  K ^TMP($J,"BAR-PSRT")
  1.  I BAR("LOC")="BILLING" D TRANS^BARRUTL Q
  1.  S BARDUZ2=DUZ(2)
  1.  S DUZ(2)=0
  1.  F  S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2)  D TRANS^BARRUTL
  1.  S DUZ(2)=BARDUZ2
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DATA ; EP
  1.  ; Gather data for transactions found in TRANS^BARRUTL
  1.  ;
  1.  ; BAR("SUB1") = Visit Location
  1.  ; BAR("SUB2") = Clinic / visit type / A/R Account / Discharge Service
  1.  ; BAR("SUB3") = Billing Entity / Allowance Category / insurer Type
  1.  ; BAR("SUB4") = A/R Account
  1.  ; BAR("SUB5") = A/R Bill
  1.  ;
  1.  ; BAR(1) = Billed Amount
  1.  ;            Tran Type Bill New             (49) +
  1.  ;            Tran Type Flat Rate Adjustment (503)
  1.  ;            Tran Type Status Chg           (993)
  1.  ; BAR(2) = Payment
  1.  ;            Tran Type Payment              (40)
  1.  ; BAR(3) = Adjustment
  1.  ;            Adj Cat Copay                  (14) +
  1.  ;            Adj Cat Deductible             (13) +
  1.  ;            Adj Cat Grouper Allowance      (16) +
  1.  ;            Adj Cat Non Payment            (4) +
  1.  ;            Adj Cat Payment Credit         (20) +
  1.  ;            Adj Cat Penalty                (15) +
  1.  ;            Adj Cat Write-off              (3) +
  1.  ;            Tran Status 3P Credit          (108)
  1.  ;            Adj Cat Sent to Collections    (25)  ;HEAT30281 IHS/SD/PKD 1.8*21
  1.  ; BAR(4) = Refund
  1.  ;            Tran Type Refund (if tied to bill)   (39) +
  1.  ;            Adj Cat Refund                 (19)
  1.  ; -------------------------------
  1.  ;
  1.  F I=1:1:4 S BAR(I)=0
  1.  F I=1:1:5 K BAR("SUB"_I)
  1.  S BARP("HIT")=0
  1.  D TRANS^BARRCHK
  1.  Q:'BARP("HIT")
  1.  S BARTR("ADJ CAT")=$P(BARTR(1),U,2)           ; Adjustment Category
  1.  I ",3,4,13,14,15,16,19,20,25"'[(","_BARTR("ADJ CAT")_",")&(",40,49,39,108,503,993,"'[(","_BARTR("T")_",")) Q
  1.  S:(BARTR("T")=49!(BARTR("T")=503)) BAR(1)=BARTR("CR-DB")
  1.  S:BARTR("T")=40 BAR(2)=BARTR("CR-DB")
  1.  ; IHS/SD/PKD bar*1.8*21 Add Sent to Collection to Adjustments HEAT30281
  1.  S:(",3,4,13,14,15,16,20,25,"[(","_BARTR("ADJ CAT")_",")) BAR(3)=BARTR("CR-DB")
  1.  S:BARTR("T")=108 BAR(3)=BARTR("CR-DB")
  1.  S:(BARTR("T")=39!(BARTR("ADJ CAT")=19)) BAR(4)=BARTR("CR-DB")
  1.  ;
  1.  ; -------------------------------
  1.  S BAR("SUB1")=$$GET1^DIQ(9999999.06,BARTR("L"),.01)
  1.  S:BAR("SUB1")="" BAR("SUB1")="No Visit Location"
  1.  I ",1,2,3,4,"[(","_BARY("STCR")_",") D  Q
  1.  . I BARY("STCR")=1 D
  1.  . . S BAR("SUB2")=BARTR("I")
  1.  . . I BAR("SUB2")]"" S BAR("SUB2")=$$GET1^DIQ(90050.02,BAR("SUB2"),.01)
  1.  . . I BAR("SUB2")="" S BAR("SUB2")="No A/R Account"
  1.  . I BARY("STCR")=2 D
  1.  . . S BAR("SUB2")=BAR("C")
  1.  . . I BAR("SUB2")]"",BAR("SUB2")'=99999 S BAR("SUB2")=$$GET1^DIQ(40.7,BAR("SUB2"),.01)
  1.  . . I BAR("SUB2")=""!(BAR("SUB2")=99999) S BAR("SUB2")="No Clinic Type"
  1.  . I BARY("STCR")=3 D
  1.  . . S BAR("SUB2")=BAR("V")
  1.  . . I BAR("SUB2")]"",BAR("SUB2")'=99999 S BAR("SUB2")=$$GET1^DIQ(9002274.8,BAR("SUB2"),.01)
  1.  . . I BAR("SUB2")=""!(BAR("SUB2")=99999) S BAR("SUB2")="No Visit Type"
  1.  . I BARY("STCR")=4 D
  1.  . . S BAR("SUB2")=BAR("DS")
  1.  . . I BAR("SUB2")]"",BAR("SUB2")'=99999 S BAR("SUB2")=$$GET1^DIQ(45.7,BAR("SUB2"),.01)
  1.  . . I BAR("SUB2")=""!(BAR("SUB2")=99999) S BAR("SUB2")="No Discharge Service"
  1.  . D STANDARD
  1.  I BARY("STCR")=5 D
  1.  . S BAR("SUB3")="OTHER"
  1.  . ;
  1.  . I BARTR("ALL")="D" S BAR("SUB3")="MEDICAID"
  1.  . I BARTR("ALL")="K" S BAR("SUB3")="MEDICAID"
  1.  . I BARTR("ALL")="FPL" S BAR("SUB3")="MEDICAID"
  1.  . ;
  1.  . I BARTR("ALL")="R" S BAR("SUB3")="MEDICARE"
  1.  . I BARTR("ALL")="MH" S BAR("SUB3")="MEDICARE"
  1.  . I BARTR("ALL")="MD" S BAR("SUB3")="MEDICARE"
  1.  . I BARTR("ALL")="MC" S BAR("SUB3")="MEDICARE"
  1.  . I BARTR("ALL")="MCC" S BAR("SUB3")="MEDICARE"
  1.  . ;
  1.  . I BARTR("ALL")="H" S BAR("SUB3")="PRIVATE INSURANCE"
  1.  . I BARTR("ALL")="M" S BAR("SUB3")="PRIVATE INSURANCE"
  1.  . I BARTR("ALL")="P" S BAR("SUB3")="PRIVATE INSURANCE"
  1.  . I BARTR("ALL")="F" S BAR("SUB3")="PRIVATE INSURANCE"
  1.  . ;
  1.  . I BARTR("ALL")="V" S BAR("SUB3")="VETERAN ADMINISTRATION"
  1.  . ;
  1.  I BARY("STCR")=6 D
  1.  . I $L(BARTR("BI")) S BAR("SUB3")=$P($T(@BARTR("BI")),";;",2)  ;BAR*1.8*1 IM21585
  1.  . I BAR("SUB3")="" S BAR("SUB3")=BARTR("BI")
  1.  I BARY("STCR")=7 D
  1.  . I $L(BARTR("BI")) S BAR("SUB3")=$P($T(@BARTR("BI")),";;",3)  ;BAR*1.8*1 IM21585
  1.  . I BAR("SUB3")="" S BAR("SUB3")=BARTR("BI")
  1.  S BAR("SUB4")=BARTR("I")
  1.  I BAR("SUB4")]"" S BAR("SUB4")=$$GET1^DIQ(90050.02,BAR("SUB4"),.01)
  1.  I BAR("SUB4")="" S BAR("SUB4")="No A/R Account"
  1.  S BAR("SUB5")=$$GET1^DIQ(90050.01,BAR,.01)
  1.  I $G(BARY("RTYP"))=2 D
  1.  . D DETAIL
  1.  I $G(BARY("RTYP"))=3 D
  1.  . D BILL
  1.  . D DETAIL
  1.  D SUMMARY
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. STANDARD ;
  1.  ; Temp global for SORT CRITERIA Clinic or Visit or A/R Account
  1.  ; or Discharge Service
  1.  ; Detail Lines
  1.  S BARHLD=$G(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2")))
  1.  S $P(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U)=$P(BARHLD,U)-BAR(1)
  1.  S $P(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U,2)=$P(BARHLD,U,2)+BAR(2)
  1.  S $P(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U,3)=$P(BARHLD,U,3)+BAR(3)
  1.  S $P(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U,4)=$P(BARHLD,U,4)-BAR(4)
  1.  ;
  1.  ; Visit Location Totals
  1.  S BARHLD=$G(^TMP($J,"BAR-PSR",BAR("SUB1")))
  1.  S $P(^TMP($J,"BAR-PSR",BAR("SUB1")),U)=$P(BARHLD,U)-BAR(1)
  1.  S $P(^TMP($J,"BAR-PSR",BAR("SUB1")),U,2)=$P(BARHLD,U,2)+BAR(2)
  1.  S $P(^TMP($J,"BAR-PSR",BAR("SUB1")),U,3)=$P(BARHLD,U,3)+BAR(3)
  1.  S $P(^TMP($J,"BAR-PSR",BAR("SUB1")),U,4)=$P(BARHLD,U,4)-BAR(4)
  1.  ;
  1.  ; Report Total
  1.  S BARHLD=$G(^TMP($J,"BAR-PSR"))
  1.  S $P(^TMP($J,"BAR-PSR"),U)=$P(BARHLD,U)-BAR(1)
  1.  S $P(^TMP($J,"BAR-PSR"),U,2)=$P(BARHLD,U,2)+BAR(2)
  1.  S $P(^TMP($J,"BAR-PSR"),U,3)=$P(BARHLD,U,3)+BAR(3)
  1.  S $P(^TMP($J,"BAR-PSR"),U,4)=$P(BARHLD,U,4)-BAR(4)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SUMMARY ;
  1.  ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
  1.  ; and Report Type Summarize.
  1.  ;
  1.  ; Detail Lines
  1.   S BARHLD=$G(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")))
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U)=$P(BARHLD,U)-BAR(1)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U,2)=$P(BARHLD,U,2)+BAR(2)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U,3)=$P(BARHLD,U,3)+BAR(3)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U,4)=$P(BARHLD,U,4)-BAR(4)
  1.  ;
  1.  ; Visit Location Totals
  1.  S BARHLD=$G(^TMP($J,"BAR-PSRT",BAR("SUB1")))
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1")),U)=$P(BARHLD,U)-BAR(1)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1")),U,2)=$P(BARHLD,U,2)+BAR(2)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1")),U,3)=$P(BARHLD,U,3)+BAR(3)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1")),U,4)=$P(BARHLD,U,4)-BAR(4)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1")),U,5)=BARTR("L")
  1.  ;
  1.  ; Report Total
  1.  S BARHLD=$G(^TMP($J,"BAR-PSRT"))
  1.  S $P(^TMP($J,"BAR-PSRT"),U)=$P(BARHLD,U)-BAR(1)
  1.  S $P(^TMP($J,"BAR-PSRT"),U,2)=$P(BARHLD,U,2)+BAR(2)
  1.  S $P(^TMP($J,"BAR-PSRT"),U,3)=$P(BARHLD,U,3)+BAR(3)
  1.  S $P(^TMP($J,"BAR-PSRT"),U,4)=$P(BARHLD,U,4)-BAR(4)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DETAIL ;
  1.  ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
  1.  ; and Report Type Summarize by payor w/in.
  1.  ;
  1.  ; Detail Lines
  1.  S BARHLD=$G(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U)=$P(BARHLD,U)-BAR(1)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,2)=$P(BARHLD,U,2)+BAR(2)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,3)=$P(BARHLD,U,3)+BAR(3)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,4)=$P(BARHLD,U,4)-BAR(4)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. BILL ;
  1.  ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
  1.  ; and Report Type Summarize by BILL w/in payor w/in.
  1.  ;
  1.  ; Detail Lines
  1.  S BARHLD=$G(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U)=$P(BARHLD,U)-BAR(1)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,2)=$P(BARHLD,U,2)+BAR(2)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,3)=$P(BARHLD,U,3)+BAR(3)
  1.  S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,4)=$P(BARHLD,U,4)-BAR(4)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. XIT ;
  1.  D ^BARVKL0
  1.  Q
  1.  ; ********************************************************************
  1.  ;THIS TABLE REPLICATES ^AUTTINTY INSURER TYPE (21 ENTRIES) P.OTT 4/12/2013
  1.  ;AND MAPS INSURER TYPE CODE TO CATEGORY (IE: W --> OTHER)
  1. H ;;PRIVATE INSURANCE;;HMO
  1. M ;;PRIVATE INSURANCE;;MEDICARE SUPPL.
  1. D ;;MEDICAID;;MEDICAID FI
  1. R ;;MEDICARE;;MEDICARE FI
  1. P ;;PRIVATE INSURANCE;;PRIVATE INSURANCE
  1. W ;;OTHER;;WORKMEN'S COMP
  1. C ;;OTHER;;CHAMPUS
  1. N ;;OTHER;;NON-BENEFICIARY (NON-INDIAN)
  1. I ;;OTHER;;INDIAN PATIENT
  1. K ;;MEDICAID;;CHIP (KIDSCARE)
  1. T ;;OTHER;;THIRD PARTY LIABILITY 
  1. G ;;OTHER;;GUARANTOR
  1. MD ;;MEDICARE;;MCR PART D
  1. MH ;;MEDICARE;;MEDICARE HMO
  1. MMC ;;MEDICARE;;MCR MANAGED CARE
  1. TSI ;;OTHER;;TRIBAL SELF INSURED
  1. SEP ;;OTHER;;STATE EXCHANGE PLAN
  1. FPL ;;MEDICAID;;FPL 133 PERCENT
  1. MC ;;MEDICARE;;MCR PART C
  1. F ;;PRIVATE INSURANCE;;FRATERNAL ORGANIZATION
  1. V ;;VETERAN;;VETERANS MEDICAL BENEFITS
  1.   ;;***END OF TABLE**