BARRASM ; IHS/SD/LSL - Age Summary Report ; 09/15/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,6,7,23,24**;OCT 26, 2005;Build 69
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
; IHS/ASDS/LSL - 02/27/02 - Routine created to replace BARRSAGE
;
; IHS/SD/LSL - 02/20/03 - V1.7 Patch 1
; Modified to include report by Discharge Service
; When sort by Clinic, make it alphabetical
;
; IHS/SD/LSL - 11/24/03 - V1.7 Patch 4
; Add Visit Location Sort level to accomodate EISS
;
;IHS/SD/POT 03/15/13 ADDED NEW VA billing ;BAR*1.8*23
;
;IHS\OCAO\CPC -20131007 OCT 2013 HEAT#132196 PROBLEM WITH NO BILLING ENTITY - BAR*1.8*24
Q
; *********************************************************************
EN ; EP
K BARY,BAR
D:'$D(BARUSR) INIT^BARUTL ; Set up basic A/R Variables
S BARP("RTN")="BARRASM" ; Routine used to gather data
S BAR("PRIVACY")=1 ; Privacy act applies (used BARRHD)
S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16) ; BILLING or VISIT
I BAR("LOC")="" S BAR("LOC")="VISIT"
D ASK^BARRASMA ; Ask all question
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
D SETHDR ; Build header array
S BARQ("RC")="COMPUTE^BARRASM" ; Build tmp global with data
S BARQ("RP")="PRINT^BARRASMB" ; 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
; *********************************************************************
;
SETHDR ;
; Build header array
S BAR("LVL")=0
S BAR("HD",0)="Age Summary Report"
I $D(BARP("UAGE")) S BAR("HD",0)="UFMS "_BAR("HD",0)_" for FY "_$P(BARP("UAGE"),U) ;MRS:BAR*1.8*7 TO131 REQ_2
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
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 - CALLED FROM BARBIZ
S BAR("SUBR")="BAR-ASM"
K ^TMP($J,"BAR-ASM")
K ^TMP($J,"BAR-ASMT")
D NOW^%DTC
S BARRUN=%
I BAR("LOC")="BILLING" D LOOP^BARRUTL Q
S BARDUZ2=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2) D LOOP^BARRUTL
S DUZ(2)=BARDUZ2
Q
; *********************************************************************
;
DATA ;
; Gather data for bills found in LOOP^BARRUTL
;
; BAR("SUB0") = Visit Location
; BAR("SUB1") = Clinic / visit type / A/R Account / Discharge Service
; BAR("SUB2") = Billing Entity / Allowance Category / Insurer Type
; BAR("SUB3") = A/R Account
; BAR("SUB4") = A/R Bill
;
; BAR(1) = 0-30 (Current)
; BAR(2) = 31-60
; BAR(3) = 61-90
; BAR(4) = 91-120
; BAR(5) = 120+
; BAR(6) = Account Balance
; -------------------------------
;
F I=1:1:6 S BAR(I)=0
K BAR("SUB0")
K BAR("SUB1"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")
S BARP("HIT")=0
I $D(BARP("UAGE")) Q:'$$UAGE^BARRASM2(BAR) ;MRS:BAR*1.8*7 TO131 REQ_2
D BILL^BARRCHK
Q:'BARP("HIT")
S BAR(1)=$$GET1^DIQ(90050.01,BAR,7.3)
S BAR(2)=$$GET1^DIQ(90050.01,BAR,7.4)
S BAR(3)=$$GET1^DIQ(90050.01,BAR,7.5)
S BAR(4)=$$GET1^DIQ(90050.01,BAR,7.6)
S BAR(5)=$$GET1^DIQ(90050.01,BAR,7.7)
S BAR(6)=$$GET1^DIQ(90050.01,BAR,15,"I")
S BARRAGE=$$GET1^DIQ(90050.01,BAR,7.2)
S ^BARASMD(BARRUN,BAR)=BAR(6)_U_BARRAGE_U_BAR("I")
S BAR("SUB0")=$$GET1^DIQ(9999999.06,BAR("L"),.01)
S:BAR("SUB0")="" BAR("SUB0")="No Visit Location"
I ",1,2,3,4,"[(","_BARY("STCR")_",") D Q
. I BARY("STCR")=1 D
. . S BAR("SUB1")=BAR("I")
. . I BAR("SUB1")]"" S BAR("SUB1")=$$GET1^DIQ(90050.02,BAR("SUB1"),.01)
. . I BAR("SUB1")="" S BAR("SUB1")="No A/R Account"
. I BARY("STCR")=2 D
. . S BAR("SUB1")=BAR("C")
. . I BAR("SUB1")]"",BAR("SUB1")'=99999 S BAR("SUB1")=$$GET1^DIQ(40.7,BAR("SUB1"),.01)
. . I BAR("SUB1")=""!(BAR("SUB1")=99999) S BAR("SUB1")="No Clinic Type"
. I BARY("STCR")=3 D
. . S BAR("SUB1")=BAR("V")
. . I BAR("SUB1")]"",BAR("SUB1")'=99999 S BAR("SUB1")=$$GET1^DIQ(9002274.8,BAR("SUB1"),.01)
. . I BAR("SUB1")=""!(BAR("SUB1")=99999) S BAR("SUB1")="No Visit Type"
. I BARY("STCR")=4 D
. . S BAR("SUB1")=BAR("DS")
. . I BAR("SUB1")]"",BAR("SUB1")'=99999 S BAR("SUB1")=$$GET1^DIQ(45.7,BAR("SUB1"),.01)
. . I BAR("SUB1")=""!(BAR("SUB1")=99999) S BAR("SUB1")="No Discharge Service"
. D STANDARD
I BARY("STCR")=5 D
. S BAR("SUB2")="OTHER"
. ;
. I BAR("ALL")="D" S BAR("SUB2")="MEDICAID"
. I BAR("ALL")="K" S BAR("SUB2")="MEDICAID"
. I BAR("ALL")="FPL" S BAR("SUB2")="MEDICAID"
. ;
. I BAR("ALL")="R" S BAR("SUB2")="MEDICARE"
. I BAR("ALL")="MH" S BAR("SUB2")="MEDICARE"
. I BAR("ALL")="MD" S BAR("SUB2")="MEDICARE"
. I BAR("ALL")="MC" S BAR("SUB2")="MEDICARE"
. I BAR("ALL")="MCC" S BAR("SUB2")="MEDICARE"
. ;
. I BAR("ALL")="H" S BAR("SUB2")="PRIVATE INSURANCE"
. I BAR("ALL")="M" S BAR("SUB2")="PRIVATE INSURANCE"
. I BAR("ALL")="P" S BAR("SUB2")="PRIVATE INSURANCE"
. I BAR("ALL")="F" S BAR("SUB2")="PRIVATE INSURANCE"
. ;
. I BAR("ALL")="V" S BAR("SUB2")="VETERANS"
. ;
;I BARY("STCR")=6 D ;OLD CODE
;. ;I $L(BAR("BI")) S BAR("SUB2")=$P($T(@BAR("BI")),";;",2) ;BAR*1.8*1 IM21585
;. I $L(BAR("BI"))<4 S BAR("SUB2")=$P($T(@BAR("BI")),";;",2) ;BAR*1.8*1 IM21585
;. S:BAR("SUB2")="" BAR("SUB2")=BAR("BI")
;. E S BAR("SUB2")=BAR("BI")
;PROBLEM WITH NO BILLING ENTITY - IHS\OCAO\CPC -20131007 NEW CODE
I BARY("STCR")=6 D
. S BAR("SUB2")=BAR("BI") ;No Billing Entity
. I $L(BAR("BI"))<4 I $P($T(@BAR("BI")),";;",2)]"" D
. . S BAR("SUB2")=$P($T(@BAR("BI")),";;",2)
I BARY("STCR")=7 D
. I $L(BAR("BI")) S BAR("SUB2")=$P($T(@BAR("BI")),";;",3) ;BAR*1.8*1 IM21585
. S:BAR("SUB2")="" BAR("SUB2")="No Insurer Type"
. E S BAR("SUB2")="No Insurer Type"
S BAR("SUB3")=BAR("I")
I BAR("SUB3")]"" S BAR("SUB3")=$$GET1^DIQ(90050.02,BAR("SUB3"),.01)
I BAR("SUB3")="" S BAR("SUB3")="No A/R Account"
S BAR("SUB4")=$$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-ASM",BAR("SUB0"),BAR("SUB1")))
S $P(^TMP($J,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U)=$P(BARHLD,U)+BAR(1)
S $P(^TMP($J,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U,4)=$P(BARHLD,U,4)+BAR(4)
S $P(^TMP($J,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U,5)=$P(BARHLD,U,5)+BAR(5)
S $P(^TMP($J,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U,6)=$P(BARHLD,U,6)+BAR(6)
;
; Visit location totals
S BARHLD=$G(^TMP($J,"BAR-ASM",BAR("SUB0")))
S $P(^TMP($J,"BAR-ASM",BAR("SUB0")),U)=$P(BARHLD,U)+BAR(1)
S $P(^TMP($J,"BAR-ASM",BAR("SUB0")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-ASM",BAR("SUB0")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-ASM",BAR("SUB0")),U,4)=$P(BARHLD,U,4)+BAR(4)
S $P(^TMP($J,"BAR-ASM",BAR("SUB0")),U,5)=$P(BARHLD,U,5)+BAR(5)
S $P(^TMP($J,"BAR-ASM",BAR("SUB0")),U,6)=$P(BARHLD,U,6)+BAR(6)
;
; Report Total
S BARHLD=$G(^TMP($J,"BAR-ASM"))
S $P(^TMP($J,"BAR-ASM"),U)=$P(BARHLD,U)+BAR(1)
S $P(^TMP($J,"BAR-ASM"),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-ASM"),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-ASM"),U,4)=$P(BARHLD,U,4)+BAR(4)
S $P(^TMP($J,"BAR-ASM"),U,5)=$P(BARHLD,U,5)+BAR(5)
S $P(^TMP($J,"BAR-ASM"),U,6)=$P(BARHLD,U,6)+BAR(6)
Q
; *********************************************************************
;
SUMMARY ;
; Temp global for SORT CRITERIA Allowance Category or Billing Entity
; and Report Type Summarize.
;
; Detail Lines
S BARHLD=$G(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")))
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U)=$P(BARHLD,U)+BAR(1)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U,4)=$P(BARHLD,U,4)+BAR(4)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U,5)=$P(BARHLD,U,5)+BAR(5)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U,6)=$P(BARHLD,U,6)+BAR(6)
;
; Visit location totals
S BARHLD=$G(^TMP($J,"BAR-ASMT",BAR("SUB0")))
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0")),U)=$P(BARHLD,U)+BAR(1)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0")),U,4)=$P(BARHLD,U,4)+BAR(4)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0")),U,5)=$P(BARHLD,U,5)+BAR(5)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0")),U,6)=$P(BARHLD,U,6)+BAR(6)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0")),U,7)=BAR("L") ; DUZ(2) value
;
; Report Total
S BARHLD=$G(^TMP($J,"BAR-ASMT"))
S $P(^TMP($J,"BAR-ASMT"),U)=$P(BARHLD,U)+BAR(1)
S $P(^TMP($J,"BAR-ASMT"),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-ASMT"),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-ASMT"),U,4)=$P(BARHLD,U,4)+BAR(4)
S $P(^TMP($J,"BAR-ASMT"),U,5)=$P(BARHLD,U,5)+BAR(5)
S $P(^TMP($J,"BAR-ASMT"),U,6)=$P(BARHLD,U,6)+BAR(6)
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-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")))
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U)=$P(BARHLD,U)+BAR(1)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U,4)=$P(BARHLD,U,4)+BAR(4)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U,5)=$P(BARHLD,U,5)+BAR(5)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U,6)=$P(BARHLD,U,6)+BAR(6)
Q
; *********************************************************************
;
BILL ;
; Temp global for SORT CRITERIA Allowance Category or Billing Entity
; and Report Type Summarize by bill w/in payer w/in all cat/bill ent
;
; Detail Lines
S BARHLD=$G(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")))
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U)=$P(BARHLD,U)+BAR(1)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U,2)=$P(BARHLD,U,2)+BAR(2)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U,3)=$P(BARHLD,U,3)+BAR(3)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U,4)=$P(BARHLD,U,4)+BAR(4)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U,5)=$P(BARHLD,U,5)+BAR(5)
S $P(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U,6)=$P(BARHLD,U,6)+BAR(6)
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**
BARRASM ; IHS/SD/LSL - Age Summary Report ; 09/15/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,6,7,23,24**;OCT 26, 2005;Build 69
+2 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+3 ; IHS/ASDS/LSL - 02/27/02 - Routine created to replace BARRSAGE
+4 ;
+5 ; IHS/SD/LSL - 02/20/03 - V1.7 Patch 1
+6 ; Modified to include report by Discharge Service
+7 ; When sort by Clinic, make it alphabetical
+8 ;
+9 ; IHS/SD/LSL - 11/24/03 - V1.7 Patch 4
+10 ; Add Visit Location Sort level to accomodate EISS
+11 ;
+12 ;IHS/SD/POT 03/15/13 ADDED NEW VA billing ;BAR*1.8*23
+13 ;
+14 ;IHS\OCAO\CPC -20131007 OCT 2013 HEAT#132196 PROBLEM WITH NO BILLING ENTITY - BAR*1.8*24
+15 QUIT
+16 ; *********************************************************************
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")="BARRASM"
+4 ; Privacy act applies (used BARRHD)
SET BAR("PRIVACY")=1
+5 ; BILLING or VISIT
SET BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)
+6 IF BAR("LOC")=""
SET BAR("LOC")="VISIT"
+7 ; Ask all question
DO ASK^BARRASMA
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+9 ; Build header array
DO SETHDR
+10 ; Build tmp global with data
SET BARQ("RC")="COMPUTE^BARRASM"
+11 ; Print reports from tmp global
SET BARQ("RP")="PRINT^BARRASMB"
+12 ; Namespace for variables
SET BARQ("NS")="BAR"
+13 ; Clean-up routine
SET BARQ("RX")="POUT^BARRUTL"
+14 ; Double queuing
DO ^BARDBQUE
+15 ; Press return to continue
DO PAZ^BARRUTL
+16 QUIT
+17 ; *********************************************************************
+18 ;
SETHDR ;
+1 ; Build header array
+2 SET BAR("LVL")=0
+3 SET BAR("HD",0)="Age Summary Report"
+4 ;MRS:BAR*1.8*7 TO131 REQ_2
IF $DATA(BARP("UAGE"))
SET BAR("HD",0)="UFMS "_BAR("HD",0)_" for FY "_$PIECE(BARP("UAGE"),U)
+5 IF ",1,2,3,4,"[(","_BARY("STCR")_",")
SET BAR("HD",0)=BAR("HD",0)_" by "_BARY("STCR","NM")
+6 IF BARY("STCR")=5
DO ALLOW^BARRHD
DO CHK^BARRHD
+7 IF BARY("STCR")=6
DO BIL^BARRHD
DO CHK^BARRHD
+8 IF BARY("STCR")=7
DO ITYP^BARRHD
DO CHK^BARRHD
+9 SET BAR("TXT")="ALL"
+10 IF $DATA(BARY("LOC"))
SET BAR("TXT")=$PIECE(^DIC(4,BARY("LOC"),0),U)
+11 IF BAR("LOC")="BILLING"
Begin DoDot:1
+12 SET BAR("TXT")=BAR("TXT")_" Visit location(s) under "
+13 SET BAR("TXT")=BAR("TXT")_$PIECE(^DIC(4,DUZ(2),0),U)
+14 SET BAR("TXT")=BAR("TXT")_" Billing Location"
End DoDot:1
+15 IF '$TEST
SET BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
+16 SET BAR("CONJ")="at "
+17 DO CHK^BARRHD
+18 QUIT
+19 ; *********************************************************************
+20 ;
COMPUTE ;EP - CALLED FROM BARBIZ
+1 SET BAR("SUBR")="BAR-ASM"
+2 KILL ^TMP($JOB,"BAR-ASM")
+3 KILL ^TMP($JOB,"BAR-ASMT")
+4 DO NOW^%DTC
+5 SET BARRUN=%
+6 IF BAR("LOC")="BILLING"
DO LOOP^BARRUTL
QUIT
+7 SET BARDUZ2=DUZ(2)
+8 SET DUZ(2)=0
+9 FOR
SET DUZ(2)=$ORDER(^BARBL(DUZ(2)))
IF 'DUZ(2)
QUIT
DO LOOP^BARRUTL
+10 SET DUZ(2)=BARDUZ2
+11 QUIT
+12 ; *********************************************************************
+13 ;
DATA ;
+1 ; Gather data for bills found in LOOP^BARRUTL
+2 ;
+3 ; BAR("SUB0") = Visit Location
+4 ; BAR("SUB1") = Clinic / visit type / A/R Account / Discharge Service
+5 ; BAR("SUB2") = Billing Entity / Allowance Category / Insurer Type
+6 ; BAR("SUB3") = A/R Account
+7 ; BAR("SUB4") = A/R Bill
+8 ;
+9 ; BAR(1) = 0-30 (Current)
+10 ; BAR(2) = 31-60
+11 ; BAR(3) = 61-90
+12 ; BAR(4) = 91-120
+13 ; BAR(5) = 120+
+14 ; BAR(6) = Account Balance
+15 ; -------------------------------
+16 ;
+17 FOR I=1:1:6
SET BAR(I)=0
+18 KILL BAR("SUB0")
+19 KILL BAR("SUB1"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")
+20 SET BARP("HIT")=0
+21 ;MRS:BAR*1.8*7 TO131 REQ_2
IF $DATA(BARP("UAGE"))
IF '$$UAGE^BARRASM2(BAR)
QUIT
+22 DO BILL^BARRCHK
+23 IF 'BARP("HIT")
QUIT
+24 SET BAR(1)=$$GET1^DIQ(90050.01,BAR,7.3)
+25 SET BAR(2)=$$GET1^DIQ(90050.01,BAR,7.4)
+26 SET BAR(3)=$$GET1^DIQ(90050.01,BAR,7.5)
+27 SET BAR(4)=$$GET1^DIQ(90050.01,BAR,7.6)
+28 SET BAR(5)=$$GET1^DIQ(90050.01,BAR,7.7)
+29 SET BAR(6)=$$GET1^DIQ(90050.01,BAR,15,"I")
+30 SET BARRAGE=$$GET1^DIQ(90050.01,BAR,7.2)
+31 SET ^BARASMD(BARRUN,BAR)=BAR(6)_U_BARRAGE_U_BAR("I")
+32 SET BAR("SUB0")=$$GET1^DIQ(9999999.06,BAR("L"),.01)
+33 IF BAR("SUB0")=""
SET BAR("SUB0")="No Visit Location"
+34 IF ",1,2,3,4,"[(","_BARY("STCR")_",")
Begin DoDot:1
+35 IF BARY("STCR")=1
Begin DoDot:2
+36 SET BAR("SUB1")=BAR("I")
+37 IF BAR("SUB1")]""
SET BAR("SUB1")=$$GET1^DIQ(90050.02,BAR("SUB1"),.01)
+38 IF BAR("SUB1")=""
SET BAR("SUB1")="No A/R Account"
End DoDot:2
+39 IF BARY("STCR")=2
Begin DoDot:2
+40 SET BAR("SUB1")=BAR("C")
+41 IF BAR("SUB1")]""
IF BAR("SUB1")'=99999
SET BAR("SUB1")=$$GET1^DIQ(40.7,BAR("SUB1"),.01)
+42 IF BAR("SUB1")=""!(BAR("SUB1")=99999)
SET BAR("SUB1")="No Clinic Type"
End DoDot:2
+43 IF BARY("STCR")=3
Begin DoDot:2
+44 SET BAR("SUB1")=BAR("V")
+45 IF BAR("SUB1")]""
IF BAR("SUB1")'=99999
SET BAR("SUB1")=$$GET1^DIQ(9002274.8,BAR("SUB1"),.01)
+46 IF BAR("SUB1")=""!(BAR("SUB1")=99999)
SET BAR("SUB1")="No Visit Type"
End DoDot:2
+47 IF BARY("STCR")=4
Begin DoDot:2
+48 SET BAR("SUB1")=BAR("DS")
+49 IF BAR("SUB1")]""
IF BAR("SUB1")'=99999
SET BAR("SUB1")=$$GET1^DIQ(45.7,BAR("SUB1"),.01)
+50 IF BAR("SUB1")=""!(BAR("SUB1")=99999)
SET BAR("SUB1")="No Discharge Service"
End DoDot:2
+51 DO STANDARD
End DoDot:1
QUIT
+52 IF BARY("STCR")=5
Begin DoDot:1
+53 SET BAR("SUB2")="OTHER"
+54 ;
+55 IF BAR("ALL")="D"
SET BAR("SUB2")="MEDICAID"
+56 IF BAR("ALL")="K"
SET BAR("SUB2")="MEDICAID"
+57 IF BAR("ALL")="FPL"
SET BAR("SUB2")="MEDICAID"
+58 ;
+59 IF BAR("ALL")="R"
SET BAR("SUB2")="MEDICARE"
+60 IF BAR("ALL")="MH"
SET BAR("SUB2")="MEDICARE"
+61 IF BAR("ALL")="MD"
SET BAR("SUB2")="MEDICARE"
+62 IF BAR("ALL")="MC"
SET BAR("SUB2")="MEDICARE"
+63 IF BAR("ALL")="MCC"
SET BAR("SUB2")="MEDICARE"
+64 ;
+65 IF BAR("ALL")="H"
SET BAR("SUB2")="PRIVATE INSURANCE"
+66 IF BAR("ALL")="M"
SET BAR("SUB2")="PRIVATE INSURANCE"
+67 IF BAR("ALL")="P"
SET BAR("SUB2")="PRIVATE INSURANCE"
+68 IF BAR("ALL")="F"
SET BAR("SUB2")="PRIVATE INSURANCE"
+69 ;
+70 IF BAR("ALL")="V"
SET BAR("SUB2")="VETERANS"
+71 ;
End DoDot:1
+72 ;I BARY("STCR")=6 D ;OLD CODE
+73 ;. ;I $L(BAR("BI")) S BAR("SUB2")=$P($T(@BAR("BI")),";;",2) ;BAR*1.8*1 IM21585
+74 ;. I $L(BAR("BI"))<4 S BAR("SUB2")=$P($T(@BAR("BI")),";;",2) ;BAR*1.8*1 IM21585
+75 ;. S:BAR("SUB2")="" BAR("SUB2")=BAR("BI")
+76 ;. E S BAR("SUB2")=BAR("BI")
+77 ;PROBLEM WITH NO BILLING ENTITY - IHS\OCAO\CPC -20131007 NEW CODE
+78 IF BARY("STCR")=6
Begin DoDot:1
+79 ;No Billing Entity
SET BAR("SUB2")=BAR("BI")
+80 IF $LENGTH(BAR("BI"))<4
IF $PIECE($TEXT(@BAR("BI")),";;",2)]""
Begin DoDot:2
+81 SET BAR("SUB2")=$PIECE($TEXT(@BAR("BI")),";;",2)
End DoDot:2
End DoDot:1
+82 IF BARY("STCR")=7
Begin DoDot:1
+83 ;BAR*1.8*1 IM21585
IF $LENGTH(BAR("BI"))
SET BAR("SUB2")=$PIECE($TEXT(@BAR("BI")),";;",3)
+84 IF BAR("SUB2")=""
SET BAR("SUB2")="No Insurer Type"
+85 IF '$TEST
SET BAR("SUB2")="No Insurer Type"
End DoDot:1
+86 SET BAR("SUB3")=BAR("I")
+87 IF BAR("SUB3")]""
SET BAR("SUB3")=$$GET1^DIQ(90050.02,BAR("SUB3"),.01)
+88 IF BAR("SUB3")=""
SET BAR("SUB3")="No A/R Account"
+89 SET BAR("SUB4")=$$GET1^DIQ(90050.01,BAR,.01)
+90 IF $GET(BARY("RTYP"))=2
Begin DoDot:1
+91 DO DETAIL
End DoDot:1
+92 IF $GET(BARY("RTYP"))=3
Begin DoDot:1
+93 DO BILL
+94 DO DETAIL
End DoDot:1
+95 DO SUMMARY
+96 QUIT
+97 ; *********************************************************************
+98 ;
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-ASM",BAR("SUB0"),BAR("SUB1")))
+5 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U)=$PIECE(BARHLD,U)+BAR(1)
+6 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+7 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+8 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U,4)=$PIECE(BARHLD,U,4)+BAR(4)
+9 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U,5)=$PIECE(BARHLD,U,5)+BAR(5)
+10 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0"),BAR("SUB1")),U,6)=$PIECE(BARHLD,U,6)+BAR(6)
+11 ;
+12 ; Visit location totals
+13 SET BARHLD=$GET(^TMP($JOB,"BAR-ASM",BAR("SUB0")))
+14 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0")),U)=$PIECE(BARHLD,U)+BAR(1)
+15 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+16 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+17 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0")),U,4)=$PIECE(BARHLD,U,4)+BAR(4)
+18 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0")),U,5)=$PIECE(BARHLD,U,5)+BAR(5)
+19 SET $PIECE(^TMP($JOB,"BAR-ASM",BAR("SUB0")),U,6)=$PIECE(BARHLD,U,6)+BAR(6)
+20 ;
+21 ; Report Total
+22 SET BARHLD=$GET(^TMP($JOB,"BAR-ASM"))
+23 SET $PIECE(^TMP($JOB,"BAR-ASM"),U)=$PIECE(BARHLD,U)+BAR(1)
+24 SET $PIECE(^TMP($JOB,"BAR-ASM"),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+25 SET $PIECE(^TMP($JOB,"BAR-ASM"),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+26 SET $PIECE(^TMP($JOB,"BAR-ASM"),U,4)=$PIECE(BARHLD,U,4)+BAR(4)
+27 SET $PIECE(^TMP($JOB,"BAR-ASM"),U,5)=$PIECE(BARHLD,U,5)+BAR(5)
+28 SET $PIECE(^TMP($JOB,"BAR-ASM"),U,6)=$PIECE(BARHLD,U,6)+BAR(6)
+29 QUIT
+30 ; *********************************************************************
+31 ;
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-ASMT",BAR("SUB0"),BAR("SUB2")))
+6 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U)=$PIECE(BARHLD,U)+BAR(1)
+7 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+8 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+9 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U,4)=$PIECE(BARHLD,U,4)+BAR(4)
+10 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U,5)=$PIECE(BARHLD,U,5)+BAR(5)
+11 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2")),U,6)=$PIECE(BARHLD,U,6)+BAR(6)
+12 ;
+13 ; Visit location totals
+14 SET BARHLD=$GET(^TMP($JOB,"BAR-ASMT",BAR("SUB0")))
+15 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0")),U)=$PIECE(BARHLD,U)+BAR(1)
+16 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+17 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+18 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0")),U,4)=$PIECE(BARHLD,U,4)+BAR(4)
+19 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0")),U,5)=$PIECE(BARHLD,U,5)+BAR(5)
+20 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0")),U,6)=$PIECE(BARHLD,U,6)+BAR(6)
+21 ; DUZ(2) value
SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0")),U,7)=BAR("L")
+22 ;
+23 ; Report Total
+24 SET BARHLD=$GET(^TMP($JOB,"BAR-ASMT"))
+25 SET $PIECE(^TMP($JOB,"BAR-ASMT"),U)=$PIECE(BARHLD,U)+BAR(1)
+26 SET $PIECE(^TMP($JOB,"BAR-ASMT"),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+27 SET $PIECE(^TMP($JOB,"BAR-ASMT"),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+28 SET $PIECE(^TMP($JOB,"BAR-ASMT"),U,4)=$PIECE(BARHLD,U,4)+BAR(4)
+29 SET $PIECE(^TMP($JOB,"BAR-ASMT"),U,5)=$PIECE(BARHLD,U,5)+BAR(5)
+30 SET $PIECE(^TMP($JOB,"BAR-ASMT"),U,6)=$PIECE(BARHLD,U,6)+BAR(6)
+31 QUIT
+32 ; *********************************************************************
+33 ;
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-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")))
+6 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U)=$PIECE(BARHLD,U)+BAR(1)
+7 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+8 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+9 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U,4)=$PIECE(BARHLD,U,4)+BAR(4)
+10 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U,5)=$PIECE(BARHLD,U,5)+BAR(5)
+11 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3")),U,6)=$PIECE(BARHLD,U,6)+BAR(6)
+12 QUIT
+13 ; *********************************************************************
+14 ;
BILL ;
+1 ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
+2 ; and Report Type Summarize by bill w/in payer w/in all cat/bill ent
+3 ;
+4 ; Detail Lines
+5 SET BARHLD=$GET(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")))
+6 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U)=$PIECE(BARHLD,U)+BAR(1)
+7 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U,2)=$PIECE(BARHLD,U,2)+BAR(2)
+8 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U,3)=$PIECE(BARHLD,U,3)+BAR(3)
+9 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U,4)=$PIECE(BARHLD,U,4)+BAR(4)
+10 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U,5)=$PIECE(BARHLD,U,5)+BAR(5)
+11 SET $PIECE(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB2"),BAR("SUB3"),BAR("SUB4")),U,6)=$PIECE(BARHLD,U,6)+BAR(6)
+12 QUIT
+13 ; ********************************************************************
+14 ;
+15 ; ********************************************************************
+16 ;THIS TABLE REPLICATES ^AUTTINTY INSURER TYPE (21 ENTRIES) P.OTT 4/12/2013
+17 ;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**
