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