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

BARTRNS4.m

Go to the documentation of this file. 
  1. 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
  1.  ;IHS/SD/POT 1.8*23 HEAT74599 JUNE 2012 "No Billing Entity" & $T("No Billing Entity"
  1.  ;IHS/SD/POT 1.8*23 MAR 2013 ADDED NEW VA billing
  1.  ;IHS/SD/SDR 1.8*28 Updated p23 documentation
  1.  ;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
  1.  ;  for Adj Amt.  Added #DAYS (APPR.DT-ADJ.DT) (Header was printing without data).  Changed loop to
  1.  ;  look thru transaction file, not bill file.
  1.  ;  (POT) - ADD ADJ TYPE IEN TO THE DETAIL REPORT; FIX MISSING #OF DATES (#5PIECE)
  1. PRINT ;
  1.  D HDB
  1.  I '$D(^TMP($J,"BAR-TRANST"))&(BARY("RTYP")=1) D  Q
  1.  .W !!!!!?25,"*** NO DATA TO PRINT ***"
  1.  .D EOP^BARUTL(0)
  1.  ;summary lines
  1.  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"
  1.  S BAR("LOC")=0
  1.  F  S BAR("LOC")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"))) Q:'BAR("LOC")  D
  1.  .S BAR("ITYP")=""
  1.  .F  S BAR("ITYP")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"))) Q:BAR("ITYP")=""  D
  1.  ..I BAR("ITYP")="No Billing Entity" Q  ;bar*1.8*23 IHS/SD/POT HEAT74599 
  1.  ..;PKD 1.8*19 12/29/10 -A/R ACCT- Zero if missing
  1.  ..;S BAR("INS")=0
  1.  ..;F  S BAR("INS")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))) Q:'BAR("INS")  D
  1.  ..S BAR("INS")=""
  1.  ..F  S BAR("INS")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))) Q:BAR("INS")'?1N.N  D
  1.  ...S BARO("LOC")=$P($G(^AUTTLOC(BAR("LOC"),0)),U,2)
  1.  ...S BARO("ALLC")=$P($T(@BAR("ITYP")),";;",2)
  1.  ...S BARO("ITYP")=$P($T(@BAR("ITYP")),";;",3)
  1.  ...;PKD 1.8*19 fix undef if no A/R acct
  1.  ...;S BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01) 
  1.  ...I BAR("INS")'=0 S BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01) I 1
  1.  ...E  S BARO("INS")="No A/R Account"
  1.  ...S BARREC=BARO("LOC")_U_BARO("ALLC")_U_BARO("ITYP")_U_BARO("INS")_U
  1.  ...W !,BARREC_$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")))
  1.  ...I $D(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS")) D
  1.  ....;PKD 1.8*19 - including AdjTypeIEN
  1.  ....;S BAR("ADJ")=""
  1.  ....;F  S BAR("ADJ")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJ"))) Q:BAR("ADJ")=""  D
  1.  ....S (BAR("ADJ"),BAR("ADJIEN"))=""  ;only one AdjType per AdjTypeIEN
  1.  ....S BARACNT=0
  1.  ....F  S BAR("ADJIEN")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"))) Q:BAR("ADJIEN")=""  D
  1.  .....S BAR("ADJ")=$O(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJIEN"),""))  ;bar*1.8*20
  1.  .....;start old bar*1.8*22 SDR NOHEAT
  1.  .....;I BARACNT'=0 W !,BARREC_U_U
  1.  .....;;W U_BAR("ADJ")_U_$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BAR("ADJ"))) 1.8.19
  1.  .....;;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
  1.  .....;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
  1.  .....;S BARACNT=1
  1.  .....;end old start new NOHEAT
  1.  .....S BAR("ADJ TYP")=""
  1.  .....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
  1.  ......I BARACNT'=0 W !,BARREC_U_U
  1.  ......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
  1.  ......S BARACNT=1
  1.  .....;end new NOHEAT
  1.  ;detail lines
  1.  I '$D(^TMP($J,"BAR-TRANS"))&(BARY("RTYP")=2) D  Q
  1.  .W !!!!!?25,"*** NO DATA TO PRINT ***"
  1.  .D EOP^BARUTL(0)
  1.  ;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
  1.  ;start new bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
  1.  I $D(^TMP($J,"BAR-TRANS")) D
  1.  . 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)"
  1.  ;end new bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
  1.  S BAR("LOC")=0
  1.  F  S BAR("LOC")=$O(^TMP($J,"BAR-TRANS",BAR("LOC"))) Q:'BAR("LOC")  D
  1.  .S BAR("ITYP")=""
  1.  .F  S BAR("ITYP")=$O(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"))) Q:BAR("ITYP")=""  D
  1.  ..I BAR("ITYP")="No Billing Entity" Q  ;bar*1.8*23 IHS/SD/POT HEAT74599 
  1.  ..;PKD 1.8*19 If A/R acct is missing
  1.  ..;S BAR("INS")=0
  1.  ..;F  S BAR("INS")=$O(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"))) Q:'BAR("INS")  D
  1.  ..S BAR("INS")=""
  1.  ..F  S BAR("INS")=$O(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"))) Q:BAR("INS")'?1N.N  D
  1.  ...S BARBILL=""
  1.  ...F  S BARBILL=$O(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL)) Q:BARBILL=""  D
  1.  ....S BARO("LOC")=$P($G(^AUTTLOC(BAR("LOC"),0)),U,2)
  1.  ....S BARO("ALLC")=$P($T(@BAR("ITYP")),";;",2)
  1.  ....S BARO("ITYP")=$P($T(@BAR("ITYP")),";;",3)
  1.  ....;PKD 1.8*19 fix undef if no A/R acct
  1.  ....;S BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01)
  1.  ....I BAR("INS")'=0 S BARO("INS")=$$GET1^DIQ(90050.02,BAR("INS")_",",.01) I 1
  1.  ....E  S BARO("INS")="No A/R Account"
  1.  ....S BARREC=BARO("LOC")_U_BARO("ALLC")_U_BARO("ITYP")_U_BARO("INS")_U_BARBILL_U
  1.  ....;PKD 1.8.20 1/25/11 BARDET - print detail all adj lines
  1.  ....;W !,BARREC_$G(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL))
  1.  ....S BARDTAIL=$G(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL))
  1.  ....W !,BARREC_BARDTAIL
  1.  ....;end 1.8.20
  1.  ....I $D(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS")) D
  1.  .....S BARACNT=0
  1.  .....F  S BARACNT=$O(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS",BARACNT)) Q:'BARACNT  D
  1.  ......;PKD 1.8*20 1/25/11 BARDET - Print bill amt even if >1 adj / bill
  1.  ......;I BARACNT>1 W !,BARREC_U_U_U_U
  1.  ......I BARACNT>1 D
  1.  .......I BARDET W !,BARREC_BARDTAIL
  1.  .......E  W !,BARREC_U_U_U_U
  1.  ......;END 1.8*20
  1.  ......W U_$G(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS",BARACNT))
  1.  Q
  1. HDB ; EP
  1.  ;Page & column hdr
  1.  ;EP for writing Rpt Hdr
  1.  W $$EN^BARVDF("IOF"),!
  1.  I $D(BAR("PRIVACY")) W ?($S($D(BAR(132)):34,$D(BAR(180)):68,1:8)),"WARNING: Confidential Patient Information, Privacy Act Applies",!
  1.  K BAR("LINE")
  1.  S $P(BAR("LINE"),"=",$S($D(BAR(133)):132,$D(BAR(180)):181,1:81))=""
  1.  W BAR("LINE"),!
  1.  W BAR("HD",0),?$S($D(BAR(132)):102,$D(BAR(180)):150,1:51)
  1.  D NOW^%DTC
  1.  S Y=%
  1.  X ^DD("DD")
  1.  W $P(Y,":",1,2)
  1.  S BAR("TMPLVL")=0
  1.  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"))
  1.  W !,BAR("LINE")
  1.  K BAR("LINE")
  1.  Q
  1.  ;start old bar*1.8*23 IHS/SD/POT
  1.  ;R ;;MEDICARE;;MEDICARE FI
  1.  ;D ;;MEDICAID;;MEDICAID FI
  1.  ;F ;;PRIVATE INSURANCE;;FRATERNAL ORGANIZATION
  1.  ;P ;;PRIVATE INSURANCE;;PRIVATE INSURANCE
  1.  ;H ;;PRIVATE INSURANCE;;HMO
  1.  ;M ;;PRIVATE INSURANCE;;MEDICARE SUPPL.
  1.  ;N ;;OTHER;;NON-BENEFICIARY (NON-INDIAN)
  1.  ;I ;;OTHER;;INDIAN PATIENT
  1.  ;W ;;OTHER;;WORKMEN'S COMP
  1.  ;C ;;OTHER;;CHAMPUS
  1.  ;K ;;MEDICAID;;CHIP (KIDSCARE)
  1.  ;T ;;PRIVATE INSURANCE;;THIRD PARTY LIABILITY
  1.  ;G ;;OTHER;;GUARANTOR
  1.  ;MD ;;MEDICARE;;MCR PART D
  1.  ;MH ;;MEDICARE;;MEDICARE HMO
  1.  ;end old start new bar*1.8*23 IHS/SD/POT
  1. H ;;PRIVATE INSURANCE;;HMO
  1. M ;;PRIVATE INSURANCE;;MEDICARE SUPPL.
  1. D ;;MEDICAID;;MEDICAID FI
  1. R ;;MEDICARE;;MEDICARE FI
  1. P ;;PRIVATE INSURANCE;;PRIVATE INSURANCE
  1. W ;;OTHER;;WORKMEN'S COMP
  1. C ;;OTHER;;CHAMPUS
  1. N ;;OTHER;;NON-BENEFICIARY (NON-INDIAN)
  1. I ;;OTHER;;INDIAN PATIENT
  1. K ;;MEDICAID;;CHIP (KIDSCARE)
  1. T ;;OTHER;;THIRD PARTY LIABILITY 
  1. G ;;OTHER;;GUARANTOR
  1. MD ;;MEDICARE;;MCR PART D
  1. MH ;;MEDICARE;;MEDICARE HMO
  1. MMC ;;MEDICARE;;MCR MANAGED CARE
  1. TSI ;;OTHER;;TRIBAL SELF INSURED
  1. SEP ;;OTHER;;STATE EXCHANGE PLAN
  1. FPL ;;MEDICAID;;FPL 133 PERCENT
  1. MC ;;MEDICARE;;MCR PART C
  1. F ;;PRIVATE INSURANCE;;FRATERNAL ORGANIZATION
  1. V ;;VETERAN;;VETERANS MEDICAL BENEFITS
  1.  ;end new bar*1.8*23 IHS/SD/POT
  1.  ;EOR - IHS/DIT/CPC 1.8*28