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

BARTRNS1.m

Go to the documentation of this file. 
  1. BARTRNS1 ; 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) - 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.  Q
  1. COMPUTE ; EP
  1.  S BAR("SUBR")="BAR-TRANS"
  1.  K ^TMP($J,"BAR-TRANS")
  1.  K ^TMP($J,"BAR-TRANST")
  1.  I BAR("LOC")="BILLING" D LOOP Q
  1.  S BARDUZ2=DUZ(2)
  1.  S DUZ(2)=0
  1.  S BARY("DT",3)=BARY("DT",2)+.99
  1.  F  S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2)  D LOOP
  1.  S DUZ(2)=BARDUZ2
  1.  Q
  1. LOOP ;EP for Loop thru Bill File
  1.  S BARP("DT")=BARY("DT",1)-1+.9  ;PKD 9/24/10 1.8*19 don't go back extra day
  1.  ;PKD 1.8*19 BARY("DT",3) - corrected end date
  1.  ;F  S BARP("DT")=$O(^BARBL(DUZ(2),"AG",BARP("DT"))) Q:'BARP("DT")!(BARP("DT")>BARY("DT",2))  D
  1.  F  S BARP("DT")=$O(^BARBL(DUZ(2),"AG",BARP("DT"))) Q:'BARP("DT")!(BARP("DT")>BARY("DT",3))  D
  1.  .S BARIEN=0
  1.  .F  S BARIEN=$O(^BARBL(DUZ(2),"AG",BARP("DT"),BARIEN)) Q:'BARIEN  D
  1.  ..;get bill info
  1.  ..S BAR(0)=$G(^BARBL(DUZ(2),BARIEN,0))  ;A/R Bill 0 node
  1.  ..S BAR(1)=$G(^BARBL(DUZ(2),BARIEN,1))  ;A/R Bill 1 node
  1.  ..S BAR("LOC")=$P(BAR(1),U,8)  ;Visit loc (A/R Parent/Sat)
  1.  ..S BAR("INS")=$P(BAR(0),U,3)  ;A/R Acct
  1.  ..S BAR("DOS")=$P(BAR(1),U,2)  ;DOS Begin
  1.  ..S BAR("APPDT")=$P(BAR(0),U,18)  ;3P Appr. date
  1.  ..S BAR("BAMT")=$P(BAR(0),U,13)  ;total bill amt
  1.  ..I BAR("INS")]"" D
  1.  ...S D0=BAR("INS")
  1.  ...S BAR("ITYP")=$$VALI^BARVPM(8)  ;Ins Typ
  1.  ..;PKD 1.8*19 12/29/10 - shouldn't happen - no A/R acct for bill
  1.  ..I BAR("INS")="" S BAR("INS")=0
  1.  ..I $D(BARY("ITYP")),$G(BARY("ITYP"))'=BAR("ITYP") Q  ;look for specific ins typ
  1.  ..I $D(BARY("LOC")),$G(BARY("LOC"))'=BAR("LOC") Q  ;look for specific loc and this isn't it
  1.  ..I $D(BARY("ARACCT")),'$D(BARY("ARACCT",BAR("INS"))) Q  ;not the a/r acct we want
  1.  ..;I $G(BAR("ITYP"))="" S BAR("BI")="No Billing Entity"  ;bar*1.8*20 pkd <undef> correction
  1.  ..I $G(BAR("ITYP"))="" S BAR("ITYP")="No Billing Entity"  ;bar*1.8*20 pkd <undef> correction
  1.  ..I BAR("ITYP")'="No Billing Entity" D
  1.  ...S BAR("ALL")="O"  ;Other Allow Cat
  1.  ...I BAR("ITYP")="G" S BAR("ALL")="O" Q
  1.  ...I BAR("ITYP")="R"!(BAR("ITYP")="MD")!(BAR("ITYP")="MH") S BAR("ALL")="R" Q  ;Mcr Allow Cat
  1.  ...I BAR("ITYP")="D" S BAR("ALL")="D" Q  ;Mcd Allow Cat
  1.  ...I BAR("ITYP")="K" S BAR("ALL")="D" Q  ;CHIPS is lumped w/Mcd
  1.  ...;PKD 1.8*19 "T"=3RD PARTY BILL -NO LONGER 'Private' per Adrian 12/29/10
  1.  ...;I ",F,M,H,P,T,"[(","_BAR("ITYP")_",") S BAR("ALL")="P" Q  ;Pvt
  1.  ...;start old bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
  1.  ...;I ",F,M,H,P,"[(","_BAR("ITYP")_",") S BAR("ALL")="P" Q  ;Pvt
  1.  ...;I ",V,"[(","_BAR("ITYP")_",") S BAR("ALL")="V" Q  ;bar*1.8*23 IHS/SD/POT
  1.  ...;end old start new bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
  1.  ...I ",R,MD,MH,MC,MMC,"[(","_BAR("ITYP")_",") S BAR("ALL")="R" Q  ;MCR
  1.  ...I ",D,K,FPL,"[(","_BAR("ITYP")_",") S BAR("ALL")="D" Q  ;MCD
  1.  ...I ",F,M,H,P,"[(","_BAR("ITYP")_",") S BAR("ALL")="P" Q  ;PVT
  1.  ...I ",V,"[(","_BAR("ITYP")_",") S BAR("ALL")="V" Q  ;VA
  1.  ...;end new bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
  1.  ..I $G(BAR("ALL"))=""  S BAR("ALL")="No Allowance Category"
  1.  ..I $D(BARY("ALL")),(+BARY("ALL")=BARY("ALL")) S BARY("ALL")=$$CONVERT^BARRSL2(BARY("ALL"))
  1.  ..I $D(BARY("ALL")),BARY("ALL")'=BAR("ALL") Q  ;Not chosen Allow Cat
  1.  ..;
  1.  ..S BARBILL=$P($G(^BARBL(DUZ(2),BARIEN,0)),U)
  1.  ..I BARY("RTYP")=1 D
  1.  ...S $P(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")),U)=+$P($G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))),U)+1
  1.  ...S $P(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")),U,2)=+$P($G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))),U,2)+$G(BAR("BAMT"))
  1.  ..;NEED TO ADD CHECK FOR INS TYPE
  1.  ..D TRANS  ;trans info for bill
  1.  Q
  1. TRANS ;EP Loop thru Trans File
  1.  S BARTR=0
  1.  F  S BARTR=$O(^BARTR(DUZ(2),"AC",BARIEN,BARTR)) Q:'BARTR  D
  1.  .;for checking Trans File data parms
  1.  .S BARTR(0)=$G(^BARTR(DUZ(2),BARTR,0))  ;A/R Trans 0 node
  1.  .S BARTR(1)=$G(^BARTR(DUZ(2),BARTR,1))  ;A/R Trans 1 node
  1.  .S BARTR("TTYP")=$P(BARTR(1),U)  ;Trans type
  1.  .S BARTR("ADJ CAT")=$P(BARTR(1),U,2)  ;Adj Cat
  1.  .S BARTR("ADJ TYPE")=$$GET1^DIQ(90052.02,$P(BARTR(1),U,3),.01)  ;Adj Type
  1.  .;PKD 1.8*19 include ADJ TYPE IEN on rpt -> BARTR("ADJ TYPIEN")
  1.  .S BARTR("ADJ TYPIEN")=$P(BARTR(1),U,3)
  1.  .S:BARTR("ADJ CAT")="" BARTR("ADJ CAT")="NULL"
  1.  .;1.8*19 Use space if ADJ TYP IEN is null to prevent subscript error
  1.  .;S:(BARTR("ADJ TYPE")="") BARTR("ADJ TYPE")="NULL"
  1.  .I BARTR("ADJ TYPE")="" S BARTR("ADJ TYPE")="NULL",BARTR("ADJ TYPIEN")=" "
  1. ADJTY .I $D(BARY("ADJ TYP")) Q:'$D(BARY("ADJ TYP",BARTR("ADJ TYPIEN")))  ;PKD 1.8*20 Check for Inclusion ADJ TYPE
  1.  .S BARTR("DT")=$P(BARTR(0),U)  ;Trans date/time
  1.  .S BARTR("TAMT")=$$GET1^DIQ(90050.03,BARTR,3.5)
  1.  .S BARTR("INS")=$P(BAR(0),U,3)  ;A/R Acct
  1.  .I BARTR("INS")]"" D
  1.  ..S D0=BARTR("INS")
  1.  ..S BARTR("ITYP")=$$VALI^BARVPM(8)  ;Ins Type
  1.  .I BARY("RTYP")=1 D SUMMARY
  1.  .I BARY("RTYP")=2 D DETAIL
  1.  Q
  1. SUMMARY ;left of the "=" - LOC^INS TYPE^INSURER
  1.  ;right of the "=" - BILL COUNT^TOTAL BILL AMT^TOTAL PYMTS^ADJ TYPE^TOTAL ADJS
  1.  ;***PKD 1.8*19 adding "ADJ TYPIEN" before ADJ TYPE for sort 
  1.  ;***& splitting long lines for SAC and clarity in reading
  1.  ;update: bill count; total bill amount ;total pymts
  1.  ;1.8*19 Lines too long w/out change - Line body must not exceed 245 characters
  1.  I BARTR("TTYP")=40 D
  1.  .S $P(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")),U,3)=+$P($G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))),U,3)+$G(BARTR("TAMT"))
  1.  ;I BARTR("TTYP")=43 D  ;bar*1.8*20
  1.  I BARTR("TTYP")=43!(BARTR("TTYP")=993) D  ;bar*1.8*20
  1.  .I +$P($G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))),U,3)=0 S $P(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")),U,3)=0
  1.  .N NODE
  1.  .;bar*1.8*22 SDR put back old NOHEAT
  1.  .S NODE=$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BARTR("ADJ TYPIEN"),BARTR("ADJ TYPE")))  ;total adjs  bar*1.8*20
  1.  .;S NODE=$G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BARTR("ADJ TYPIEN")_" "_BARTR("ADJ TYPE")))  ;total adjs  bar*1.8*20
  1.  .S $P(NODE,U)=$P(NODE,U)+$G(BARTR("TAMT"))
  1.  .;bar*1.8*22 SDR put back old NOHEAT
  1.  .S $P(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BARTR("ADJ TYPIEN"),BARTR("ADJ TYPE")),U)=NODE  ;bar*1.8*20
  1.  .;S $P(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BARTR("ADJ TYPIEN")_" "_BARTR("ADJ TYPE")),U)=NODE  ;bar*1.8*20
  1.  Q
  1.  ;oldTag***  SUMMARY ;left of the "=" - LOC^INS TYPE^INSURER
  1.  Q
  1.  I BARTR("TTYP")=40 D
  1.  .S $P(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")),U,3)=+$P($G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))),U,3)+$G(BARTR("TAMT"))
  1.  ;total adjs
  1.  I BARTR("TTYP")=43 D
  1.  .I +$P($G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))),U,3)=0 S $P(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")),U,3)=0
  1.  .S $P(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BARTR("ADJ TYPE")),U)=+$P($G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"),"ADJS",BARTR("ADJ TYPE"))),U)+$G(BARTR("TAMT"))  ;total adjs
  1.  Q
  1.  ;
  1. DETAIL ;left of the "=" - LOC^ALLOW CAT^INS TYPE^INSURER^BILL
  1.  ;right of the "=" - DOS^APPROVAL DT^TOTAL BILL AMT^TOTAL PYMTS^# DAYS (DOS-APPR.DT)
  1.  ; if adj
  1.  ;right of the "=" - ADJ DT^ADJ TYPE^ADJ AMT^#DAYS (APPR.DT-ADJ.DT)
  1.  S $P(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL),U)=$$SDT^BARDUTL(BAR("DOS"))
  1.  S $P(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL),U,2)=$$CDT^BARDUTL(BAR("APPDT"))
  1.  S $P(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL),U,3)=BAR("BAMT")
  1.  ;# of days between appr. date & DOS
  1.  S X1=BAR("APPDT")
  1.  S X2=BAR("DOS")
  1.  D ^%DTC
  1.  S $P(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL),U,5)=X
  1.  ;
  1.  I BARTR("TTYP")=40 D
  1.  .S $P(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL),U,4)=$P(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL),U,4)+BARTR("TAMT")
  1.  ;I BARTR("TTYP")=43 D  ;bar*1.8*20
  1.  I BARTR("TTYP")=43!(BARTR("TTYP")=993) D  ;bar*1.8*20
  1.  .S BAR(BARBILL)=+$G(BAR(BARBILL))+1
  1.  .;# of days between appr. date & adj date
  1.  .S X1=+BARTR("DT")
  1.  .S X2=BAR("APPDT")
  1.  .D ^%DTC
  1.  .;S $P(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS",+$G(BAR(BARBILL))),U,4)=X  ;bar*1.8*20
  1.  .;PKD 1.8*19 Add  "ADJ TYPIEN" to sort
  1.  .N NODE
  1.  .S $P(NODE,U)=$$CDT^BARDUTL(BARTR("DT"))
  1.  .;S $P(NODE,U,2)=BARTR("ADJ TYPE")_" "_$J(BARTR("ADJ TYPIEN"),4) move to right side
  1.  .;start old bar*1.*22 NOHEAT
  1.  .;S $P(NODE,U,2)=$J(BARTR("ADJ TYPIEN"),4)_" "_BARTR("ADJ TYPE")
  1.  .;S $P(NODE,U,3)=BARTR("TAMT")
  1.  .;end old start new
  1.  .S $P(NODE,U,2)=BARTR("ADJ TYPIEN")
  1.  .S $P(NODE,U,3)=BARTR("ADJ TYPE")
  1.  .S $P(NODE,U,4)=BARTR("TAMT")
  1.  .;end new
  1.  .S $P(NODE,U,5)=X ;ADDING MISSING DATE  ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
  1.  .S ^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS",+$G(BAR(BARBILL)))=NODE
  1.  .;S $P(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS",+$G(BAR(BARBILL))),U)=$$CDT^BARDUTL(BARTR("DT"))
  1.  .;S $P(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS",+$G(BAR(BARBILL))),U,2)=BARTR("ADJ TYPE")
  1.  .;S $P(^TMP($J,"BAR-TRANS",BAR("LOC"),BAR("ITYP"),BAR("INS"),BARBILL,"ADJS",+$G(BAR(BARBILL))),U,3)=BARTR("TAMT")
  1.  .; END 1.8*19
  1.  Q
  1. PRINT ;
  1.  D PRINT^BARTRNS4  ;bar*1.8*28 IHS/SD/SDR split routine to BARTRNS4 due to size
  1.  Q
  1.  ;EOR - IHS/DIT/CPC 1.8*28