BARRADJ2.m

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"))