BARRASM.m

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)