BARTRNS4 ; IHS/SD/SDR - Transaction Summary/Detail Report ; 03/10/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**10,19,20,22,23,28**;OCT 26, 2005;Build 92
;IHS/SD/POT 1.8*23 HEAT74599 JUNE 2012 "No Billing Entity" & $T("No Billing Entity"
;IHS/SD/POT 1.8*23 MAR 2013 ADDED NEW VA billing
;IHS/SD/SDR 1.8*28 Updated p23 documentation
;IHS/SD/SDR,POT 1.8*28 CR8397 HEAT155084 (SDR) - Split from routine BARTRNS1 due to size. Corrected column header from Adj Amt to Adj Cat. Added column
; for Adj Amt. Added #DAYS (APPR.DT-ADJ.DT) (Header was printing without data). Changed loop to
; look thru transaction file, not bill file.
; (POT) - ADD ADJ TYPE IEN TO THE DETAIL REPORT; FIX MISSING #OF DATES (#5PIECE)
PRINT ;
D HDB
I '$D(^TMP($J,"BAR-TRANST"))&(BARY("RTYP")=1) D Q
.W !!!!!?25,"*** NO DATA TO PRINT ***"
.D EOP^BARUTL(0)
;summary lines
I $D(^TMP($J,"BAR-TRANST")) W !,"LOCATION^ALLOWANCE CAT^INSURER TYPE^INSURER^BILL COUNT^TOTAL BILL AMOUNT^TOTAL PAYMENTS^ADJ TYPE IEN^ADJUSTMENT TYPE^TOTAL ADJUSTMENTS"
S BAR("LOC")=0
F S BAR("LOC")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"))) Q:'BAR("LOC") D
.S BAR("ITYP")=""
.F S BAR("ITYP")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"))) Q:BAR("ITYP")="" D
..I BAR("ITYP")="No Billing Entity" Q ;bar*1.8*23 IHS/SD/POT HEAT74599
..;PKD 1.8*19 12/29/10 -A/R ACCT- Zero if missing
..;S BAR("INS")=0
..;F S BAR("INS")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))) Q:'BAR("INS") D
..S BAR("INS")=""
..F S BAR("INS")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))) Q:BAR("INS")'?1N.N D
...S BARO("LOC")=$P($G(^AUTTLOC(BAR("LOC"),0)),U,2)
...S BARO("ALLC")=$P($T(@BAR("ITYP")),";;",2)
...S BARO("ITYP")=$P($T(@BAR("ITYP")),";;",3)
...;PKD 1.8*19 fix undef if no A/R acct
...;S BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01)
...I BAR("INS")'=0 S BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01) I 1
...E S BARO("INS")="No A/R Account"
...S BARREC=BARO("LOC")_U_BARO("ALLC")_U_BARO("ITYP")_U_BARO("INS")_U
...W !,BARREC_$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")))
...I $D(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS")) D
....;PKD 1.8*19 - including AdjTypeIEN
....;S BAR("ADJ")=""
....;F S BAR("ADJ")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJ"))) Q:BAR("ADJ")="" D
....S (BAR("ADJ"),BAR("ADJIEN"))="" ;only one AdjType per AdjTypeIEN
....S BARACNT=0
....F S BAR("ADJIEN")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"))) Q:BAR("ADJIEN")="" D
.....S BAR("ADJ")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"),"")) ;bar*1.8*20
.....;start old bar*1.8*22 SDR NOHEAT
.....;I BARACNT'=0 W !,BARREC_U_U
.....;;W U_BAR("ADJ")_U_$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJ"))) 1.8.19
.....;;W U_BAR("ADJIEN")_U_BAR("ADJ")_U_$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"),BAR("ADJ"))) ;bar*1.8*20
.....;W U_BAR("ADJIEN")_U_BAR("ADJ")_U_$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"))) ;bar*1.8*20
.....;S BARACNT=1
.....;end old start new NOHEAT
.....S BAR("ADJ TYP")=""
.....F S BAR("ADJ TYP")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"),BAR("ADJ TYP"))) Q:BAR("ADJ TYP")="" D
......I BARACNT'=0 W !,BARREC_U_U
......W U_BAR("ADJIEN")_U_BAR("ADJ")_U_$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"),BAR("ADJ TYP"))) ;bar*1.8*20
......S BARACNT=1
.....;end new NOHEAT
;detail lines
I '$D(^TMP($J,"BAR-TRANS"))&(BARY("RTYP")=2) D Q
.W !!!!!?25,"*** NO DATA TO PRINT ***"
.D EOP^BARUTL(0)
;I $D(^TMP($J,"BAR-TRANS")) W !,"LOCATION^ALLOWANCE CAT^INSURER TYPE^INSURER^BILL^DOS^APPROVAL DT^TOTAL BILL AMT^TOTAL PAYMENTS^#DAYS (DOS-APPR.DT)^ADJUSTMENT DT^ADJUSTMENT TYPE^ADJUSTMENT AMT^#DAYS (APPR.DT-ADJ.DT)" ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
;start new bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
I $D(^TMP($J,"BAR-TRANS")) D
. W !,"LOCATION^ALLOWANCE CAT^INSURER TYPE^INSURER^BILL^DOS^APPROVAL DT^TOTAL BILL AMT^TOTAL PAYMENTS^#DAYS (DOS-APPR.DT)^ADJUSTMENT DT^ADJ TYPE IEN^ADJUSTMENT TYPE^ADJUSTMENT AMT^#DAYS (APPR.DT-ADJ.DT)"
;end new bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
S BAR("LOC")=0
F S BAR("LOC")=$O(^TMP($J,"BAR-TRANS",BAR("LOC"))) Q:'BAR("LOC") D
.S BAR("ITYP")=""
.F S BAR("ITYP")=$O(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"))) Q:BAR("ITYP")="" D
..I BAR("ITYP")="No Billing Entity" Q ;bar*1.8*23 IHS/SD/POT HEAT74599
..;PKD 1.8*19 If A/R acct is missing
..;S BAR("INS")=0
..;F S BAR("INS")=$O(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"))) Q:'BAR("INS") D
..S BAR("INS")=""
..F S BAR("INS")=$O(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"))) Q:BAR("INS")'?1N.N D
...S BARBILL=""
...F S BARBILL=$O(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL)) Q:BARBILL="" D
....S BARO("LOC")=$P($G(^AUTTLOC(BAR("LOC"),0)),U,2)
....S BARO("ALLC")=$P($T(@BAR("ITYP")),";;",2)
....S BARO("ITYP")=$P($T(@BAR("ITYP")),";;",3)
....;PKD 1.8*19 fix undef if no A/R acct
....;S BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01)
....I BAR("INS")'=0 S BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01) I 1
....E S BARO("INS")="No A/R Account"
....S BARREC=BARO("LOC")_U_BARO("ALLC")_U_BARO("ITYP")_U_BARO("INS")_U_BARBILL_U
....;PKD 1.8.20 1/25/11 BARDET - print detail all adj lines
....;W !,BARREC_$G(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL))
....S BARDTAIL=$G(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL))
....W !,BARREC_BARDTAIL
....;end 1.8.20
....I $D(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS")) D
.....S BARACNT=0
.....F S BARACNT=$O(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS",BARACNT)) Q:'BARACNT D
......;PKD 1.8*20 1/25/11 BARDET - Print bill amt even if >1 adj / bill
......;I BARACNT>1 W !,BARREC_U_U_U_U
......I BARACNT>1 D
.......I BARDET W !,BARREC_BARDTAIL
.......E W !,BARREC_U_U_U_U
......;END 1.8*20
......W U_$G(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS",BARACNT))
Q
HDB ; EP
;Page & column hdr
;EP for writing Rpt Hdr
W $$EN^BARVDF("IOF"),!
I $D(BAR("PRIVACY")) W ?($S($D(BAR(132)):34,$D(BAR(180)):68,1:8)),"WARNING: Confidential Patient Information, Privacy Act Applies",!
K BAR("LINE")
S $P(BAR("LINE"),"=",$S($D(BAR(133)):132,$D(BAR(180)):181,1:81))=""
W BAR("LINE"),!
W BAR("HD",0),?$S($D(BAR(132)):102,$D(BAR(180)):150,1:51)
D NOW^%DTC
S Y=%
X ^DD("DD")
W $P(Y,":",1,2)
S BAR("TMPLVL")=0
F S BAR("TMPLVL")=$O(BAR("HD",BAR("TMPLVL"))) Q:'BAR("TMPLVL")&(BAR("TMPLVL")'=0) W:$G(BAR("HD",BAR("TMPLVL")))]"" !,BAR("HD",BAR("TMPLVL"))
W !,BAR("LINE")
K BAR("LINE")
Q
;start old bar*1.8*23 IHS/SD/POT
;R ;;MEDICARE;;MEDICARE FI
;D ;;MEDICAID;;MEDICAID FI
;F ;;PRIVATE INSURANCE;;FRATERNAL ORGANIZATION
;P ;;PRIVATE INSURANCE;;PRIVATE INSURANCE
;H ;;PRIVATE INSURANCE;;HMO
;M ;;PRIVATE INSURANCE;;MEDICARE SUPPL.
;N ;;OTHER;;NON-BENEFICIARY (NON-INDIAN)
;I ;;OTHER;;INDIAN PATIENT
;W ;;OTHER;;WORKMEN'S COMP
;C ;;OTHER;;CHAMPUS
;K ;;MEDICAID;;CHIP (KIDSCARE)
;T ;;PRIVATE INSURANCE;;THIRD PARTY LIABILITY
;G ;;OTHER;;GUARANTOR
;MD ;;MEDICARE;;MCR PART D
;MH ;;MEDICARE;;MEDICARE HMO
;end old start new bar*1.8*23 IHS/SD/POT
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 new bar*1.8*23 IHS/SD/POT
;EOR - IHS/DIT/CPC 1.8*28
BARTRNS4 ; IHS/SD/SDR - Transaction Summary/Detail Report ; 03/10/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**10,19,20,22,23,28**;OCT 26, 2005;Build 92
+2 ;IHS/SD/POT 1.8*23 HEAT74599 JUNE 2012 "No Billing Entity" & $T("No Billing Entity"
+3 ;IHS/SD/POT 1.8*23 MAR 2013 ADDED NEW VA billing
+4 ;IHS/SD/SDR 1.8*28 Updated p23 documentation
+5 ;IHS/SD/SDR,POT 1.8*28 CR8397 HEAT155084 (SDR) - Split from routine BARTRNS1 due to size. Corrected column header from Adj Amt to Adj Cat. Added column
+6 ; for Adj Amt. Added #DAYS (APPR.DT-ADJ.DT) (Header was printing without data). Changed loop to
+7 ; look thru transaction file, not bill file.
+8 ; (POT) - ADD ADJ TYPE IEN TO THE DETAIL REPORT; FIX MISSING #OF DATES (#5PIECE)
PRINT ;
+1 DO HDB
+2 IF '$DATA(^TMP($JOB,"BAR-TRANST"))&(BARY("RTYP")=1)
Begin DoDot:1
+3 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+4 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+5 ;summary lines
+6 IF $DATA(^TMP($JOB,"BAR-TRANST"))
WRITE !,"LOCATION^ALLOWANCE CAT^INSURER TYPE^INSURER^BILL COUNT^TOTAL BILL AMOUNT^TOTAL PAYMENTS^ADJ TYPE IEN^ADJUSTMENT TYPE^TOTAL ADJUSTMENTS"
+7 SET BAR("LOC")=0
+8 FOR
SET BAR("LOC")=$ORDER(^TMP($JOB,"BAR-TRANST",BAR("LOC")))
IF 'BAR("LOC")
QUIT
Begin DoDot:1
+9 SET BAR("ITYP")=""
+10 FOR
SET BAR("ITYP")=$ORDER(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP")))
IF BAR("ITYP")=""
QUIT
Begin DoDot:2
+11 ;bar*1.8*23 IHS/SD/POT HEAT74599
IF BAR("ITYP")="No Billing Entity"
QUIT
+12 ;PKD 1.8*19 12/29/10 -A/R ACCT- Zero if missing
+13 ;S BAR("INS")=0
+14 ;F S BAR("INS")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))) Q:'BAR("INS") D
+15 SET BAR("INS")=""
+16 FOR
SET BAR("INS")=$ORDER(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")))
IF BAR("INS")'?1N.N
QUIT
Begin DoDot:3
+17 SET BARO("LOC")=$PIECE($GET(^AUTTLOC(BAR("LOC"),0)),U,2)
+18 SET BARO("ALLC")=$PIECE($TEXT(@BAR("ITYP")),";;",2)
+19 SET BARO("ITYP")=$PIECE($TEXT(@BAR("ITYP")),";;",3)
+20 ;PKD 1.8*19 fix undef if no A/R acct
+21 ;S BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01)
+22 IF BAR("INS")'=0
SET BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01)
IF 1
+23 IF '$TEST
SET BARO("INS")="No A/R Account"
+24 SET BARREC=BARO("LOC")_U_BARO("ALLC")_U_BARO("ITYP")_U_BARO("INS")_U
+25 WRITE !,BARREC_$GET(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")))
+26 IF $DATA(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS"))
Begin DoDot:4
+27 ;PKD 1.8*19 - including AdjTypeIEN
+28 ;S BAR("ADJ")=""
+29 ;F S BAR("ADJ")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJ"))) Q:BAR("ADJ")="" D
+30 ;only one AdjType per AdjTypeIEN
SET (BAR("ADJ"),BAR("ADJIEN"))=""
+31 SET BARACNT=0
+32 FOR
SET BAR("ADJIEN")=$ORDER(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN")))
IF BAR("ADJIEN")=""
QUIT
Begin DoDot:5
+33 ;bar*1.8*20
SET BAR("ADJ")=$ORDER(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"),""))
+34 ;start old bar*1.8*22 SDR NOHEAT
+35 ;I BARACNT'=0 W !,BARREC_U_U
+36 ;;W U_BAR("ADJ")_U_$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJ"))) 1.8.19
+37 ;;W U_BAR("ADJIEN")_U_BAR("ADJ")_U_$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"),BAR("ADJ"))) ;bar*1.8*20
+38 ;W U_BAR("ADJIEN")_U_BAR("ADJ")_U_$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"))) ;bar*1.8*20
+39 ;S BARACNT=1
+40 ;end old start new NOHEAT
+41 SET BAR("ADJ TYP")=""
+42 FOR
SET BAR("ADJ TYP")=$ORDER(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"),BAR("ADJ TYP")))
IF BAR("ADJ TYP")=""
QUIT
Begin DoDot:6
+43 IF BARACNT'=0
WRITE !,BARREC_U_U
+44 ;bar*1.8*20
WRITE U_BAR("ADJIEN")_U_BAR("ADJ")_U_$GET(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"),BAR("ADJ TYP")))
+45 SET BARACNT=1
End DoDot:6
+46 ;end new NOHEAT
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+47 ;detail lines
+48 IF '$DATA(^TMP($JOB,"BAR-TRANS"))&(BARY("RTYP")=2)
Begin DoDot:1
+49 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+50 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+51 ;I $D(^TMP($J,"BAR-TRANS")) W !,"LOCATION^ALLOWANCE CAT^INSURER TYPE^INSURER^BILL^DOS^APPROVAL DT^TOTAL BILL AMT^TOTAL PAYMENTS^#DAYS (DOS-APPR.DT)^ADJUSTMENT DT^ADJUSTMENT TYPE^ADJUSTMENT AMT^#DAYS (APPR.DT-ADJ.DT)" ;bar*1.8*28 IHS/SD/POT CR83
97 HEAT155084
+52 ;start new bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
+53 IF $DATA(^TMP($JOB,"BAR-TRANS"))
Begin DoDot:1
+54 WRITE !,"LOCATION^ALLOWANCE CAT^INSURER TYPE^INSURER^BILL^DOS^APPROVAL DT^TOTAL BILL AMT^TOTAL PAYMENTS^#DAYS (DOS-APPR.DT)^ADJUSTMENT DT^ADJ TYPE IEN^ADJUSTMENT TYPE^ADJUSTMENT AMT^#DAYS (APPR.DT-ADJ.DT)"
End DoDot:1
+55 ;end new bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
+56 SET BAR("LOC")=0
+57 FOR
SET BAR("LOC")=$ORDER(^TMP($JOB,"BAR-TRANS",BAR("LOC")))
IF 'BAR("LOC")
QUIT
Begin DoDot:1
+58 SET BAR("ITYP")=""
+59 FOR
SET BAR("ITYP")=$ORDER(^TMP($JOB,"BAR-TRANS",BAR("LOC"),BAR("ITYP")))
IF BAR("ITYP")=""
QUIT
Begin DoDot:2
+60 ;bar*1.8*23 IHS/SD/POT HEAT74599
IF BAR("ITYP")="No Billing Entity"
QUIT
+61 ;PKD 1.8*19 If A/R acct is missing
+62 ;S BAR("INS")=0
+63 ;F S BAR("INS")=$O(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"))) Q:'BAR("INS") D
+64 SET BAR("INS")=""
+65 FOR
SET BAR("INS")=$ORDER(^TMP($JOB,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS")))
IF BAR("INS")'?1N.N
QUIT
Begin DoDot:3
+66 SET BARBILL=""
+67 FOR
SET BARBILL=$ORDER(^TMP($JOB,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL))
IF BARBILL=""
QUIT
Begin DoDot:4
+68 SET BARO("LOC")=$PIECE($GET(^AUTTLOC(BAR("LOC"),0)),U,2)
+69 SET BARO("ALLC")=$PIECE($TEXT(@BAR("ITYP")),";;",2)
+70 SET BARO("ITYP")=$PIECE($TEXT(@BAR("ITYP")),";;",3)
+71 ;PKD 1.8*19 fix undef if no A/R acct
+72 ;S BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01)
+73 IF BAR("INS")'=0
SET BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01)
IF 1
+74 IF '$TEST
SET BARO("INS")="No A/R Account"
+75 SET BARREC=BARO("LOC")_U_BARO("ALLC")_U_BARO("ITYP")_U_BARO("INS")_U_BARBILL_U
+76 ;PKD 1.8.20 1/25/11 BARDET - print detail all adj lines
+77 ;W !,BARREC_$G(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL))
+78 SET BARDTAIL=$GET(^TMP($JOB,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL))
+79 WRITE !,BARREC_BARDTAIL
+80 ;end 1.8.20
+81 IF $DATA(^TMP($JOB,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS"))
Begin DoDot:5
+82 SET BARACNT=0
+83 FOR
SET BARACNT=$ORDER(^TMP($JOB,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS",BARACNT))
IF 'BARACNT
QUIT
Begin DoDot:6
+84 ;PKD 1.8*20 1/25/11 BARDET - Print bill amt even if >1 adj / bill
+85 ;I BARACNT>1 W !,BARREC_U_U_U_U
+86 IF BARACNT>1
Begin DoDot:7
+87 IF BARDET
WRITE !,BARREC_BARDTAIL
+88 IF '$TEST
WRITE !,BARREC_U_U_U_U
End DoDot:7
+89 ;END 1.8*20
+90 WRITE U_$GET(^TMP($JOB,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS",BARACNT))
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+91 QUIT
HDB ; EP
+1 ;Page & column hdr
+2 ;EP for writing Rpt Hdr
+3 WRITE $$EN^BARVDF("IOF"),!
+4 IF $DATA(BAR("PRIVACY"))
WRITE ?($SELECT($DATA(BAR(132)):34,$DATA(BAR(180)):68,1:8)),"WARNING: Confidential Patient Information, Privacy Act Applies",!
+5 KILL BAR("LINE")
+6 SET $PIECE(BAR("LINE"),"=",$SELECT($DATA(BAR(133)):132,$DATA(BAR(180)):181,1:81))=""
+7 WRITE BAR("LINE"),!
+8 WRITE BAR("HD",0),?$SELECT($DATA(BAR(132)):102,$DATA(BAR(180)):150,1:51)
+9 DO NOW^%DTC
+10 SET Y=%
+11 XECUTE ^DD("DD")
+12 WRITE $PIECE(Y,":",1,2)
+13 SET BAR("TMPLVL")=0
+14 FOR
SET BAR("TMPLVL")=$ORDER(BAR("HD",BAR("TMPLVL")))
IF 'BAR("TMPLVL")&(BAR("TMPLVL")'=0)
QUIT
IF $GET(BAR("HD",BAR("TMPLVL")))]""
WRITE !,BAR("HD",BAR("TMPLVL"))
+15 WRITE !,BAR("LINE")
+16 KILL BAR("LINE")
+17 QUIT
+18 ;start old bar*1.8*23 IHS/SD/POT
+19 ;R ;;MEDICARE;;MEDICARE FI
+20 ;D ;;MEDICAID;;MEDICAID FI
+21 ;F ;;PRIVATE INSURANCE;;FRATERNAL ORGANIZATION
+22 ;P ;;PRIVATE INSURANCE;;PRIVATE INSURANCE
+23 ;H ;;PRIVATE INSURANCE;;HMO
+24 ;M ;;PRIVATE INSURANCE;;MEDICARE SUPPL.
+25 ;N ;;OTHER;;NON-BENEFICIARY (NON-INDIAN)
+26 ;I ;;OTHER;;INDIAN PATIENT
+27 ;W ;;OTHER;;WORKMEN'S COMP
+28 ;C ;;OTHER;;CHAMPUS
+29 ;K ;;MEDICAID;;CHIP (KIDSCARE)
+30 ;T ;;PRIVATE INSURANCE;;THIRD PARTY LIABILITY
+31 ;G ;;OTHER;;GUARANTOR
+32 ;MD ;;MEDICARE;;MCR PART D
+33 ;MH ;;MEDICARE;;MEDICARE HMO
+34 ;end old start new bar*1.8*23 IHS/SD/POT
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 new bar*1.8*23 IHS/SD/POT
+2 ;EOR - IHS/DIT/CPC 1.8*28
