BARRPSRA ; IHS/SD/PKD - New Period Summary Report ; 03/28/2011
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,6,7,21,23**;OCT 26, 2005
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
; IHS/SD/LSL - 02/20/03 - V1.7 Patch 1
; Routine created to replace previous PSR
;
; IHS/SD/LSL - 08/01/03 - V1.7 Patch 2
; Add Location IEN to Location level of summary data for EISS
; MAR 2013 P.OTTIS ADDED NEW VA billing
Q
; *********************************************************************
;
EN ; EP
K BARY,BAR
D:'$D(BARUSR) INIT^BARUTL ; Set up basic A/R Variables
S BARP("RTN")="BARRPSRA" ; Routine used to gather data
S BAR("PRIVACY")=1 ; Privacy act applies (used BARRHD)
S BAR("LOC")="VISIT" ; PSR should always be VISIT
D ASK^BARRASMA ; Ask all question (From ASM rtn)
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) D XIT Q
D DATES ; Ask transaction date range
I +BARSTART<1 D XIT Q ; Dates answered wrong
D SETHDR ; Build header array
S BARQ("RC")="COMPUTE^BARRPSRA" ; Build tmp global with data
S BARQ("RP")="PRINT^BARRPSRB" ; Print reports from tmp global
S BARQ("NS")="BAR" ; Namespace for variables
S BARQ("RX")="POUT^BARRUTL" ; Clean-up routine
D ^BARDBQUE ; Double queuing
D PAZ^BARRUTL ; Press return to continue
Q
; *********************************************************************
;
DATES ;
; Ask beginning and ending Transaction Dates.
W !!," ============ Entry of TRANSACTION DATE Range =============",!
S BARSTART=$$DATE^BARDUTL(1)
I BARSTART<1 Q
S BAREND=$$DATE^BARDUTL(2)
I BAREND<1 W ! G DATES
I BAREND<BARSTART D G DATES
.W *7
.W !!,"The END date must not be before the START date.",!
S BARY("DT",1)=BARSTART
S BARY("DT",2)=BAREND
Q
; ********************************************************************
;
SETHDR ;
; Build header array
S BAR("OPT")="PSR"
S BARY("DT")="T"
S BAR("LVL")=0
S BAR("HD",0)="Period Summary Report"
I ",1,2,3,4,"[(","_BARY("STCR")_",") S BAR("HD",0)=BAR("HD",0)_" by "_BARY("STCR","NM")
I BARY("STCR")=5 D ALLOW^BARRHD,CHK^BARRHD
I BARY("STCR")=6 D BIL^BARRHD,CHK^BARRHD
I BARY("STCR")=7 D ITYP^BARRHD,CHK^BARRHD
I $G(BARY("RTYP"))=2 D
. S BAR("LVL")=$G(BAR("LVL"))+1
. S BAR("HD",BAR("LVL"))=""
. S BAR("TXT")="PAYER"
. S BAR("CONJ")="Sorted by "
. D CHK^BARRHD
I $G(BARY("RTYP"))=3 D
. S BAR("TXT")="BILL w/in PAYER"
. S BAR("CONJ")="Sorted by "
. D CHK^BARRHD
D DT^BARRHD
S BAR("LVL")=$G(BAR("LVL"))+1
S BAR("HD",BAR("LVL"))=""
S BAR("TXT")="ALL"
I $D(BARY("LOC")) S BAR("TXT")=$P(^DIC(4,BARY("LOC"),0),U)
I BAR("LOC")="BILLING" D
. S BAR("TXT")=BAR("TXT")_" Visit location(s) under "
. S BAR("TXT")=BAR("TXT")_$P(^DIC(4,DUZ(2),0),U)
. S BAR("TXT")=BAR("TXT")_" Billing Location"
E S BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
S BAR("CONJ")="at "
D CHK^BARRHD
Q
; *********************************************************************
;
COMPUTE ; EP
S BAR("SUBR")="BAR-PSR"
K ^TMP($J,"BAR-PSR")
K ^TMP($J,"BAR-PSRT")
I BAR("LOC")="BILLING" D TRANS^BARRUTL Q
S BARDUZ2=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2) D TRANS^BARRUTL
S DUZ(2)=BARDUZ2
Q
; *********************************************************************
;
DATA ; EP
; Gather data for transactions found in TRANS^BARRUTL
;
; BAR("SUB1") = Visit Location
; BAR("SUB2") = Clinic / visit type / A/R Account / Discharge Service
; BAR("SUB3") = Billing Entity / Allowance Category / insurer Type
; BAR("SUB4") = A/R Account
; BAR("SUB5") = A/R Bill
;
; BAR(1) = Billed Amount
; Tran Type Bill New (49) +
; Tran Type Flat Rate Adjustment (503)
; Tran Type Status Chg (993)
; BAR(2) = Payment
; Tran Type Payment (40)
; BAR(3) = Adjustment
; Adj Cat Copay (14) +
; Adj Cat Deductible (13) +
; Adj Cat Grouper Allowance (16) +
; Adj Cat Non Payment (4) +
; Adj Cat Payment Credit (20) +
; Adj Cat Penalty (15) +
; Adj Cat Write-off (3) +
; Tran Status 3P Credit (108)
; Adj Cat Sent to Collections (25) ;HEAT30281 IHS/SD/PKD 1.8*21
; BAR(4) = Refund
; Tran Type Refund (if tied to bill) (39) +
; Adj Cat Refund (19)
; -------------------------------
;
F I=1:1:4 S BAR(I)=0
F I=1:1:5 K BAR("SUB"_I)
S BARP("HIT")=0
D TRANS^BARRCHK
Q:'BARP("HIT")
S BARTR("ADJ CAT")=$P(BARTR(1),U,2) ; Adjustment Category
I ",3,4,13,14,15,16,19,20,25"'[(","_BARTR("ADJ CAT")_",")&(",40,49,39,108,503,993,"'[(","_BARTR("T")_",")) Q
S:(BARTR("T")=49!(BARTR("T")=503)) BAR(1)=BARTR("CR-DB")
S:BARTR("T")=40 BAR(2)=BARTR("CR-DB")
; IHS/SD/PKD bar*1.8*21 Add Sent to Collection to Adjustments HEAT30281
S:(",3,4,13,14,15,16,20,25,"[(","_BARTR("ADJ CAT")_",")) BAR(3)=BARTR("CR-DB")
S:BARTR("T")=108 BAR(3)=BARTR("CR-DB")
S:(BARTR("T")=39!(BARTR("ADJ CAT")=19)) BAR(4)=BARTR("CR-DB")
;
; -------------------------------
S BAR("SUB1")=$$GET1^DIQ(9999999.06,BARTR("L"),.01)
S:BAR("SUB1")="" BAR("SUB1")="No Visit Location"
I ",1,2,3,4,"[(","_BARY("STCR")_",") D Q
. I BARY("STCR")=1 D
. . S BAR("SUB2")=BARTR("I")
. . I BAR("SUB2")]"" S BAR("SUB2")=$$GET1^DIQ(90050.02,BAR("SUB2"),.01)
. . I BAR("SUB2")="" S BAR("SUB2")="No A/R Account"
. I BARY("STCR")=2 D
. . S BAR("SUB2")=BAR("C")
. . I BAR("SUB2")]"",BAR("SUB2")'=99999 S BAR("SUB2")=$$GET1^DIQ(40.7,BAR("SUB2"),.01)
. . I BAR("SUB2")=""!(BAR("SUB2")=99999) S BAR("SUB2")="No Clinic Type"
. I BARY("STCR")=3 D
. . S BAR("SUB2")=BAR("V")
. . I BAR("SUB2")]"",BAR("SUB2")'=99999 S BAR("SUB2")=$$GET1^DIQ(9002274.8,BAR("SUB2"),.01)
. . I BAR("SUB2")=""!(BAR("SUB2")=99999) S BAR("SUB2")="No Visit Type"
. I BARY("STCR")=4 D
. . S BAR("SUB2")=BAR("DS")
. . I BAR("SUB2")]"",BAR("SUB2")'=99999 S BAR("SUB2")=$$GET1^DIQ(45.7,BAR("SUB2"),.01)
. . I BAR("SUB2")=""!(BAR("SUB2")=99999) S BAR("SUB2")="No Discharge Service"
. D STANDARD
I BARY("STCR")=5 D
. S BAR("SUB3")="OTHER"
. ;
. I BARTR("ALL")="D" S BAR("SUB3")="MEDICAID"
. I BARTR("ALL")="K" S BAR("SUB3")="MEDICAID"
. I BARTR("ALL")="FPL" S BAR("SUB3")="MEDICAID"
. ;
. I BARTR("ALL")="R" S BAR("SUB3")="MEDICARE"
. I BARTR("ALL")="MH" S BAR("SUB3")="MEDICARE"
. I BARTR("ALL")="MD" S BAR("SUB3")="MEDICARE"
. I BARTR("ALL")="MC" S BAR("SUB3")="MEDICARE"
. I BARTR("ALL")="MCC" S BAR("SUB3")="MEDICARE"
. ;
. I BARTR("ALL")="H" S BAR("SUB3")="PRIVATE INSURANCE"
. I BARTR("ALL")="M" S BAR("SUB3")="PRIVATE INSURANCE"
. I BARTR("ALL")="P" S BAR("SUB3")="PRIVATE INSURANCE"
. I BARTR("ALL")="F" S BAR("SUB3")="PRIVATE INSURANCE"
. ;
. I BARTR("ALL")="V" S BAR("SUB3")="VETERAN ADMINISTRATION"
. ;
I BARY("STCR")=6 D
. I $L(BARTR("BI")) S BAR("SUB3")=$P($T(@BARTR("BI")),";;",2) ;BAR*1.8*1 IM21585
. I BAR("SUB3")="" S BAR("SUB3")=BARTR("BI")
I BARY("STCR")=7 D
. I $L(BARTR("BI")) S BAR("SUB3")=$P($T(@BARTR("BI")),";;",3) ;BAR*1.8*1 IM21585
. I BAR("SUB3")="" S BAR("SUB3")=BARTR("BI")
S BAR("SUB4")=BARTR("I")
I BAR("SUB4")]"" S BAR("SUB4")=$$GET1^DIQ(90050.02,BAR("SUB4"),.01)
I BAR("SUB4")="" S BAR("SUB4")="No A/R Account"
S BAR("SUB5")=$$GET1^DIQ(90050.01,BAR,.01)
I $G(BARY("RTYP"))=2 D
. D DETAIL
I $G(BARY("RTYP"))=3 D
. D BILL
. D DETAIL
D SUMMARY
Q
; *********************************************************************
;
STANDARD ;
; Temp global for SORT CRITERIA Clinic or Visit or A/R Account
; or Discharge Service
; Detail Lines
S BARHLD=$G(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2")))
S $P(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U)=$P(BARHLD,U)-BAR(1)
S $P(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U,4)=$P(BARHLD,U,4)-BAR(4)
;
; Visit Location Totals
S BARHLD=$G(^TMP($J,"BAR-PSR",BAR("SUB1")))
S $P(^TMP($J,"BAR-PSR",BAR("SUB1")),U)=$P(BARHLD,U)-BAR(1)
S $P(^TMP($J,"BAR-PSR",BAR("SUB1")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-PSR",BAR("SUB1")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-PSR",BAR("SUB1")),U,4)=$P(BARHLD,U,4)-BAR(4)
;
; Report Total
S BARHLD=$G(^TMP($J,"BAR-PSR"))
S $P(^TMP($J,"BAR-PSR"),U)=$P(BARHLD,U)-BAR(1)
S $P(^TMP($J,"BAR-PSR"),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-PSR"),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-PSR"),U,4)=$P(BARHLD,U,4)-BAR(4)
Q
; *********************************************************************
;
SUMMARY ;
; Temp global for SORT CRITERIA Allowance Category or Billing Entity
; and Report Type Summarize.
;
; Detail Lines
S BARHLD=$G(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")))
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U)=$P(BARHLD,U)-BAR(1)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U,4)=$P(BARHLD,U,4)-BAR(4)
;
; Visit Location Totals
S BARHLD=$G(^TMP($J,"BAR-PSRT",BAR("SUB1")))
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1")),U)=$P(BARHLD,U)-BAR(1)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1")),U,4)=$P(BARHLD,U,4)-BAR(4)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1")),U,5)=BARTR("L")
;
; Report Total
S BARHLD=$G(^TMP($J,"BAR-PSRT"))
S $P(^TMP($J,"BAR-PSRT"),U)=$P(BARHLD,U)-BAR(1)
S $P(^TMP($J,"BAR-PSRT"),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-PSRT"),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-PSRT"),U,4)=$P(BARHLD,U,4)-BAR(4)
Q
; *********************************************************************
;
DETAIL ;
; Temp global for SORT CRITERIA Allowance Category or Billing Entity
; and Report Type Summarize by payor w/in.
;
; Detail Lines
S BARHLD=$G(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U)=$P(BARHLD,U)-BAR(1)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,4)=$P(BARHLD,U,4)-BAR(4)
Q
; *********************************************************************
;
BILL ;
; Temp global for SORT CRITERIA Allowance Category or Billing Entity
; and Report Type Summarize by BILL w/in payor w/in.
;
; Detail Lines
S BARHLD=$G(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U)=$P(BARHLD,U)-BAR(1)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,4)=$P(BARHLD,U,4)-BAR(4)
Q
; *********************************************************************
;
XIT ;
D ^BARVKL0
Q
; ********************************************************************
;THIS TABLE REPLICATES ^AUTTINTY INSURER TYPE (21 ENTRIES) P.OTT 4/12/2013
;AND MAPS INSURER TYPE CODE TO CATEGORY (IE: W --> OTHER)
H ;;PRIVATE INSURANCE;;HMO
M ;;PRIVATE INSURANCE;;MEDICARE SUPPL.
D ;;MEDICAID;;MEDICAID FI
R ;;MEDICARE;;MEDICARE FI
P ;;PRIVATE INSURANCE;;PRIVATE INSURANCE
W ;;OTHER;;WORKMEN'S COMP
C ;;OTHER;;CHAMPUS
N ;;OTHER;;NON-BENEFICIARY (NON-INDIAN)
I ;;OTHER;;INDIAN PATIENT
K ;;MEDICAID;;CHIP (KIDSCARE)
T ;;OTHER;;THIRD PARTY LIABILITY
G ;;OTHER;;GUARANTOR
MD ;;MEDICARE;;MCR PART D
MH ;;MEDICARE;;MEDICARE HMO
MMC ;;MEDICARE;;MCR MANAGED CARE
TSI ;;OTHER;;TRIBAL SELF INSURED
SEP ;;OTHER;;STATE EXCHANGE PLAN
FPL ;;MEDICAID;;FPL 133 PERCENT
MC ;;MEDICARE;;MCR PART C
F ;;PRIVATE INSURANCE;;FRATERNAL ORGANIZATION
V ;;VETERAN;;VETERANS MEDICAL BENEFITS
;;***END OF TABLE**
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
+2 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+3 ; IHS/SD/LSL - 02/20/03 - V1.7 Patch 1
+4 ; Routine created to replace previous PSR
+5 ;
+6 ; IHS/SD/LSL - 08/01/03 - V1.7 Patch 2
+7 ; Add Location IEN to Location level of summary data for EISS
+8 ; MAR 2013 P.OTTIS ADDED NEW VA billing
+9 QUIT
+10 ; *********************************************************************
+11 ;
EN ; EP
+1 KILL BARY,BAR
+2 ; Set up basic A/R Variables
IF '$DATA(BARUSR)
DO INIT^BARUTL
+3 ; Routine used to gather data
SET BARP("RTN")="BARRPSRA"
+4 ; Privacy act applies (used BARRHD)
SET BAR("PRIVACY")=1
+5 ; PSR should always be VISIT
SET BAR("LOC")="VISIT"
+6 ; Ask all question (From ASM rtn)
DO ASK^BARRASMA
+7 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
DO XIT
QUIT
+8 ; Ask transaction date range
DO DATES
+9 ; Dates answered wrong
IF +BARSTART<1
DO XIT
QUIT
+10 ; Build header array
DO SETHDR
+11 ; Build tmp global with data
SET BARQ("RC")="COMPUTE^BARRPSRA"
+12 ; Print reports from tmp global
SET BARQ("RP")="PRINT^BARRPSRB"
+13 ; Namespace for variables
SET BARQ("NS")="BAR"
+14 ; Clean-up routine
SET BARQ("RX")="POUT^BARRUTL"
+15 ; Double queuing
DO ^BARDBQUE
+16 ; Press return to continue
DO PAZ^BARRUTL
+17 QUIT
+18 ; *********************************************************************
+19 ;
DATES ;
+1 ; Ask beginning and ending Transaction Dates.
+2 WRITE !!," ============ Entry of TRANSACTION DATE Range =============",!
+3 SET BARSTART=$$DATE^BARDUTL(1)
+4 IF BARSTART<1
QUIT
+5 SET BAREND=$$DATE^BARDUTL(2)
+6 IF BAREND<1
WRITE !
GOTO DATES
+7 IF BAREND<BARSTART
Begin DoDot:1
+8 WRITE *7
+9 WRITE !!,"The END date must not be before the START date.",!
End DoDot:1
GOTO DATES
+10 SET BARY("DT",1)=BARSTART
+11 SET BARY("DT",2)=BAREND
+12 QUIT
+13 ; ********************************************************************
+14 ;
SETHDR ;
+1 ; Build header array
+2 SET BAR("OPT")="PSR"
+3 SET BARY("DT")="T"
+4 SET BAR("LVL")=0
+5 SET BAR("HD",0)="Period Summary Report"
+6 IF ",1,2,3,4,"[(","_BARY("STCR")_",")
SET BAR("HD",0)=BAR("HD",0)_" by "_BARY("STCR","NM")
+7 IF BARY("STCR")=5
DO ALLOW^BARRHD
DO CHK^BARRHD
+8 IF BARY("STCR")=6
DO BIL^BARRHD
DO CHK^BARRHD
+9 IF BARY("STCR")=7
DO ITYP^BARRHD
DO CHK^BARRHD
+10 IF $GET(BARY("RTYP"))=2
Begin DoDot:1
+11 SET BAR("LVL")=$GET(BAR("LVL"))+1
+12 SET BAR("HD",BAR("LVL"))=""
+13 SET BAR("TXT")="PAYER"
+14 SET BAR("CONJ")="Sorted by "
+15 DO CHK^BARRHD
End DoDot:1
+16 IF $GET(BARY("RTYP"))=3
Begin DoDot:1
+17 SET BAR("TXT")="BILL w/in PAYER"
+18 SET BAR("CONJ")="Sorted by "
+19 DO CHK^BARRHD
End DoDot:1
+20 DO DT^BARRHD
+21 SET BAR("LVL")=$GET(BAR("LVL"))+1
+22 SET BAR("HD",BAR("LVL"))=""
+23 SET BAR("TXT")="ALL"
+24 IF $DATA(BARY("LOC"))
SET BAR("TXT")=$PIECE(^DIC(4,BARY("LOC"),0),U)
+25 IF BAR("LOC")="BILLING"
Begin DoDot:1
+26 SET BAR("TXT")=BAR("TXT")_" Visit location(s) under "
+27 SET BAR("TXT")=BAR("TXT")_$PIECE(^DIC(4,DUZ(2),0),U)
+28 SET BAR("TXT")=BAR("TXT")_" Billing Location"
End DoDot:1
+29 IF '$TEST
SET BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
+30 SET BAR("CONJ")="at "
+31 DO CHK^BARRHD
+32 QUIT
+33 ; *********************************************************************
+34 ;
COMPUTE ; EP
+1 SET BAR("SUBR")="BAR-PSR"
+2 KILL ^TMP($JOB,"BAR-PSR")
+3 KILL ^TMP($JOB,"BAR-PSRT")
+4 IF BAR("LOC")="BILLING"
DO TRANS^BARRUTL
QUIT
+5 SET BARDUZ2=DUZ(2)
+6 SET DUZ(2)=0
+7 FOR
SET DUZ(2)=$ORDER(^BARBL(DUZ(2)))
IF 'DUZ(2)
QUIT
DO TRANS^BARRUTL
+8 SET DUZ(2)=BARDUZ2
+9 QUIT
+10 ; *********************************************************************
+11 ;
DATA ; EP
+1 ; Gather data for transactions found in TRANS^BARRUTL
+2 ;
+3 ; BAR("SUB1") = Visit Location
+4 ; BAR("SUB2") = Clinic / visit type / A/R Account / Discharge Service
+5 ; BAR("SUB3") = Billing Entity / Allowance Category / insurer Type
+6 ; BAR("SUB4") = A/R Account
+7 ; BAR("SUB5") = A/R Bill
+8 ;
+9 ; BAR(1) = Billed Amount
+10 ; Tran Type Bill New (49) +
+11 ; Tran Type Flat Rate Adjustment (503)
+12 ; Tran Type Status Chg (993)
+13 ; BAR(2) = Payment
+14 ; Tran Type Payment (40)
+15 ; BAR(3) = Adjustment
+16 ; Adj Cat Copay (14) +
+17 ; Adj Cat Deductible (13) +
+18 ; Adj Cat Grouper Allowance (16) +
+19 ; Adj Cat Non Payment (4) +
+20 ; Adj Cat Payment Credit (20) +
+21 ; Adj Cat Penalty (15) +
+22 ; Adj Cat Write-off (3) +
+23 ; Tran Status 3P Credit (108)
+24 ; Adj Cat Sent to Collections (25) ;HEAT30281 IHS/SD/PKD 1.8*21
+25 ; BAR(4) = Refund
+26 ; Tran Type Refund (if tied to bill) (39) +
+27 ; Adj Cat Refund (19)
+28 ; -------------------------------
+29 ;
+30 FOR I=1:1:4
SET BAR(I)=0
+31 FOR I=1:1:5
KILL BAR("SUB"_I)
+32 SET BARP("HIT")=0
+33 DO TRANS^BARRCHK
+34 IF 'BARP("HIT")
QUIT
+35 ; Adjustment Category
SET BARTR("ADJ CAT")=$PIECE(BARTR(1),U,2)
+36 IF ",3,4,13,14,15,16,19,20,25"'[(","_BARTR("ADJ CAT")_",")&(",40,49,39,108,503,993,"'[(","_BARTR("T")_","))
QUIT
+37 IF (BARTR("T")=49!(BARTR("T")=503))
SET BAR(1)=BARTR("CR-DB")
+38 IF BARTR("T")=40
SET BAR(2)=BARTR("CR-DB")
+39 ; IHS/SD/PKD bar*1.8*21 Add Sent to Collection to Adjustments HEAT30281
+40 IF (",3,4,13,14,15,16,20,25,"[(","_BARTR("ADJ CAT")_","))
SET BAR(3)=BARTR("CR-DB")
+41 IF BARTR("T")=108
SET BAR(3)=BARTR("CR-DB")
+42 IF (BARTR("T")=39!(BARTR("ADJ CAT")=19))
SET BAR(4)=BARTR("CR-DB")
+43 ;
+44 ; -------------------------------
+45 SET BAR("SUB1")=$$GET1^DIQ(9999999.06,BARTR("L"),.01)
+46 IF BAR("SUB1")=""
SET BAR("SUB1")="No Visit Location"
+47 IF ",1,2,3,4,"[(","_BARY("STCR")_",")
Begin DoDot:1
+48 IF BARY("STCR")=1
Begin DoDot:2
+49 SET BAR("SUB2")=BARTR("I")
+50 IF BAR("SUB2")]""
SET BAR("SUB2")=$$GET1^DIQ(90050.02,BAR("SUB2"),.01)
+51 IF BAR("SUB2")=""
SET BAR("SUB2")="No A/R Account"
End DoDot:2
+52 IF BARY("STCR")=2
Begin DoDot:2
+53 SET BAR("SUB2")=BAR("C")
+54 IF BAR("SUB2")]""
IF BAR("SUB2")'=99999
SET BAR("SUB2")=$$GET1^DIQ(40.7,BAR("SUB2"),.01)
+55 IF BAR("SUB2")=""!(BAR("SUB2")=99999)
SET BAR("SUB2")="No Clinic Type"
End DoDot:2
+56 IF BARY("STCR")=3
Begin DoDot:2
+57 SET BAR("SUB2")=BAR("V")
+58 IF BAR("SUB2")]""
IF BAR("SUB2")'=99999
SET BAR("SUB2")=$$GET1^DIQ(9002274.8,BAR("SUB2"),.01)
+59 IF BAR("SUB2")=""!(BAR("SUB2")=99999)
SET BAR("SUB2")="No Visit Type"
End DoDot:2
+60 IF BARY("STCR")=4
Begin DoDot:2
+61 SET BAR("SUB2")=BAR("DS")
+62 IF BAR("SUB2")]""
IF BAR("SUB2")'=99999
SET BAR("SUB2")=$$GET1^DIQ(45.7,BAR("SUB2"),.01)
+63 IF BAR("SUB2")=""!(BAR("SUB2")=99999)
SET BAR("SUB2")="No Discharge Service"
End DoDot:2
+64 DO STANDARD
End DoDot:1
QUIT
+65 IF BARY("STCR")=5
Begin DoDot:1
+66 SET BAR("SUB3")="OTHER"
+67 ;
+68 IF BARTR("ALL")="D"
SET BAR("SUB3")="MEDICAID"
+69 IF BARTR("ALL")="K"
SET BAR("SUB3")="MEDICAID"
+70 IF BARTR("ALL")="FPL"
SET BAR("SUB3")="MEDICAID"
+71 ;
+72 IF BARTR("ALL")="R"
SET BAR("SUB3")="MEDICARE"
+73 IF BARTR("ALL")="MH"
SET BAR("SUB3")="MEDICARE"
+74 IF BARTR("ALL")="MD"
SET BAR("SUB3")="MEDICARE"
+75 IF BARTR("ALL")="MC"
SET BAR("SUB3")="MEDICARE"
+76 IF BARTR("ALL")="MCC"
SET BAR("SUB3")="MEDICARE"
+77 ;
+78 IF BARTR("ALL")="H"
SET BAR("SUB3")="PRIVATE INSURANCE"
+79 IF BARTR("ALL")="M"
SET BAR("SUB3")="PRIVATE INSURANCE"
+80 IF BARTR("ALL")="P"
SET BAR("SUB3")="PRIVATE INSURANCE"
+81 IF BARTR("ALL")="F"
SET BAR("SUB3")="PRIVATE INSURANCE"
+82 ;
+83 IF BARTR("ALL")="V"
SET BAR("SUB3")="VETERAN ADMINISTRATION"
+84 ;
End DoDot:1
+85 IF BARY("STCR")=6
Begin DoDot:1
+86 ;BAR*1.8*1 IM21585
IF $LENGTH(BARTR("BI"))
SET BAR("SUB3")=$PIECE($TEXT(@BARTR("BI")),";;",2)
+87 IF BAR("SUB3")=""
SET BAR("SUB3")=BARTR("BI")
End DoDot:1
+88 IF BARY("STCR")=7
Begin DoDot:1
+89 ;BAR*1.8*1 IM21585
IF $LENGTH(BARTR("BI"))
SET BAR("SUB3")=$PIECE($TEXT(@BARTR("BI")),";;",3)
+90 IF BAR("SUB3")=""
SET BAR("SUB3")=BARTR("BI")
End DoDot:1
+91 SET BAR("SUB4")=BARTR("I")
+92 IF BAR("SUB4")]""
SET BAR("SUB4")=$$GET1^DIQ(90050.02,BAR("SUB4"),.01)
+93 IF BAR("SUB4")=""
SET BAR("SUB4")="No A/R Account"
+94 SET BAR("SUB5")=$$GET1^DIQ(90050.01,BAR,.01)
+95 IF $GET(BARY("RTYP"))=2
Begin DoDot:1
+96 DO DETAIL
End DoDot:1
+97 IF $GET(BARY("RTYP"))=3
Begin DoDot:1
+98 DO BILL
+99 DO DETAIL
End DoDot:1
+100 DO SUMMARY
+101 QUIT
+102 ; *********************************************************************
+103 ;
STANDARD ;
+1 ; Temp global for SORT CRITERIA Clinic or Visit or A/R Account
+2 ; or Discharge Service
+3 ; Detail Lines
+4 SET BARHLD=$GET(^TMP($JOB,"BAR-PSR",BAR("SUB1"),BAR("SUB2")))
+5 SET $PIECE(^TMP($JOB,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U)=$PIECE(BARHLD,U)-BAR(1)
+6 SET $PIECE(^TMP($JOB,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+7 SET $PIECE(^TMP($JOB,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+8 SET $PIECE(^TMP($JOB,"BAR-PSR",BAR("SUB1"),BAR("SUB2")),U,4)=$PIECE(BARHLD,U,4)-BAR(4)
+9 ;
+10 ; Visit Location Totals
+11 SET BARHLD=$GET(^TMP($JOB,"BAR-PSR",BAR("SUB1")))
+12 SET $PIECE(^TMP($JOB,"BAR-PSR",BAR("SUB1")),U)=$PIECE(BARHLD,U)-BAR(1)
+13 SET $PIECE(^TMP($JOB,"BAR-PSR",BAR("SUB1")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+14 SET $PIECE(^TMP($JOB,"BAR-PSR",BAR("SUB1")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+15 SET $PIECE(^TMP($JOB,"BAR-PSR",BAR("SUB1")),U,4)=$PIECE(BARHLD,U,4)-BAR(4)
+16 ;
+17 ; Report Total
+18 SET BARHLD=$GET(^TMP($JOB,"BAR-PSR"))
+19 SET $PIECE(^TMP($JOB,"BAR-PSR"),U)=$PIECE(BARHLD,U)-BAR(1)
+20 SET $PIECE(^TMP($JOB,"BAR-PSR"),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+21 SET $PIECE(^TMP($JOB,"BAR-PSR"),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+22 SET $PIECE(^TMP($JOB,"BAR-PSR"),U,4)=$PIECE(BARHLD,U,4)-BAR(4)
+23 QUIT
+24 ; *********************************************************************
+25 ;
SUMMARY ;
+1 ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
+2 ; and Report Type Summarize.
+3 ;
+4 ; Detail Lines
+5 SET BARHLD=$GET(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")))
+6 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U)=$PIECE(BARHLD,U)-BAR(1)
+7 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+8 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+9 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")),U,4)=$PIECE(BARHLD,U,4)-BAR(4)
+10 ;
+11 ; Visit Location Totals
+12 SET BARHLD=$GET(^TMP($JOB,"BAR-PSRT",BAR("SUB1")))
+13 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1")),U)=$PIECE(BARHLD,U)-BAR(1)
+14 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+15 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+16 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1")),U,4)=$PIECE(BARHLD,U,4)-BAR(4)
+17 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1")),U,5)=BARTR("L")
+18 ;
+19 ; Report Total
+20 SET BARHLD=$GET(^TMP($JOB,"BAR-PSRT"))
+21 SET $PIECE(^TMP($JOB,"BAR-PSRT"),U)=$PIECE(BARHLD,U)-BAR(1)
+22 SET $PIECE(^TMP($JOB,"BAR-PSRT"),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+23 SET $PIECE(^TMP($JOB,"BAR-PSRT"),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+24 SET $PIECE(^TMP($JOB,"BAR-PSRT"),U,4)=$PIECE(BARHLD,U,4)-BAR(4)
+25 QUIT
+26 ; *********************************************************************
+27 ;
DETAIL ;
+1 ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
+2 ; and Report Type Summarize by payor w/in.
+3 ;
+4 ; Detail Lines
+5 SET BARHLD=$GET(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))
+6 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U)=$PIECE(BARHLD,U)-BAR(1)
+7 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+8 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+9 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,4)=$PIECE(BARHLD,U,4)-BAR(4)
+10 QUIT
+11 ; *********************************************************************
+12 ;
BILL ;
+1 ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
+2 ; and Report Type Summarize by BILL w/in payor w/in.
+3 ;
+4 ; Detail Lines
+5 SET BARHLD=$GET(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
+6 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U)=$PIECE(BARHLD,U)-BAR(1)
+7 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+8 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+9 SET $PIECE(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,4)=$PIECE(BARHLD,U,4)-BAR(4)
+10 QUIT
+11 ; *********************************************************************
+12 ;
XIT ;
+1 DO ^BARVKL0
+2 QUIT
+3 ; ********************************************************************
+4 ;THIS TABLE REPLICATES ^AUTTINTY INSURER TYPE (21 ENTRIES) P.OTT 4/12/2013
+5 ;AND MAPS INSURER TYPE CODE TO CATEGORY (IE: W --> OTHER)
H ;;PRIVATE INSURANCE;;HMO
M ;;PRIVATE INSURANCE;;MEDICARE SUPPL.
D ;;MEDICAID;;MEDICAID FI
R ;;MEDICARE;;MEDICARE FI
P ;;PRIVATE INSURANCE;;PRIVATE INSURANCE
W ;;OTHER;;WORKMEN'S COMP
C ;;OTHER;;CHAMPUS
N ;;OTHER;;NON-BENEFICIARY (NON-INDIAN)
I ;;OTHER;;INDIAN PATIENT
K ;;MEDICAID;;CHIP (KIDSCARE)
T ;;OTHER;;THIRD PARTY LIABILITY
G ;;OTHER;;GUARANTOR
MD ;;MEDICARE;;MCR PART D
MH ;;MEDICARE;;MEDICARE HMO
MMC ;;MEDICARE;;MCR MANAGED CARE
TSI ;;OTHER;;TRIBAL SELF INSURED
SEP ;;OTHER;;STATE EXCHANGE PLAN
FPL ;;MEDICAID;;FPL 133 PERCENT
MC ;;MEDICARE;;MCR PART C
F ;;PRIVATE INSURANCE;;FRATERNAL ORGANIZATION
V ;;VETERAN;;VETERANS MEDICAL BENEFITS
+1 ;;***END OF TABLE**
