BARRAMR2 ; IHS/SD/LSL - Aging management report ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**7,23,24**;OCT 26, 2005;Build 69
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
; IHS/ASDS/LSL - 09/26/00 - Routine created
; Detail print of Aging management report
;
; IHS/SD/LSL - 07/08/02 - V1.6 Patch 2
; Modified to print missing clinics and visit types
;
; IHS/SD/POTT HEAT102270 IGNORE LINE ITEMS WITH BALANCES=0 - BAR1.8*23
; IHS/SD/POTT HEAT151319 APPLY HEAT 102270 CHANGE ONLY TO AGING REPORT [2/10/2014] - BAR1.8*24
Q
; *********************************************************************
;
DETAIL ; EP
; Print Detail
S BAR("COL")="W !,""Patient"",?22,""Bill Number"",?42,""DOS"",?51,""Amount Billed"",?68,""Balance"""
S:BAR("HD",0)["Bills" BAR("HD",0)="DETAIL Bills"_$P(BAR("HD",0),"Bills",2,99)
S:BAR("HD",0)["Aging" BAR("HD",0)="DETAIL Aging"_$P(BAR("HD",0),"Aging",2,99)
D HDB ; Page and column header
S (BAR("CNT1"),BAR("CNT2"),BAR("CNT3"),BAR("CNT"))=0
S (BAR("BTOT1"),BAR("BTOT2"),BAR("BTOT3"),BAR("BTOT"))=0
S (BAR("ATOT1"),BAR("ATOT2"),BAR("ATOT3"),BAR("ATOT"))=0
S BAR("ACCT")="" ; Initialize account (3)
S BAR("L")="" ; Initialize location (1)
S BAR("SORT")="" ; Initialize sort (2)
S BAR("Z")="TMP("_$J_",""BAR-AMR"""
S BAR="^"_BAR("Z")_")"
I '$D(@BAR) D Q ; No data, message, quit
. W !!!!!?25,"*** NO DATA TO PRINT ***"
. D EOP^BARUTL(0)
; traverse the temp global...
F S BAR=$Q(@BAR) Q:BAR'[BAR("Z") D Q:$G(BAR("F1"))
. I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))
. S BAR("TXT")=$P($P(BAR,",",3,99),"""",2)
. S BAR("B")=$G(^BARBL(DUZ(2),$P(BAR("TXT"),U,5),0))
. Q:BAR("B")=""
. S BAR("B1")=$G(^BARBL(DUZ(2),$P(BAR("TXT"),U,5),1))
. S BAR("AMT")=$P(BAR("B"),U,13) ; Bill amount
. S BAR("BAL")=$P(BAR("B"),U,15) ; Remaining balance
. S BAR("DOS")=$P(BAR("B1"),U,2) ; DOS begin
. S Y=BAR("DOS") D DD^%DT ; External format
. S BAR("DOS")=Y
. ;;;I +BAR("BAL")=0 QUIT ; - BAR1.8*23
. I $G(BAR("HD",0))["Aging" I +BAR("BAL")=0 QUIT ;P.OTT HEAT151319 - BAR1.8*24
. I BAR("L")'=$P(BAR("TXT"),U) D
. . Q:$G(BAR("F1"))
. . I BAR("L")]"" D
. . . Q:$G(BAR("F1"))
. . . D SUB3,SUB2,SUB
. . . W !
. . W !?5,"Visit Location: ",$P(BAR("TXT"),U)
. . S (BAR("SORT"),BAR("ACCT"))=""
. S BAR("L")=$P(BAR("TXT"),U)
. I BAR("SORT")'=$P(BAR("TXT"),U,2) D
. . I BAR("SORT")]"" D
. . . Q:$G(BAR("F1"))
. . . D SUB3,SUB2
. . . W !
. . I BARY("SORT")="C" D
. . . W !?10," Clinic: "
. . . I $P(BAR("TXT"),U,2)=99999 W "NO CLINIC"
. . . E W $P(^DIC(40.7,$P(BAR("TXT"),U,2),0),U)
. . E D
. . . W !?10,"Visit Type: "
. . . I $P(BAR("TXT"),U,2)=99999 W "NO VISIT TYPE"
. . . E W $P(^ABMDVTYP($P(BAR("TXT"),U,2),0),U)
. . S BAR("ACCT")=""
. S BAR("SORT")=$P(BAR("TXT"),U,2)
. I BAR("ACCT")'=$P(BAR("TXT"),U,3) D
. . I BAR("ACCT")]"" D
. . . Q:$G(BAR("F1"))
. . . D SUB3
. . . W !
. . W !?15,"A/R Account: ",$P(BAR("TXT"),U,3),!
. S BAR("ACCT")=$P(BAR("TXT"),U,3)
. W !,$E($P(BAR("TXT"),U,4),1,18) ; Patient name
. W ?20,$P(BAR("B"),U) ; A/R Bill
. W ?38,BAR("DOS") ; DOS Begin
. W ?51,$J($FN($P(BAR("B"),U,13),",",2),13) ; Bill Amount
. W ?65,$J($FN($P(BAR("B"),U,15),",",2),13) ; Remaining Balance
. S BAR("CNT")=$G(BAR("CNT"))+1 ; Total count
. S BAR("CNT1")=$G(BAR("CNT1"))+1 ; Count per location
. S BAR("CNT2")=$G(BAR("CNT2"))+1 ; Count per sort
. S BAR("CNT3")=$G(BAR("CNT3"))+1 ; Count per acct
. S BAR("ATOT")=$G(BAR("ATOT"))+$P(BAR("B"),U,13) ; Amount tot
. S BAR("ATOT1")=$G(BAR("ATOT1"))+$P(BAR("B"),U,13) ; Amount per loc
. S BAR("ATOT2")=$G(BAR("ATOT2"))+$P(BAR("B"),U,13) ; Amount per sort
. S BAR("ATOT3")=$G(BAR("ATOT3"))+$P(BAR("B"),U,13) ; Amount per acct
. S BAR("BTOT")=$G(BAR("BTOT"))+$P(BAR("B"),U,15) ; Amount tot
. S BAR("BTOT1")=$G(BAR("BTOT1"))+$P(BAR("B"),U,15) ; Amount per loc
. S BAR("BTOT2")=$G(BAR("BTOT2"))+$P(BAR("B"),U,15) ; Amount per sort
. S BAR("BTOT3")=$G(BAR("BTOT3"))+$P(BAR("B"),U,15) ; Amount per acct
Q:$G(BAR("F1"))
D SUB3,SUB2,SUB,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")
S $P(BAR("DASH"),"=",$S($D(BAR(132)):132,1:80))=""
W !,BAR("DASH")
Q
; *********************************************************************
;
SUB ;
Q:'BAR("CNT1")
W !?51,"-------------",?65,"-------------"
W !,"Visit location"
W ?20,"Count: ",$J(BAR("CNT1"),4)
W ?40,"Total:"
W ?51,$J($FN(BAR("ATOT1"),",",2),13)
W ?65,$J($FN(BAR("BTOT1"),",",2),13)
S (BAR("CNT1"),BAR("ATOT1"),BAR("BTOT1"))=0
Q
; *********************************************************************
;
SUB2 ;
Q:'BAR("CNT2")
W !?51,"-------------",?65,"-------------"
I BARY("SORT")="C" W !,"Clinic Type"
E W !,"Visit Type"
W ?20,"Count: ",$J(BAR("CNT2"),4)
W ?40,"Total:"
W ?51,$J($FN(BAR("ATOT2"),",",2),13)
W ?65,$J($FN(BAR("BTOT2"),",",2),13)
S (BAR("CNT2"),BAR("ATOT2"),BAR("BTOT2"))=0
Q
; *********************************************************************
;
SUB3 ;
Q:'BAR("CNT3")
W !?51,"-------------",?65,"-------------"
W !,"A/R Account"
W ?20,"Count: ",$J(BAR("CNT3"),4)
W ?40,"Total:"
W ?51,$J($FN(BAR("ATOT3"),",",2),13)
W ?65,$J($FN(BAR("BTOT3"),",",2),13)
S (BAR("CNT3"),BAR("ATOT3"),BAR("BTOT3"))=0
Q
; *********************************************************************
;
TOT ;
Q:'BAR("CNT")
W !?51,"=============",?65,"============="
W !,"Report Totals"
W ?20,"Count: ",$J(BAR("CNT"),4)
W ?40,"Total:"
W ?51,$J($FN(BAR("ATOT"),",",2),13)
W ?65,$J($FN(BAR("BTOT"),",",2),13)
S (BAR("CNT"),BAR("ATOT"),BAR("BTOT"))=0
Q
BARRAMR2 ; IHS/SD/LSL - Aging management report ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7,23,24**;OCT 26, 2005;Build 69
+2 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+3 ; IHS/ASDS/LSL - 09/26/00 - Routine created
+4 ; Detail print of Aging management report
+5 ;
+6 ; IHS/SD/LSL - 07/08/02 - V1.6 Patch 2
+7 ; Modified to print missing clinics and visit types
+8 ;
+9 ; IHS/SD/POTT HEAT102270 IGNORE LINE ITEMS WITH BALANCES=0 - BAR1.8*23
+10 ; IHS/SD/POTT HEAT151319 APPLY HEAT 102270 CHANGE ONLY TO AGING REPORT [2/10/2014] - BAR1.8*24
+11 QUIT
+12 ; *********************************************************************
+13 ;
DETAIL ; EP
+1 ; Print Detail
+2 SET BAR("COL")="W !,""Patient"",?22,""Bill Number"",?42,""DOS"",?51,""Amount Billed"",?68,""Balance"""
+3 IF BAR("HD",0)["Bills"
SET BAR("HD",0)="DETAIL Bills"_$PIECE(BAR("HD",0),"Bills",2,99)
+4 IF BAR("HD",0)["Aging"
SET BAR("HD",0)="DETAIL Aging"_$PIECE(BAR("HD",0),"Aging",2,99)
+5 ; Page and column header
DO HDB
+6 SET (BAR("CNT1"),BAR("CNT2"),BAR("CNT3"),BAR("CNT"))=0
+7 SET (BAR("BTOT1"),BAR("BTOT2"),BAR("BTOT3"),BAR("BTOT"))=0
+8 SET (BAR("ATOT1"),BAR("ATOT2"),BAR("ATOT3"),BAR("ATOT"))=0
+9 ; Initialize account (3)
SET BAR("ACCT")=""
+10 ; Initialize location (1)
SET BAR("L")=""
+11 ; Initialize sort (2)
SET BAR("SORT")=""
+12 SET BAR("Z")="TMP("_$JOB_",""BAR-AMR"""
+13 SET BAR="^"_BAR("Z")_")"
+14 ; No data, message, quit
IF '$DATA(@BAR)
Begin DoDot:1
+15 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+16 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+17 ; traverse the temp global...
+18 FOR
SET BAR=$QUERY(@BAR)
IF BAR'[BAR("Z")
QUIT
Begin DoDot:1
+19 IF $Y>(IOSL-5)
DO HD
IF $GET(BAR("F1"))
QUIT
+20 SET BAR("TXT")=$PIECE($PIECE(BAR,",",3,99),"""",2)
+21 SET BAR("B")=$GET(^BARBL(DUZ(2),$PIECE(BAR("TXT"),U,5),0))
+22 IF BAR("B")=""
QUIT
+23 SET BAR("B1")=$GET(^BARBL(DUZ(2),$PIECE(BAR("TXT"),U,5),1))
+24 ; Bill amount
SET BAR("AMT")=$PIECE(BAR("B"),U,13)
+25 ; Remaining balance
SET BAR("BAL")=$PIECE(BAR("B"),U,15)
+26 ; DOS begin
SET BAR("DOS")=$PIECE(BAR("B1"),U,2)
+27 ; External format
SET Y=BAR("DOS")
DO DD^%DT
+28 SET BAR("DOS")=Y
+29 ;;;I +BAR("BAL")=0 QUIT ; - BAR1.8*23
+30 ;P.OTT HEAT151319 - BAR1.8*24
IF $GET(BAR("HD",0))["Aging"
IF +BAR("BAL")=0
QUIT
+31 IF BAR("L")'=$PIECE(BAR("TXT"),U)
Begin DoDot:2
+32 IF $GET(BAR("F1"))
QUIT
+33 IF BAR("L")]""
Begin DoDot:3
+34 IF $GET(BAR("F1"))
QUIT
+35 DO SUB3
DO SUB2
DO SUB
+36 WRITE !
End DoDot:3
+37 WRITE !?5,"Visit Location: ",$PIECE(BAR("TXT"),U)
+38 SET (BAR("SORT"),BAR("ACCT"))=""
End DoDot:2
+39 SET BAR("L")=$PIECE(BAR("TXT"),U)
+40 IF BAR("SORT")'=$PIECE(BAR("TXT"),U,2)
Begin DoDot:2
+41 IF BAR("SORT")]""
Begin DoDot:3
+42 IF $GET(BAR("F1"))
QUIT
+43 DO SUB3
DO SUB2
+44 WRITE !
End DoDot:3
+45 IF BARY("SORT")="C"
Begin DoDot:3
+46 WRITE !?10," Clinic: "
+47 IF $PIECE(BAR("TXT"),U,2)=99999
WRITE "NO CLINIC"
+48 IF '$TEST
WRITE $PIECE(^DIC(40.7,$PIECE(BAR("TXT"),U,2),0),U)
End DoDot:3
+49 IF '$TEST
Begin DoDot:3
+50 WRITE !?10,"Visit Type: "
+51 IF $PIECE(BAR("TXT"),U,2)=99999
WRITE "NO VISIT TYPE"
+52 IF '$TEST
WRITE $PIECE(^ABMDVTYP($PIECE(BAR("TXT"),U,2),0),U)
End DoDot:3
+53 SET BAR("ACCT")=""
End DoDot:2
+54 SET BAR("SORT")=$PIECE(BAR("TXT"),U,2)
+55 IF BAR("ACCT")'=$PIECE(BAR("TXT"),U,3)
Begin DoDot:2
+56 IF BAR("ACCT")]""
Begin DoDot:3
+57 IF $GET(BAR("F1"))
QUIT
+58 DO SUB3
+59 WRITE !
End DoDot:3
+60 WRITE !?15,"A/R Account: ",$PIECE(BAR("TXT"),U,3),!
End DoDot:2
+61 SET BAR("ACCT")=$PIECE(BAR("TXT"),U,3)
+62 ; Patient name
WRITE !,$EXTRACT($PIECE(BAR("TXT"),U,4),1,18)
+63 ; A/R Bill
WRITE ?20,$PIECE(BAR("B"),U)
+64 ; DOS Begin
WRITE ?38,BAR("DOS")
+65 ; Bill Amount
WRITE ?51,$JUSTIFY($FNUMBER($PIECE(BAR("B"),U,13),",",2),13)
+66 ; Remaining Balance
WRITE ?65,$JUSTIFY($FNUMBER($PIECE(BAR("B"),U,15),",",2),13)
+67 ; Total count
SET BAR("CNT")=$GET(BAR("CNT"))+1
+68 ; Count per location
SET BAR("CNT1")=$GET(BAR("CNT1"))+1
+69 ; Count per sort
SET BAR("CNT2")=$GET(BAR("CNT2"))+1
+70 ; Count per acct
SET BAR("CNT3")=$GET(BAR("CNT3"))+1
+71 ; Amount tot
SET BAR("ATOT")=$GET(BAR("ATOT"))+$PIECE(BAR("B"),U,13)
+72 ; Amount per loc
SET BAR("ATOT1")=$GET(BAR("ATOT1"))+$PIECE(BAR("B"),U,13)
+73 ; Amount per sort
SET BAR("ATOT2")=$GET(BAR("ATOT2"))+$PIECE(BAR("B"),U,13)
+74 ; Amount per acct
SET BAR("ATOT3")=$GET(BAR("ATOT3"))+$PIECE(BAR("B"),U,13)
+75 ; Amount tot
SET BAR("BTOT")=$GET(BAR("BTOT"))+$PIECE(BAR("B"),U,15)
+76 ; Amount per loc
SET BAR("BTOT1")=$GET(BAR("BTOT1"))+$PIECE(BAR("B"),U,15)
+77 ; Amount per sort
SET BAR("BTOT2")=$GET(BAR("BTOT2"))+$PIECE(BAR("B"),U,15)
+78 ; Amount per acct
SET BAR("BTOT3")=$GET(BAR("BTOT3"))+$PIECE(BAR("B"),U,15)
End DoDot:1
IF $GET(BAR("F1"))
QUIT
+79 IF $GET(BAR("F1"))
QUIT
+80 DO SUB3
DO SUB2
DO SUB
DO TOT
+81 QUIT
+82 ; *********************************************************************
+83 ;
HD ; EP
+1 DO PAZ^BARRUTL
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAR("F1")=1
QUIT
+3 ; -------------------------------
+4 ;
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 SET $PIECE(BAR("DASH"),"=",$SELECT($DATA(BAR(132)):132,1:80))=""
+7 WRITE !,BAR("DASH")
+8 QUIT
+9 ; *********************************************************************
+10 ;
SUB ;
+1 IF 'BAR("CNT1")
QUIT
+2 WRITE !?51,"-------------",?65,"-------------"
+3 WRITE !,"Visit location"
+4 WRITE ?20,"Count: ",$JUSTIFY(BAR("CNT1"),4)
+5 WRITE ?40,"Total:"
+6 WRITE ?51,$JUSTIFY($FNUMBER(BAR("ATOT1"),",",2),13)
+7 WRITE ?65,$JUSTIFY($FNUMBER(BAR("BTOT1"),",",2),13)
+8 SET (BAR("CNT1"),BAR("ATOT1"),BAR("BTOT1"))=0
+9 QUIT
+10 ; *********************************************************************
+11 ;
SUB2 ;
+1 IF 'BAR("CNT2")
QUIT
+2 WRITE !?51,"-------------",?65,"-------------"
+3 IF BARY("SORT")="C"
WRITE !,"Clinic Type"
+4 IF '$TEST
WRITE !,"Visit Type"
+5 WRITE ?20,"Count: ",$JUSTIFY(BAR("CNT2"),4)
+6 WRITE ?40,"Total:"
+7 WRITE ?51,$JUSTIFY($FNUMBER(BAR("ATOT2"),",",2),13)
+8 WRITE ?65,$JUSTIFY($FNUMBER(BAR("BTOT2"),",",2),13)
+9 SET (BAR("CNT2"),BAR("ATOT2"),BAR("BTOT2"))=0
+10 QUIT
+11 ; *********************************************************************
+12 ;
SUB3 ;
+1 IF 'BAR("CNT3")
QUIT
+2 WRITE !?51,"-------------",?65,"-------------"
+3 WRITE !,"A/R Account"
+4 WRITE ?20,"Count: ",$JUSTIFY(BAR("CNT3"),4)
+5 WRITE ?40,"Total:"
+6 WRITE ?51,$JUSTIFY($FNUMBER(BAR("ATOT3"),",",2),13)
+7 WRITE ?65,$JUSTIFY($FNUMBER(BAR("BTOT3"),",",2),13)
+8 SET (BAR("CNT3"),BAR("ATOT3"),BAR("BTOT3"))=0
+9 QUIT
+10 ; *********************************************************************
+11 ;
TOT ;
+1 IF 'BAR("CNT")
QUIT
+2 WRITE !?51,"=============",?65,"============="
+3 WRITE !,"Report Totals"
+4 WRITE ?20,"Count: ",$JUSTIFY(BAR("CNT"),4)
+5 WRITE ?40,"Total:"
+6 WRITE ?51,$JUSTIFY($FNUMBER(BAR("ATOT"),",",2),13)
+7 WRITE ?65,$JUSTIFY($FNUMBER(BAR("BTOT"),",",2),13)
+8 SET (BAR("CNT"),BAR("ATOT"),BAR("BTOT"))=0
+9 QUIT
