BARRADJ2 ; IHS/SD/TPF - TRANSACTION/ADJUSTMENT REPORT ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**6,7,19,20,21,23,24**;OCT 26, 2005;Build 69
; IHS/SD/POT 03/20/12 HEAT60464 FIXING INITIAL VALUE OF DSRCTOT ;BAR*1.8*23
; IHS/SD/POT 03/19/13 HEAT107110 FIXING TOTALS ;BAR*1.8*23
; IHS/SD/POT 01/15/14 HEAT124730 ADDING DOS TO REPORT ;BAR*1.8*24
; IHS/SD/POT 02/18/14 HEAT153046 FIXING TOTALS (COLUMN TRANSACTIONS) ;BAR*1.8*24
Q
;
DETAIL ; EP
N BARBILL,BARBILLO ;BAR*1.8*6
; Print Detail
N TT S TT=$O(BARY("TRANS TYPE",""))
;TT = 40 FOR PAYMENT TRANSACTION TYPE
;AND 43 FOR AN ADJUST ACCOUNT
;AND 993 FOR 'STATUS CHANGE' TRANSACTION TYPE ;bar*1.8*19*ADD*TMM
I 'TT W !!,"TRANSACTION TYPE PARAMETER MUST BE DEFINED!" H 2 Q
I 'SUMMARY D
. S BAR("COL")="W !,""Bill"",?15,""Transaction"",?26,"""",?45,""Amount"",?56,""Transaction"""_$S(TT=40:"",1:",?69,""Adjustment""")
. I TT=40 S BAR("COL")=BAR("COL")_",?75,""DOS""" ;P.OTT HEAT#124730
. S BAR("COL",0)="W !,""Number"",?19,""Date"",?32,""Insurer"",?45,""Billed"",?59,""Amount"""_$S(TT=40:"",1:",?73,""Type""")
. I TT'=40 S BAR("COL",1)="W !?19,""DOS""" ;P.OTT HEAT#124730
. S BAR("HD",0)="DETAIL Transaction"_$P(BAR("HD",0),"Transaction",2,99)
E D
.S BAR("COL")="W !,"""",?15,"""",?32,""Bill"",?45,""Amount"",?56,""Transaction"",?69,"""""
.S BAR("COL",0)="W !,"""",?5,""Insurer"",?32,""Count"",?45,""Billed"",?59,""Amount"",?73,"""""
.S BAR("HD",0)="SUMMARY Transaction"_$P(BAR("HD",0),"Transaction",2,99)
D:'BARTEXT HDB ;Page and column header
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAR("F1")=1 ;bar*1.8*19*ADD*TMM
Q:$G(BAR("F1")) ;bar*1.8*19*ADD*TMM
;INITIALIZE TOTALS
K VLOCTTOT,TRANTTOT,ADJTTTOT,SORTTTOT,ARTTOT
S TOTBILLS=0 ;BILL COUNT
S GRANBILL=0 ;BILL AMT GRAND TOT
S GRANTRAN=0 ;TRANS AMT GRAND TOT
S DSRCTOT=0 ;HEAT#60464 FIXING INITIAL VALUE OF DSRCTOT
;
K I,Y,X
S BARDASH=" ---------- ----------"
S BAREQUAL=" ========== =========="
S BAR("AR")="" ;Initialize A/R Clerk (1)
S BAR("L")="" ;Initialize location (2)
S BAR("TRANS")="" ;Initialize transaction (3)
S BAR("B")="" ;Initialize Batch (3)
S BAR("IT")="" ;Initialize Item (4)
S BAR("SORT")="" ;Initialize sort (5)
S BAR("ACCT")="" ;Initialize A/R account (6)
S BAR("ADJCAT")=""
S BAR("OINS")="" ;OLD INSURER
S BAR("O11")="" ;OLD INS IEN
S BARTR("DATA SRC")=""
S BARPREV="BEGIN"
S BAR("Z")="TMP("_$J_",""BAR-TSR"""
S BAR="^"_BAR("Z")_")"
I '$D(@BAR) D Q ;No data, message, quit
. W $$CJ^XLFSTR("*** NO DATA TO PRINT FOR "_$P($G(^DIC(4,DUZ(2),0)),U)_" ***",IOM)
. D EOP^BARUTL(0)
. I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAR("F1")=1 Q ;IHS/SD/AR 1.8*19
S BARBILLO="" ;BAR*1.8*6
F S BAR=$Q(@BAR) Q:BAR[("BAR-TSRS") D Q:$G(BAR("F1"))
. ;OLD CODE I $Y>(IOSL-5) D HD Q:$G(BAR("F1")) D SUBHD ;
. I 'BARTEXT I $Y>(IOSL-5) D HD Q:$G(BAR("F1")) D SUBHD ;4/1/14 BAR*1.8*24 (NO PAGING)
.S BAR("TXT")=$P($P(BAR,",",4,99),"""",2)
.S BAR("TXT")=$P(BAR,",",3)_U_BAR("TXT") ;Subscript
.S BAR("TXTO")=BAR("TXT") ;NOW THIS IS THE SAME ORDER AS IN ^BARRADJ
.;THIS NEXT LINE TAKES DUZ(2) AND STICKS IT AT THE END OF THE STRING?
.S BAR("TXT")=$P(BAR("TXTO"),U)_U_$P(BAR("TXTO"),U,3,99)_U_$P(BAR("TXTO"),U,2)
.S BAR("NODE")=@BAR ;Data
.S BARBILL=$P(BAR("TXT"),U,7) ;BAR*1.8*6
.S BAR(1)=$P(BAR("NODE"),U) ;Bill number
.S BAR(2)=$P(BAR("NODE"),U,2) ;PAY-AMT
.S BAR(3)=$P(BAR("NODE"),U,3) ;PRV-CRD
.S BAR(4)=$P(BAR("NODE"),U,4) ;Refund
.S BAR(5)=$P(BAR("NODE"),U,5) ;Payment
.S BAR(6)=$P(BAR("NODE"),U,6) ;Bill Amount
.S BAR(7)=$P(BAR("NODE"),U,7) ;Adjustment
.S BAR(8)=$P(BAR("NODE"),U,8) ;transaction type
.S BAR(9)=$P(BAR("NODE"),U,9) ;insurer
.S BAR(10)=$P(BAR("NODE"),U,10) ;transaction date
.S BAR(11)=$P(BAR("NODE"),U,11) ;A/R ACCT PTR (INSURER PTR)
.S BAR(12)=$P(BAR("NODE"),U,12) ;Adjustment category
.S BAR(13)=$P(BAR("NODE"),U,13) ;Adjustment Type
.I BARTEXT D
..Q:$L(BAR("NODE"),U)<10
..N BARDLMTD
..S BARDLMTD("CLINICVISIT")="NONE"
..S BARDLMTD("VISIT")=$P(BAR("TXT"),U,2)
..I BARY("SORT")="C" D
...I $P(BAR("TXT"),U,6)=99999 S BARDLMTD("CLINICVISIT")="NO CLINIC" ;bar*1.8*21 SDR
...S BARDLMTD("CLINICVISIT")=$P(^DIC(40.7,$P(BAR("TXT"),U,6),0),U) ;bar*1.8*21 SDR
..I BARY("SORT")="V" D
...I $P(BAR("TXT"),U,6)=99999 S BARDLMTD("CLINICVISIT")="NO VISIT TYPE" ;bar*1.8*21 SDR
...S BARDLMTD("CLINICVISIT")=$P($G(^ABMDVTYP($P(BAR("TXT"),U,6),0)),U) ;bar*1.8*21 SDR
..S BARDLMTD("BILLNUM")=BAR(1)
..S BARDLMTD("DOS")=$$GETDOS(BARBILL) ;P.OTT HEAT#124730
..S BARDLMTD("TRANSDATE")=BAR(10)
..S BARDLMTD("INSURER")=BAR(9)
..S BARDLMTD("BILLAMT")=$FN(BAR(6),",",2)
..S BARDLMTD("TRXNAMT")=$FN(BAR(3)+BAR(4)+BAR(5)+BAR(7),",",2)
..I $D(BARY("TRANS TYPE",43))!$D(BARY("TRANS TYPE",993)) D ;M819*ADD*TMM
...I '$P(BAR("TXT"),U,3) S BARDLMTD("ADJCAT")=$P(BAR("TXT"),U,3)
...E S BARDLMTD("ADJCAT")=$$GET1^DIQ(90052.01,$P(BAR("TXT"),U,3)_",",.01,"E")
...S BARDLMTD("ADJTYPE")=$E($$GET1^DIQ(90052.02,BAR(12)_",",.01),1,12)
... ;IHS/SD/POT BAR*1.8*24 ADDED DOS
... ;W:BARY("SORT")="N" !,BARDLMTD("VISIT")_U_BARDLMTD("ADJCAT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")_U_BARDLMTD("ADJTYPE")
... ;W:BARY("SORT")'="N" !,BARDLMTD("VISIT")_U_BARDLMTD("CLINICVISIT")_U_BARDLMTD("ADJCAT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")_U_BARDLMTD("ADJTYPE")
... W:BARY("SORT")="N" !,BARDLMTD("VISIT")_U_BARDLMTD("ADJCAT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("DOS")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")_U_BARDLMTD("ADJTYPE")
... W:BARY("SORT")'="N" !,BARDLMTD("VISIT")_U_BARDLMTD("CLINICVISIT")_U_BARDLMTD("ADJCAT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("DOS")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")_U_BARDLMTD("ADJTYPE")
..E D
... ;IHS/SD/POT BAR*1.8*24 ADDED DOS
... ;W:BARY("SORT")="N" !,BARDLMTD("VISIT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")
... ;W:BARY("SORT")'="N" !,BARDLMTD("VISIT")_U_BARDLMTD("CLINICVISIT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")
...W:BARY("SORT")="N" !,BARDLMTD("VISIT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("DOS")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")
...W:BARY("SORT")'="N" !,BARDLMTD("VISIT")_U_BARDLMTD("CLINICVISIT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("DOS")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")
.Q:BARTEXT
.I BARPREV="BEGIN" D
..S BARPREV=BAR(12)
.E D
..I BARPREV'=BAR(12),$D(BARY("TRANS TYPE",43))!$D(BARY("TRANS TYPE",993)) D ;M819*ADD*TMM
...S BARPREV=BAR(12)
...D SUBTYPE
.I $D(BARY("AR")),BAR("AR")'=$P(BAR("TXT"),U) D
..S BAR("L")=""
..D SUBHD
.S BAR("AR")=$P(BAR("TXT"),U)
.;
.I BAR("L")'=$P(BAR("TXT"),U,2) D
..I BAR("L")]"" D
...I SUMMARY D GETCOUNT
...Q:$G(BAR("F1"))
...W !,BARDASH
...D SUBLOC
...W !
..W !?1,"Visit Location.......: ",$P(BAR("TXT"),U,2)
..S (BAR("TRANS"))=""
..S (TRANBTOT,TRANTTOT)=0
.S BAR("L")=$P(BAR("TXT"),U,2)
.;
.I BAR("TRANS")'=$P(BAR("TXT"),U,3) D
..I BAR("TRANS")]"" D
...Q:$G(BAR("F1"))
...I SUMMARY D GETCOUNT
...W !,BARDASH
...D SUBTRAN
...W !
..I $D(BARY("TRANS TYPE",43)) W !?5,"Adjustment Category.......: "
..I $D(BARY("TRANS TYPE",993)) W !?5,"Adjustment Category.......: " ;M819*ADD*TMM
..I '$P(BAR("TXT"),U,3) W $P(BAR("TXT"),U,3)
..E D
...I $D(BARY("TRANS TYPE",43))!$D(BARY("TRANS TYPE",993)) W $$GET1^DIQ(90052.01,$P(BAR("TXT"),U,3)_",",.01,"E") ;M819*ADD*TMM
...E W $$GET1^DIQ(90052.02,$P(BAR("TXT"),U,3)_",",.01,"E")
.S BAR("TRANS")=$P(BAR("TXT"),U,3)
.I BAR("SORT")'=$P(BAR("TXT"),U,6) D
..I BAR("SORT")]"" D
...Q:$G(BAR("F1"))
...I SUMMARY D GETCOUNT
...W !,BARDASH
...D SUBSORT
...W !
..I BARTR("DATA SRC")'=$P(BAR("TXT"),U,5) D
...I BARTR("DATA SRC")]"" D
....I SUMMARY D GETCOUNT
....Q:$G(BAR("F1"))
....W !,BARDASH
....D SUBDSRC
....W !
...W !?10,"Data Source..........: ",$S($P(BAR("TXT"),U,5)="e":"ELECTRONIC",1:"MANUAL")
..S BARTR("DATA SRC")=$P(BAR("TXT"),U,5)
..I BARY("SORT")="C" D
...W !?10,"Clinic Type..........: "
...I $P(BAR("TXT"),U,6)=99999 W "NO CLINIC" Q
...W $P(^DIC(40.7,$P(BAR("TXT"),U,6),0),U),!
..I BARY("SORT")="V" D
...W !?10,"Visit Type...........: "
...I $P(BAR("TXT"),U,6)=99999 W "NO VISIT TYPE" Q
...W $P($G(^ABMDVTYP($P(BAR("TXT"),U,6),0)),U),!
.S BAR("SORT")=$P(BAR("TXT"),U,6)
.I 'SUMMARY W !,$E(BAR(1),1,15) ; A/R Bill ;BAR*1.8*1 item 1 page 12
.I 'SUMMARY W ?15,BAR(10) ;TRANS DATE
.I SUMMARY S OFFSET=10
.E S OFFSET=27
.I $L($E(BAR(9),1,15))<15 D
..K FILL
..S $P(FILL," ",16-$L(BAR(9)))=""
..W:'SUMMARY ?OFFSET,$E(BAR(9),1,15)_FILL
.E W:'SUMMARY ?OFFSET,$E(BAR(9),1,15) ;INSURER
.I 'SUMMARY D
..Q:BARBILL=BARBILLO
..W ?41,$J($FN(BAR(6),",",2),10) ; Bill Amt
.I 'SUMMARY W ?55,$J($FN(BAR(3)+BAR(4)+BAR(5)+BAR(7),",",2),10) ;GET ALL ADJS
.I 'SUMMARY W $P(BAR("TXT"),U,5)
.I 'SUMMARY,'$D(BARY("TRANS TYPE",40)) W ?67,$E($$GET1^DIQ(90052.02,BAR(12)_",",.01),1,12) ;ADJ TYPE
. S BARDOS=$$GETDOS(BARBILL) ;P.OTT HEAT#124730
. I 'SUMMARY I TT=40 W ?69,BARDOS
. I 'SUMMARY I TT'=40 W !?15,BARDOS ;P.OTT
.;ADD THE SUBTOTALS ONLY IFA NEW BILL. AND DON'T ADD IF THE BILL AMT FOR A BILL HAS ALREADY BEEN COUNTED
.I BARBILL'=BARBILLO D
.. S VLOCBTOT=$G(VLOCBTOT)+BAR(6)
.. S TRANBTOT=$G(TRANBTOT)+BAR(6)
.. S ADJTBTOT=$G(ADJTBTOT)+BAR(6)
.. S SORTBTOT=$G(SORTBTOT)+BAR(6)
.. S ARBTOT=$G(ARBTOT)+BAR(6)
.. S DSRCBTOT=$G(DSRCBTOT)+BAR(6)
.. S BARBILLO=BARBILL
.. ;following 2 lines moved from bottom p.ott HEAT 107110
.. S GRANBILL=GRANBILL+BAR(6) ;p.ott
.. ;;;S GRANTRAN=GRANTRAN+BAR(3)+BAR(4)+BAR(5)+BAR(7) ;p.ott LINE DEATIVATED 2/18/2014 HEAT 153046
. S VLOCTTOT=$G(VLOCTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7) ;WAS ADDING BAR(2)
. S TRANTTOT=$G(TRANTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7)
. S ADJTTTOT=$G(ADJTTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7)
. S SORTTTOT=$G(SORTTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7)
. S ARTTOT=$G(ARTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7)
. S DSRCTTOT=$G(DSRCTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7)
. ;S GRANBILL=GRANBILL+BAR(6) ;p.ott 2 lines taken from here UP 107110 FIXING TOTALS
. S GRANTRAN=GRANTRAN+BAR(3)+BAR(4)+BAR(5)+BAR(7) ;LINE ACTIVATED 2/18/2014 HEAT 153046
Q:$G(BAR("F1"))!BARTEXT
I SUMMARY D GETCOUNT
W !,BARDASH
D SUBSORT ;2 LINES SWAPPED 107110 FIXING TOTALS ; Totals by Sort type
D SUBDSRC ; Totals by Data Source
W ! D SUBTRAN
W ! D SUBLOC
D TOT
Q
HD ; EP
D PAZ^BARRUTL
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAR("F1")=1 Q
HDB ; EP
; Page and column header
S BAR("PG")=BAR("PG")+1
S BAR("I")=""
D WHD^BARRHD ; Report header
X BAR("COL")
X BAR("COL",0)
I $G(BAR("COL",1))]"" X BAR("COL",1) ;P.OTT
S $P(BAR("DASH"),"=",$S($D(BAR(132)):132,1:80))=""
W !,BAR("DASH")
Q
SUBHD ;
; If A/R clerk specified
Q:'$D(BARY("AR"))
Q:'+$P(BAR("TXT"),U)
W !!,"A/R Entry Clerk: ",$P(^VA(200,$P(BAR("TXT"),U),0),U)
Q
SUBTRAN ;EP - TOTALS BY TRANSACTION TYPE
I $D(BARY("TRANS TYPE",40)) W !?10,"Totals by Transaction type:"
E W !?10,"Totals by Adjustment Category:"
W ?42,$J($FN(TRANBTOT,",",2),10)
W ?55,$J($FN(TRANTTOT,",",2),10)
S (TRANBTOT,TRANTTOT)=0
Q
SUBLOC ;
; Totals by Visit location.
W !,"Location Tot:"
W ?42,$J($FN(VLOCBTOT,",",2),10)
W ?55,$J($FN(VLOCTTOT,",",2),10)
S (VLOCBTOT,VLOCTTOT)=0
Q
SUBADJ ;
; Totals by adjustment category
W !,"Adjustment Category Tot:"
W ?41,$J($FN(ADJTBTOT,",",2),10)
W ?55,$J($FN(ADJTTTOT,",",2),10)
S (ADJTBTOT,ADJTTTOT)=0
Q
SUB2 ;
; Totals by Collection Batch
Q
Q:'BAR("BTOT2")
W !," Batch Tot:"
W ?41,$J($FN(BAR("BTOT2"),",",2),10)
W ?55,$J($FN(BAR("ATOT2"),",",2),10)
S (BAR("PATOT2"),BAR("PCTOT2"),BAR("RTOT2"),BAR("PTOT2"),BAR("BTOT2"),BAR("ATOT2"))=0
Q
SUB3 ;
Q
; Totals by Collection Batch Item
Q:'BAR("BTOT3")
W !," Item Tot:"
W ?41,$J($FN(BAR("BTOT3"),",",2),10)
W ?55,$J($FN(BAR("ATOT3"),",",2),10)
S (BAR("PATOT3"),BAR("PCTOT3"),BAR("RTOT3"),BAR("PTOT3"),BAR("BTOT3"),BAR("ATOT3"))=0
Q
;
SUBDSRC ;
; Totals by Data Source
W !?25,"Data Source Tot:"
I SUMMARY W !?5,"Subtotal:",?33,$J(DSRCTTOT,5,0) ;IHS/SD/TPF 7/27/2011 BAR*1.8*21 BUG FOUND BY ADRIAN TYPO
W ?42,$J($FN(DSRCBTOT,",",2),10)
W ?55,$J($FN(DSRCTTOT,",",2),10)
S (DSRCBTOT,DSRCTTOT)=0
Q
;
SUBSORT ;
; Totals by Sort type
;
I BARY("SORT")="C",'SUMMARY W !?25,"Clinic Tot:"
I BARY("SORT")="V",'SUMMARY W !?25,"Visit Type Tot:"
;
I BARY("SORT")'="N" D
.I SUMMARY W !?5,"Subtotal:",?33,$J(SUBTOT,5,0)
.W ?42,$J($FN(SORTBTOT,",",2),10)
.W ?55,$J($FN(SORTTTOT,",",2),10)
S (SORTBTOT,SORTTTOT)=0
Q
SUB5 ;
Q
; totals by A/R Account
Q:'BAR("BTOT5")
W !,"A/R Acct Tot:"
W ?41,$J($FN(BAR("BTOT5"),",",2),10)
W ?55,$J($FN(BAR("ATOT5"),",",2),10)
S (BAR("PATOT5"),BAR("PCTOT5"),BAR("RTOT5"),BAR("PTOT5"),BAR("BTOT5"),BAR("ATOT5"))=0
Q
TOT ;
; Report (a/r clerk) totals
W !!,BAREQUAL
I 'SUMMARY W !,"REPORT TOTAL"
E W !,"Total:"
I SUMMARY W ?33,$J($G(TOTBILLS),5,0)
W ?42,$J($FN(GRANBILL,",",2),10)
W ?55,$J($FN(GRANTRAN,",",2),10)
S BAR("ST")=1
Q
GETCOUNT ;
N BILL,INSURER
S SUBTOT=0
S SUBS=$P(BAR("TXTO"),U,1,7)
S $P(SUBS,U,7)=BAR("SORT")
S INSURER=""
F S INSURER=$O(^TMP($J,"BAR-TSRS-INS",SUBS,INSURER)) Q:INSURER="" D
.W !?5,$E($$GET1^DIQ(90050.02,INSURER_",",.01,"E"),1,25)
.S BILL=""
.F CNT=0:1 S BILL=$O(^TMP($J,"BAR-TSRS-INS",SUBS,INSURER,BILL)) Q:BILL=""
.W ?33,$J(CNT,5,0)
.S TOTBILLS=TOTBILLS+CNT
.S SUBTOT=SUBTOT+CNT
Q
SUBTYPE ;
W !,BARDASH
W !,?20,"Adjustment Type Tot:"
W ?41,$J($FN(ADJTBTOT,",",2),10)
W ?55,$J($FN(ADJTTTOT,",",2),10)
W !
S (ADJTBTOT,ADJTTTOT)=0
Q
GETDOS(BARBILL) ;
NEW X,Y
S X=$$GET1^DIQ(90050.01,BARBILL,102,"I") ;P.OTT DOS BEGIN WAS "I"
Q $$SDT^BARDUTL(X)
;EOR
BARRADJ2 ; IHS/SD/TPF - TRANSACTION/ADJUSTMENT REPORT ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,7,19,20,21,23,24**;OCT 26, 2005;Build 69
+2 ; IHS/SD/POT 03/20/12 HEAT60464 FIXING INITIAL VALUE OF DSRCTOT ;BAR*1.8*23
+3 ; IHS/SD/POT 03/19/13 HEAT107110 FIXING TOTALS ;BAR*1.8*23
+4 ; IHS/SD/POT 01/15/14 HEAT124730 ADDING DOS TO REPORT ;BAR*1.8*24
+5 ; IHS/SD/POT 02/18/14 HEAT153046 FIXING TOTALS (COLUMN TRANSACTIONS) ;BAR*1.8*24
+6 QUIT
+7 ;
DETAIL ; EP
+1 ;BAR*1.8*6
NEW BARBILL,BARBILLO
+2 ; Print Detail
+3 NEW TT
SET TT=$ORDER(BARY("TRANS TYPE",""))
+4 ;TT = 40 FOR PAYMENT TRANSACTION TYPE
+5 ;AND 43 FOR AN ADJUST ACCOUNT
+6 ;AND 993 FOR 'STATUS CHANGE' TRANSACTION TYPE ;bar*1.8*19*ADD*TMM
+7 IF 'TT
WRITE !!,"TRANSACTION TYPE PARAMETER MUST BE DEFINED!"
HANG 2
QUIT
+8 IF 'SUMMARY
Begin DoDot:1
+9 SET BAR("COL")="W !,""Bill"",?15,""Transaction"",?26,"""",?45,""Amount"",?56,""Transaction"""_$SELECT(TT=40:"",1:",?69,""Adjustment""")
+10 ;P.OTT HEAT#124730
IF TT=40
SET BAR("COL")=BAR("COL")_",?75,""DOS"""
+11 SET BAR("COL",0)="W !,""Number"",?19,""Date"",?32,""Insurer"",?45,""Billed"",?59,""Amount"""_$SELECT(TT=40:"",1:",?73,""Type""")
+12 ;P.OTT HEAT#124730
IF TT'=40
SET BAR("COL",1)="W !?19,""DOS"""
+13 SET BAR("HD",0)="DETAIL Transaction"_$PIECE(BAR("HD",0),"Transaction",2,99)
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 SET BAR("COL")="W !,"""",?15,"""",?32,""Bill"",?45,""Amount"",?56,""Transaction"",?69,"""""
+16 SET BAR("COL",0)="W !,"""",?5,""Insurer"",?32,""Count"",?45,""Billed"",?59,""Amount"",?73,"""""
+17 SET BAR("HD",0)="SUMMARY Transaction"_$PIECE(BAR("HD",0),"Transaction",2,99)
End DoDot:1
+18 ;Page and column header
IF 'BARTEXT
DO HDB
+19 ;bar*1.8*19*ADD*TMM
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAR("F1")=1
+20 ;bar*1.8*19*ADD*TMM
IF $GET(BAR("F1"))
QUIT
+21 ;INITIALIZE TOTALS
+22 KILL VLOCTTOT,TRANTTOT,ADJTTTOT,SORTTTOT,ARTTOT
+23 ;BILL COUNT
SET TOTBILLS=0
+24 ;BILL AMT GRAND TOT
SET GRANBILL=0
+25 ;TRANS AMT GRAND TOT
SET GRANTRAN=0
+26 ;HEAT#60464 FIXING INITIAL VALUE OF DSRCTOT
SET DSRCTOT=0
+27 ;
+28 KILL I,Y,X
+29 SET BARDASH=" ---------- ----------"
+30 SET BAREQUAL=" ========== =========="
+31 ;Initialize A/R Clerk (1)
SET BAR("AR")=""
+32 ;Initialize location (2)
SET BAR("L")=""
+33 ;Initialize transaction (3)
SET BAR("TRANS")=""
+34 ;Initialize Batch (3)
SET BAR("B")=""
+35 ;Initialize Item (4)
SET BAR("IT")=""
+36 ;Initialize sort (5)
SET BAR("SORT")=""
+37 ;Initialize A/R account (6)
SET BAR("ACCT")=""
+38 SET BAR("ADJCAT")=""
+39 ;OLD INSURER
SET BAR("OINS")=""
+40 ;OLD INS IEN
SET BAR("O11")=""
+41 SET BARTR("DATA SRC")=""
+42 SET BARPREV="BEGIN"
+43 SET BAR("Z")="TMP("_$JOB_",""BAR-TSR"""
+44 SET BAR="^"_BAR("Z")_")"
+45 ;No data, message, quit
IF '$DATA(@BAR)
Begin DoDot:1
+46 WRITE $$CJ^XLFSTR("*** NO DATA TO PRINT FOR "_$PIECE($GET(^DIC(4,DUZ(2),0)),U)_" ***",IOM)
+47 DO EOP^BARUTL(0)
+48 ;IHS/SD/AR 1.8*19
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAR("F1")=1
QUIT
End DoDot:1
QUIT
+49 ;BAR*1.8*6
SET BARBILLO=""
+50 FOR
SET BAR=$QUERY(@BAR)
IF BAR[("BAR-TSRS")
QUIT
Begin DoDot:1
+51 ;OLD CODE I $Y>(IOSL-5) D HD Q:$G(BAR("F1")) D SUBHD ;
+52 ;4/1/14 BAR*1.8*24 (NO PAGING)
IF 'BARTEXT
IF $Y>(IOSL-5)
DO HD
IF $GET(BAR("F1"))
QUIT
DO SUBHD
+53 SET BAR("TXT")=$PIECE($PIECE(BAR,",",4,99),"""",2)
+54 ;Subscript
SET BAR("TXT")=$PIECE(BAR,",",3)_U_BAR("TXT")
+55 ;NOW THIS IS THE SAME ORDER AS IN ^BARRADJ
SET BAR("TXTO")=BAR("TXT")
+56 ;THIS NEXT LINE TAKES DUZ(2) AND STICKS IT AT THE END OF THE STRING?
+57 SET BAR("TXT")=$PIECE(BAR("TXTO"),U)_U_$PIECE(BAR("TXTO"),U,3,99)_U_$PIECE(BAR("TXTO"),U,2)
+58 ;Data
SET BAR("NODE")=@BAR
+59 ;BAR*1.8*6
SET BARBILL=$PIECE(BAR("TXT"),U,7)
+60 ;Bill number
SET BAR(1)=$PIECE(BAR("NODE"),U)
+61 ;PAY-AMT
SET BAR(2)=$PIECE(BAR("NODE"),U,2)
+62 ;PRV-CRD
SET BAR(3)=$PIECE(BAR("NODE"),U,3)
+63 ;Refund
SET BAR(4)=$PIECE(BAR("NODE"),U,4)
+64 ;Payment
SET BAR(5)=$PIECE(BAR("NODE"),U,5)
+65 ;Bill Amount
SET BAR(6)=$PIECE(BAR("NODE"),U,6)
+66 ;Adjustment
SET BAR(7)=$PIECE(BAR("NODE"),U,7)
+67 ;transaction type
SET BAR(8)=$PIECE(BAR("NODE"),U,8)
+68 ;insurer
SET BAR(9)=$PIECE(BAR("NODE"),U,9)
+69 ;transaction date
SET BAR(10)=$PIECE(BAR("NODE"),U,10)
+70 ;A/R ACCT PTR (INSURER PTR)
SET BAR(11)=$PIECE(BAR("NODE"),U,11)
+71 ;Adjustment category
SET BAR(12)=$PIECE(BAR("NODE"),U,12)
+72 ;Adjustment Type
SET BAR(13)=$PIECE(BAR("NODE"),U,13)
+73 IF BARTEXT
Begin DoDot:2
+74 IF $LENGTH(BAR("NODE"),U)<10
QUIT
+75 NEW BARDLMTD
+76 SET BARDLMTD("CLINICVISIT")="NONE"
+77 SET BARDLMTD("VISIT")=$PIECE(BAR("TXT"),U,2)
+78 IF BARY("SORT")="C"
Begin DoDot:3
+79 ;bar*1.8*21 SDR
IF $PIECE(BAR("TXT"),U,6)=99999
SET BARDLMTD("CLINICVISIT")="NO CLINIC"
+80 ;bar*1.8*21 SDR
SET BARDLMTD("CLINICVISIT")=$PIECE(^DIC(40.7,$PIECE(BAR("TXT"),U,6),0),U)
End DoDot:3
+81 IF BARY("SORT")="V"
Begin DoDot:3
+82 ;bar*1.8*21 SDR
IF $PIECE(BAR("TXT"),U,6)=99999
SET BARDLMTD("CLINICVISIT")="NO VISIT TYPE"
+83 ;bar*1.8*21 SDR
SET BARDLMTD("CLINICVISIT")=$PIECE($GET(^ABMDVTYP($PIECE(BAR("TXT"),U,6),0)),U)
End DoDot:3
+84 SET BARDLMTD("BILLNUM")=BAR(1)
+85 ;P.OTT HEAT#124730
SET BARDLMTD("DOS")=$$GETDOS(BARBILL)
+86 SET BARDLMTD("TRANSDATE")=BAR(10)
+87 SET BARDLMTD("INSURER")=BAR(9)
+88 SET BARDLMTD("BILLAMT")=$FNUMBER(BAR(6),",",2)
+89 SET BARDLMTD("TRXNAMT")=$FNUMBER(BAR(3)+BAR(4)+BAR(5)+BAR(7),",",2)
+90 ;M819*ADD*TMM
IF $DATA(BARY("TRANS TYPE",43))!$DATA(BARY("TRANS TYPE",993))
Begin DoDot:3
+91 IF '$PIECE(BAR("TXT"),U,3)
SET BARDLMTD("ADJCAT")=$PIECE(BAR("TXT"),U,3)
+92 IF '$TEST
SET BARDLMTD("ADJCAT")=$$GET1^DIQ(90052.01,$PIECE(BAR("TXT"),U,3)_",",.01,"E")
+93 SET BARDLMTD("ADJTYPE")=$EXTRACT($$GET1^DIQ(90052.02,BAR(12)_",",.01),1,12)
+94 ;IHS/SD/POT BAR*1.8*24 ADDED DOS
+95 ;W:BARY("SORT")="N" !,BARDLMTD("VISIT")_U_BARDLMTD("ADJCAT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")_U_BARDLMTD("ADJTYPE")
+96 ;W:BARY("SORT")'="N" !,BARDLMTD("VISIT")_U_BARDLMTD("CLINICVISIT")_U_BARDLMTD("ADJCAT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")_U_BARDLMTD("ADJTYPE")
+97 IF BARY("SORT")="N"
WRITE !,BARDLMTD("VISIT")_U_BARDLMTD("ADJCAT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("DOS")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")_U_BARDLMTD("ADJTYPE")
+98 IF BARY("SORT")'="N"
WRITE !,BARDLMTD("VISIT")_U_BARDLMTD("CLINICVISIT")_U_BARDLMTD("ADJCAT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("DOS")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")_U_BARDLMTD("A
DJTYPE")
End DoDot:3
+99 IF '$TEST
Begin DoDot:3
+100 ;IHS/SD/POT BAR*1.8*24 ADDED DOS
+101 ;W:BARY("SORT")="N" !,BARDLMTD("VISIT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")
+102 ;W:BARY("SORT")'="N" !,BARDLMTD("VISIT")_U_BARDLMTD("CLINICVISIT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")
+103 IF BARY("SORT")="N"
WRITE !,BARDLMTD("VISIT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("DOS")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")
+104 IF BARY("SORT")'="N"
WRITE !,BARDLMTD("VISIT")_U_BARDLMTD("CLINICVISIT")_U_BARDLMTD("BILLNUM")_U_BARDLMTD("DOS")_U_BARDLMTD("TRANSDATE")_U_BARDLMTD("INSURER")_U_BARDLMTD("BILLAMT")_U_BARDLMTD("TRXNAMT")
End DoDot:3
End DoDot:2
+105 IF BARTEXT
QUIT
+106 IF BARPREV="BEGIN"
Begin DoDot:2
+107 SET BARPREV=BAR(12)
End DoDot:2
+108 IF '$TEST
Begin DoDot:2
+109 ;M819*ADD*TMM
IF BARPREV'=BAR(12)
IF $DATA(BARY("TRANS TYPE",43))!$DATA(BARY("TRANS TYPE",993))
Begin DoDot:3
+110 SET BARPREV=BAR(12)
+111 DO SUBTYPE
End DoDot:3
End DoDot:2
+112 IF $DATA(BARY("AR"))
IF BAR("AR")'=$PIECE(BAR("TXT"),U)
Begin DoDot:2
+113 SET BAR("L")=""
+114 DO SUBHD
End DoDot:2
+115 SET BAR("AR")=$PIECE(BAR("TXT"),U)
+116 ;
+117 IF BAR("L")'=$PIECE(BAR("TXT"),U,2)
Begin DoDot:2
+118 IF BAR("L")]""
Begin DoDot:3
+119 IF SUMMARY
DO GETCOUNT
+120 IF $GET(BAR("F1"))
QUIT
+121 WRITE !,BARDASH
+122 DO SUBLOC
+123 WRITE !
End DoDot:3
+124 WRITE !?1,"Visit Location.......: ",$PIECE(BAR("TXT"),U,2)
+125 SET (BAR("TRANS"))=""
+126 SET (TRANBTOT,TRANTTOT)=0
End DoDot:2
+127 SET BAR("L")=$PIECE(BAR("TXT"),U,2)
+128 ;
+129 IF BAR("TRANS")'=$PIECE(BAR("TXT"),U,3)
Begin DoDot:2
+130 IF BAR("TRANS")]""
Begin DoDot:3
+131 IF $GET(BAR("F1"))
QUIT
+132 IF SUMMARY
DO GETCOUNT
+133 WRITE !,BARDASH
+134 DO SUBTRAN
+135 WRITE !
End DoDot:3
+136 IF $DATA(BARY("TRANS TYPE",43))
WRITE !?5,"Adjustment Category.......: "
+137 ;M819*ADD*TMM
IF $DATA(BARY("TRANS TYPE",993))
WRITE !?5,"Adjustment Category.......: "
+138 IF '$PIECE(BAR("TXT"),U,3)
WRITE $PIECE(BAR("TXT"),U,3)
+139 IF '$TEST
Begin DoDot:3
+140 ;M819*ADD*TMM
IF $DATA(BARY("TRANS TYPE",43))!$DATA(BARY("TRANS TYPE",993))
WRITE $$GET1^DIQ(90052.01,$PIECE(BAR("TXT"),U,3)_",",.01,"E")
+141 IF '$TEST
WRITE $$GET1^DIQ(90052.02,$PIECE(BAR("TXT"),U,3)_",",.01,"E")
End DoDot:3
End DoDot:2
+142 SET BAR("TRANS")=$PIECE(BAR("TXT"),U,3)
+143 IF BAR("SORT")'=$PIECE(BAR("TXT"),U,6)
Begin DoDot:2
+144 IF BAR("SORT")]""
Begin DoDot:3
+145 IF $GET(BAR("F1"))
QUIT
+146 IF SUMMARY
DO GETCOUNT
+147 WRITE !,BARDASH
+148 DO SUBSORT
+149 WRITE !
End DoDot:3
+150 IF BARTR("DATA SRC")'=$PIECE(BAR("TXT"),U,5)
Begin DoDot:3
+151 IF BARTR("DATA SRC")]""
Begin DoDot:4
+152 IF SUMMARY
DO GETCOUNT
+153 IF $GET(BAR("F1"))
QUIT
+154 WRITE !,BARDASH
+155 DO SUBDSRC
+156 WRITE !
End DoDot:4
+157 WRITE !?10,"Data Source..........: ",$SELECT($PIECE(BAR("TXT"),U,5)="e":"ELECTRONIC",1:"MANUAL")
End DoDot:3
+158 SET BARTR("DATA SRC")=$PIECE(BAR("TXT"),U,5)
+159 IF BARY("SORT")="C"
Begin DoDot:3
+160 WRITE !?10,"Clinic Type..........: "
+161 IF $PIECE(BAR("TXT"),U,6)=99999
WRITE "NO CLINIC"
QUIT
+162 WRITE $PIECE(^DIC(40.7,$PIECE(BAR("TXT"),U,6),0),U),!
End DoDot:3
+163 IF BARY("SORT")="V"
Begin DoDot:3
+164 WRITE !?10,"Visit Type...........: "
+165 IF $PIECE(BAR("TXT"),U,6)=99999
WRITE "NO VISIT TYPE"
QUIT
+166 WRITE $PIECE($GET(^ABMDVTYP($PIECE(BAR("TXT"),U,6),0)),U),!
End DoDot:3
End DoDot:2
+167 SET BAR("SORT")=$PIECE(BAR("TXT"),U,6)
+168 ; A/R Bill ;BAR*1.8*1 item 1 page 12
IF 'SUMMARY
WRITE !,$EXTRACT(BAR(1),1,15)
+169 ;TRANS DATE
IF 'SUMMARY
WRITE ?15,BAR(10)
+170 IF SUMMARY
SET OFFSET=10
+171 IF '$TEST
SET OFFSET=27
+172 IF $LENGTH($EXTRACT(BAR(9),1,15))<15
Begin DoDot:2
+173 KILL FILL
+174 SET $PIECE(FILL," ",16-$LENGTH(BAR(9)))=""
+175 IF 'SUMMARY
WRITE ?OFFSET,$EXTRACT(BAR(9),1,15)_FILL
End DoDot:2
+176 ;INSURER
IF '$TEST
IF 'SUMMARY
WRITE ?OFFSET,$EXTRACT(BAR(9),1,15)
+177 IF 'SUMMARY
Begin DoDot:2
+178 IF BARBILL=BARBILLO
QUIT
+179 ; Bill Amt
WRITE ?41,$JUSTIFY($FNUMBER(BAR(6),",",2),10)
End DoDot:2
+180 ;GET ALL ADJS
IF 'SUMMARY
WRITE ?55,$JUSTIFY($FNUMBER(BAR(3)+BAR(4)+BAR(5)+BAR(7),",",2),10)
+181 IF 'SUMMARY
WRITE $PIECE(BAR("TXT"),U,5)
+182 ;ADJ TYPE
IF 'SUMMARY
IF '$DATA(BARY("TRANS TYPE",40))
WRITE ?67,$EXTRACT($$GET1^DIQ(90052.02,BAR(12)_",",.01),1,12)
+183 ;P.OTT HEAT#124730
SET BARDOS=$$GETDOS(BARBILL)
+184 IF 'SUMMARY
IF TT=40
WRITE ?69,BARDOS
+185 ;P.OTT
IF 'SUMMARY
IF TT'=40
WRITE !?15,BARDOS
+186 ;ADD THE SUBTOTALS ONLY IFA NEW BILL. AND DON'T ADD IF THE BILL AMT FOR A BILL HAS ALREADY BEEN COUNTED
+187 IF BARBILL'=BARBILLO
Begin DoDot:2
+188 SET VLOCBTOT=$GET(VLOCBTOT)+BAR(6)
+189 SET TRANBTOT=$GET(TRANBTOT)+BAR(6)
+190 SET ADJTBTOT=$GET(ADJTBTOT)+BAR(6)
+191 SET SORTBTOT=$GET(SORTBTOT)+BAR(6)
+192 SET ARBTOT=$GET(ARBTOT)+BAR(6)
+193 SET DSRCBTOT=$GET(DSRCBTOT)+BAR(6)
+194 SET BARBILLO=BARBILL
+195 ;following 2 lines moved from bottom p.ott HEAT 107110
+196 ;p.ott
SET GRANBILL=GRANBILL+BAR(6)
+197 ;;;S GRANTRAN=GRANTRAN+BAR(3)+BAR(4)+BAR(5)+BAR(7) ;p.ott LINE DEATIVATED 2/18/2014 HEAT 153046
End DoDot:2
+198 ;WAS ADDING BAR(2)
SET VLOCTTOT=$GET(VLOCTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7)
+199 SET TRANTTOT=$GET(TRANTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7)
+200 SET ADJTTTOT=$GET(ADJTTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7)
+201 SET SORTTTOT=$GET(SORTTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7)
+202 SET ARTTOT=$GET(ARTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7)
+203 SET DSRCTTOT=$GET(DSRCTTOT)+BAR(3)+BAR(4)+BAR(5)+BAR(7)
+204 ;S GRANBILL=GRANBILL+BAR(6) ;p.ott 2 lines taken from here UP 107110 FIXING TOTALS
+205 ;LINE ACTIVATED 2/18/2014 HEAT 153046
SET GRANTRAN=GRANTRAN+BAR(3)+BAR(4)+BAR(5)+BAR(7)
End DoDot:1
IF $GET(BAR("F1"))
QUIT
+206 IF $GET(BAR("F1"))!BARTEXT
QUIT
+207 IF SUMMARY
DO GETCOUNT
+208 WRITE !,BARDASH
+209 ;2 LINES SWAPPED 107110 FIXING TOTALS ; Totals by Sort type
DO SUBSORT
+210 ; Totals by Data Source
DO SUBDSRC
+211 WRITE !
DO SUBTRAN
+212 WRITE !
DO SUBLOC
+213 DO TOT
+214 QUIT
HD ; EP
+1 DO PAZ^BARRUTL
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAR("F1")=1
QUIT
HDB ; EP
+1 ; Page and column header
+2 SET BAR("PG")=BAR("PG")+1
+3 SET BAR("I")=""
+4 ; Report header
DO WHD^BARRHD
+5 XECUTE BAR("COL")
+6 XECUTE BAR("COL",0)
+7 ;P.OTT
IF $GET(BAR("COL",1))]""
XECUTE BAR("COL",1)
+8 SET $PIECE(BAR("DASH"),"=",$SELECT($DATA(BAR(132)):132,1:80))=""
+9 WRITE !,BAR("DASH")
+10 QUIT
SUBHD ;
+1 ; If A/R clerk specified
+2 IF '$DATA(BARY("AR"))
QUIT
+3 IF '+$PIECE(BAR("TXT"),U)
QUIT
+4 WRITE !!,"A/R Entry Clerk: ",$PIECE(^VA(200,$PIECE(BAR("TXT"),U),0),U)
+5 QUIT
SUBTRAN ;EP - TOTALS BY TRANSACTION TYPE
+1 IF $DATA(BARY("TRANS TYPE",40))
WRITE !?10,"Totals by Transaction type:"
+2 IF '$TEST
WRITE !?10,"Totals by Adjustment Category:"
+3 WRITE ?42,$JUSTIFY($FNUMBER(TRANBTOT,",",2),10)
+4 WRITE ?55,$JUSTIFY($FNUMBER(TRANTTOT,",",2),10)
+5 SET (TRANBTOT,TRANTTOT)=0
+6 QUIT
SUBLOC ;
+1 ; Totals by Visit location.
+2 WRITE !,"Location Tot:"
+3 WRITE ?42,$JUSTIFY($FNUMBER(VLOCBTOT,",",2),10)
+4 WRITE ?55,$JUSTIFY($FNUMBER(VLOCTTOT,",",2),10)
+5 SET (VLOCBTOT,VLOCTTOT)=0
+6 QUIT
SUBADJ ;
+1 ; Totals by adjustment category
+2 WRITE !,"Adjustment Category Tot:"
+3 WRITE ?41,$JUSTIFY($FNUMBER(ADJTBTOT,",",2),10)
+4 WRITE ?55,$JUSTIFY($FNUMBER(ADJTTTOT,",",2),10)
+5 SET (ADJTBTOT,ADJTTTOT)=0
+6 QUIT
SUB2 ;
+1 ; Totals by Collection Batch
+2 QUIT
+3 IF 'BAR("BTOT2")
QUIT
+4 WRITE !," Batch Tot:"
+5 WRITE ?41,$JUSTIFY($FNUMBER(BAR("BTOT2"),",",2),10)
+6 WRITE ?55,$JUSTIFY($FNUMBER(BAR("ATOT2"),",",2),10)
+7 SET (BAR("PATOT2"),BAR("PCTOT2"),BAR("RTOT2"),BAR("PTOT2"),BAR("BTOT2"),BAR("ATOT2"))=0
+8 QUIT
SUB3 ;
+1 QUIT
+2 ; Totals by Collection Batch Item
+3 IF 'BAR("BTOT3")
QUIT
+4 WRITE !," Item Tot:"
+5 WRITE ?41,$JUSTIFY($FNUMBER(BAR("BTOT3"),",",2),10)
+6 WRITE ?55,$JUSTIFY($FNUMBER(BAR("ATOT3"),",",2),10)
+7 SET (BAR("PATOT3"),BAR("PCTOT3"),BAR("RTOT3"),BAR("PTOT3"),BAR("BTOT3"),BAR("ATOT3"))=0
+8 QUIT
+9 ;
SUBDSRC ;
+1 ; Totals by Data Source
+2 WRITE !?25,"Data Source Tot:"
+3 ;IHS/SD/TPF 7/27/2011 BAR*1.8*21 BUG FOUND BY ADRIAN TYPO
IF SUMMARY
WRITE !?5,"Subtotal:",?33,$JUSTIFY(DSRCTTOT,5,0)
+4 WRITE ?42,$JUSTIFY($FNUMBER(DSRCBTOT,",",2),10)
+5 WRITE ?55,$JUSTIFY($FNUMBER(DSRCTTOT,",",2),10)
+6 SET (DSRCBTOT,DSRCTTOT)=0
+7 QUIT
+8 ;
SUBSORT ;
+1 ; Totals by Sort type
+2 ;
+3 IF BARY("SORT")="C"
IF 'SUMMARY
WRITE !?25,"Clinic Tot:"
+4 IF BARY("SORT")="V"
IF 'SUMMARY
WRITE !?25,"Visit Type Tot:"
+5 ;
+6 IF BARY("SORT")'="N"
Begin DoDot:1
+7 IF SUMMARY
WRITE !?5,"Subtotal:",?33,$JUSTIFY(SUBTOT,5,0)
+8 WRITE ?42,$JUSTIFY($FNUMBER(SORTBTOT,",",2),10)
+9 WRITE ?55,$JUSTIFY($FNUMBER(SORTTTOT,",",2),10)
End DoDot:1
+10 SET (SORTBTOT,SORTTTOT)=0
+11 QUIT
SUB5 ;
+1 QUIT
+2 ; totals by A/R Account
+3 IF 'BAR("BTOT5")
QUIT
+4 WRITE !,"A/R Acct Tot:"
+5 WRITE ?41,$JUSTIFY($FNUMBER(BAR("BTOT5"),",",2),10)
+6 WRITE ?55,$JUSTIFY($FNUMBER(BAR("ATOT5"),",",2),10)
+7 SET (BAR("PATOT5"),BAR("PCTOT5"),BAR("RTOT5"),BAR("PTOT5"),BAR("BTOT5"),BAR("ATOT5"))=0
+8 QUIT
TOT ;
+1 ; Report (a/r clerk) totals
+2 WRITE !!,BAREQUAL
+3 IF 'SUMMARY
WRITE !,"REPORT TOTAL"
+4 IF '$TEST
WRITE !,"Total:"
+5 IF SUMMARY
WRITE ?33,$JUSTIFY($GET(TOTBILLS),5,0)
+6 WRITE ?42,$JUSTIFY($FNUMBER(GRANBILL,",",2),10)
+7 WRITE ?55,$JUSTIFY($FNUMBER(GRANTRAN,",",2),10)
+8 SET BAR("ST")=1
+9 QUIT
GETCOUNT ;
+1 NEW BILL,INSURER
+2 SET SUBTOT=0
+3 SET SUBS=$PIECE(BAR("TXTO"),U,1,7)
+4 SET $PIECE(SUBS,U,7)=BAR("SORT")
+5 SET INSURER=""
+6 FOR
SET INSURER=$ORDER(^TMP($JOB,"BAR-TSRS-INS",SUBS,INSURER))
IF INSURER=""
QUIT
Begin DoDot:1
+7 WRITE !?5,$EXTRACT($$GET1^DIQ(90050.02,INSURER_",",.01,"E"),1,25)
+8 SET BILL=""
+9 FOR CNT=0:1
SET BILL=$ORDER(^TMP($JOB,"BAR-TSRS-INS",SUBS,INSURER,BILL))
IF BILL=""
QUIT
+10 WRITE ?33,$JUSTIFY(CNT,5,0)
+11 SET TOTBILLS=TOTBILLS+CNT
+12 SET SUBTOT=SUBTOT+CNT
End DoDot:1
+13 QUIT
SUBTYPE ;
+1 WRITE !,BARDASH
+2 WRITE !,?20,"Adjustment Type Tot:"
+3 WRITE ?41,$JUSTIFY($FNUMBER(ADJTBTOT,",",2),10)
+4 WRITE ?55,$JUSTIFY($FNUMBER(ADJTTTOT,",",2),10)
+5 WRITE !
+6 SET (ADJTBTOT,ADJTTTOT)=0
+7 QUIT
GETDOS(BARBILL) ;
+1 NEW X,Y
+2 ;P.OTT DOS BEGIN WAS "I"
SET X=$$GET1^DIQ(90050.01,BARBILL,102,"I")
+3 QUIT $$SDT^BARDUTL(X)
+4 ;EOR
