BARRTAR3 ; IHS/SD/LSL - Transaction report ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,7**;MAR 27,2007
;
; IHS/ASDS/LSL - 10/06/00 - Routine created
; Summary print of Transaction report
;
; IHS/SD/LSL - 07/10/02 - V1/6 Patch 2
; Modified to print missing clinics and missing visit types
;
; IHS/SD/LSL - 10/24/02 - V1.7 - PAB-1002-90130
; Modified to accomodate DUZ(2) subscript
;
; IHS/SD/RTL - 5/23/05 - V1.8 Patch 1 - IM17362
; TAR report bombing - missing collection batch
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
Q
; *********************************************************************
;
SUMM ; EP
S BAR("COL")="W !,""A/R Account"",?15,""PAY-AMT"",?26,""PRV-CRD"",?37,""REFUND"",?48,""PAYMENT"",?59,""BILL AMT"",?70,""ADJUSTMENT"""
S BAR("HD",0)="SUMMARY Transaction"_$P(BAR("HD",0),"Transaction",2,99)
D HDB^BARRTAR2
S BARDASH=" ---------- ---------- ---------- ---------- ---------- ----------"
S BAREQUAL=" ========== ========== ========== ========== ========== =========="
S (BAR("0TOTA"),BAR("0TOTB"),BAR("0TOTC"),BAR("0TOTD"),BAR("0TOTE"),BAR("0TOTF"))=0
S (BAR("OL"),BAR("OB"),BAR("OIT"),BAR("OS"))=""
I '$D(^TMP($J,"BAR-TARS")) D Q
. W !!!,"*** NO DATA TO PRINT ***"
. D EOP^BARUTL(0)
S (BAR("AR"),BAR("OAR"))=""
F S BAR("AR")=$O(^TMP($J,"BAR-TARS",BAR("AR"))) Q:BAR("AR")']""!($G(BAR("F1"))) D
. I +BAR("AR") W !!,"A/R Entry Clerk: ",$P(^VA(200,BAR("AR"),0),U)
. S BAR("DUZ")=0
. F S BAR("DUZ")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"))) Q:'+BAR("DUZ")!($G(BAR("F1"))) D
. . S (BAR("L"),BAR("OL"))=""
. . F S BAR("L")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"))) Q:BAR("L")=""!($G(BAR("F1"))) D LOC
Q:$G(BAR("F1"))
W !,BAREQUAL
W !,"REPORT TOTAL"
W ?15,$J($FN(BAR("0TOTA"),",",2),10)
W ?26,$J($FN(BAR("0TOTB"),",",2),10)
W ?37,$J($FN(BAR("0TOTC"),",",2),10)
W ?48,$J($FN(BAR("0TOTD"),",",2),10)
W ?59,$J($FN(BAR("0TOTE"),",",2),10)
W ?70,$J($FN(BAR("0TOTF"),",",2),10)
Q
; *********************************************************************
;
LOC ;
S BAR("B")=""
F S BAR("B")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"))) Q:BAR("B")=""!($G(BAR("F1"))) D BATCH
Q:$G(BAR("F1"))
W !,BARDASH
W !,"Location Tot:"
W ?15,$J($FN(BAR("1TOTA"),",",2),10)
W ?26,$J($FN(BAR("1TOTB"),",",2),10)
W ?37,$J($FN(BAR("1TOTC"),",",2),10)
W ?48,$J($FN(BAR("1TOTD"),",",2),10)
W ?59,$J($FN(BAR("1TOTE"),",",2),10)
W ?70,$J($FN(BAR("1TOTF"),",",2),10)
Q
; *********************************************************************
;
BATCH ;
S BAR("IT")=""
F S BAR("IT")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"))) Q:BAR("IT")=""!($G(BAR("F1"))) D ITEM
Q:$G(BAR("F1"))
W !,BARDASH
W !," Batch Tot:"
W ?15,$J($FN(BAR("2TOTA"),",",2),10)
W ?26,$J($FN(BAR("2TOTB"),",",2),10)
W ?37,$J($FN(BAR("2TOTC"),",",2),10)
W ?48,$J($FN(BAR("2TOTD"),",",2),10)
W ?59,$J($FN(BAR("2TOTE"),",",2),10)
W ?70,$J($FN(BAR("2TOTF"),",",2),10)
Q
; *********************************************************************
;
ITEM ;
S BAR("S")=""
F S BAR("S")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S"))) Q:BAR("S")=""!($G(BAR("F1"))) D SORT
Q:$G(BAR("F1"))
W !,BARDASH
W !," Item Tot:"
W ?15,$J($FN(BAR("3TOTA"),",",2),10)
W ?26,$J($FN(BAR("3TOTB"),",",2),10)
W ?37,$J($FN(BAR("3TOTC"),",",2),10)
W ?48,$J($FN(BAR("3TOTD"),",",2),10)
W ?59,$J($FN(BAR("3TOTE"),",",2),10)
W ?70,$J($FN(BAR("3TOTF"),",",2),10)
Q
; *********************************************************************
;
SORT ;
S BAR("ACCT")=""
F S BAR("ACCT")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S"),BAR("ACCT"))) Q:BAR("ACCT")=""!($G(BAR("F1"))) D ACCT
Q:$G(BAR("F1"))
W !,BARDASH
I BARY("SORT")="C" W !," Clinic Tot:"
E W !," Visit Tot:"
W ?15,$J($FN(BAR("4TOTA"),",",2),10)
W ?26,$J($FN(BAR("4TOTB"),",",2),10)
W ?37,$J($FN(BAR("4TOTC"),",",2),10)
W ?48,$J($FN(BAR("4TOTD"),",",2),10)
W ?59,$J($FN(BAR("4TOTE"),",",2),10)
W ?70,$J($FN(BAR("4TOTF"),",",2),10)
Q
; *********************************************************************
;
ACCT ;
Q:$G(BAR("F1"))
I $Y>(IOSL-5) D HD^BARRTAR2 Q:$G(BAR("F1"))
I BAR("OL")'=BAR("L") W ! D HD1 W !
E I BAR("OB")'=BAR("B") W ! D HD2 W !
E I BAR("OIT")'=BAR("IT") W ! D HD3 W !
E I BAR("OS")'=BAR("S") W ! D HD4 W !
S BAR("DATA")=^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S"),BAR("ACCT"))
W !,$E(BAR("ACCT"),1,14) ; A/R Account
W ?15,$J($FN($P(BAR("DATA"),U,2),",",2),10) ; Pay Amt
W ?26,$J($FN($P(BAR("DATA"),U,3),",",2),10) ; Prev Credit
W ?37,$J($FN($P(BAR("DATA"),U,4),",",2),10) ; Refunds
W ?48,$J($FN($P(BAR("DATA"),U,5),",",2),10) ; payment
W ?59,$J($FN($P(BAR("DATA"),U,6),",",2),10) ; bill amt
W ?70,$J($FN($P(BAR("DATA"),U,7),",",2),10) ; adjustments
F I=0:1:4 D ; Accumulate totals
. S Y=1
. F X="TOTA","TOTB","TOTC","TOTD","TOTE","TOTF" D
. . S Y=Y+1
. . S BARV=I_X
. . S BARV2="BAR("""_BARV_""")"
. . S @BARV2=@BARV2+$P(BAR("DATA"),U,Y)
K I,X,Y
Q
; *********************************************************************
;
HD1 ;
W !?10,"Visit Location.......: ",BAR("L")
S BAR("OL")=BAR("L")
S (BAR("1TOTA"),BAR("1TOTB"),BAR("1TOTC"),BAR("1TOTD"),BAR("1TOTE"),BAR("1TOTF"))=0
D HD2
Q
; *********************************************************************
;
HD2 ;
W !?10,"Collection Batch.....: "
;I +BAR("B") W $P(^BARCOL(DUZ(2),BAR("B"),0),U)
I +BAR("B"),$P($G(^BARCOL(DUZ(2),BAR("B"),0)),U)'="" D
.W $P(^BARCOL(DUZ(2),BAR("B"),0),U) ;IM17362
E W BAR("B")
S BAR("OB")=BAR("B")
S (BAR("2TOTA"),BAR("2TOTB"),BAR("2TOTC"),BAR("2TOTD"),BAR("2TOTE"),BAR("2TOTF"))=0
D HD3
Q
; *********************************************************************
;
HD3 ;
W !?10,"Collection Batch Item: ",BAR("IT")
S BAR("OIT")=BAR("IT")
S (BAR("3TOTA"),BAR("3TOTB"),BAR("3TOTC"),BAR("3TOTD"),BAR("3TOTE"),BAR("3TOTF"))=0
D HD4
Q
; *********************************************************************
;
HD4 ;
W !?10
I BARY("SORT")="C" D
. W "Clinic Type..........: "
. I BAR("S")=99999 W "NO CLINIC" Q
. W $P(^DIC(40.7,BAR("S"),0),U)
I BARY("SORT")="V" D
. W "Visit Type...........: "
. I BAR("S")=99999 W "NO VISIT TYPE" Q
. W $P(^ABMDVTYP(BAR("S"),0),U)
S BAR("OS")=BAR("S")
S (BAR("4TOTA"),BAR("4TOTB"),BAR("4TOTC"),BAR("4TOTD"),BAR("4TOTE"),BAR("4TOTF"))=0
Q
BARRTAR3 ; IHS/SD/LSL - Transaction report ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,7**;MAR 27,2007
+2 ;
+3 ; IHS/ASDS/LSL - 10/06/00 - Routine created
+4 ; Summary print of Transaction report
+5 ;
+6 ; IHS/SD/LSL - 07/10/02 - V1/6 Patch 2
+7 ; Modified to print missing clinics and missing visit types
+8 ;
+9 ; IHS/SD/LSL - 10/24/02 - V1.7 - PAB-1002-90130
+10 ; Modified to accomodate DUZ(2) subscript
+11 ;
+12 ; IHS/SD/RTL - 5/23/05 - V1.8 Patch 1 - IM17362
+13 ; TAR report bombing - missing collection batch
+14 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+15 QUIT
+16 ; *********************************************************************
+17 ;
SUMM ; EP
+1 SET BAR("COL")="W !,""A/R Account"",?15,""PAY-AMT"",?26,""PRV-CRD"",?37,""REFUND"",?48,""PAYMENT"",?59,""BILL AMT"",?70,""ADJUSTMENT"""
+2 SET BAR("HD",0)="SUMMARY Transaction"_$PIECE(BAR("HD",0),"Transaction",2,99)
+3 DO HDB^BARRTAR2
+4 SET BARDASH=" ---------- ---------- ---------- ---------- ---------- ----------"
+5 SET BAREQUAL=" ========== ========== ========== ========== ========== =========="
+6 SET (BAR("0TOTA"),BAR("0TOTB"),BAR("0TOTC"),BAR("0TOTD"),BAR("0TOTE"),BAR("0TOTF"))=0
+7 SET (BAR("OL"),BAR("OB"),BAR("OIT"),BAR("OS"))=""
+8 IF '$DATA(^TMP($JOB,"BAR-TARS"))
Begin DoDot:1
+9 WRITE !!!,"*** NO DATA TO PRINT ***"
+10 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+11 SET (BAR("AR"),BAR("OAR"))=""
+12 FOR
SET BAR("AR")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR")))
IF BAR("AR")']""!($GET(BAR("F1")))
QUIT
Begin DoDot:1
+13 IF +BAR("AR")
WRITE !!,"A/R Entry Clerk: ",$PIECE(^VA(200,BAR("AR"),0),U)
+14 SET BAR("DUZ")=0
+15 FOR
SET BAR("DUZ")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ")))
IF '+BAR("DUZ")!($GET(BAR("F1")))
QUIT
Begin DoDot:2
+16 SET (BAR("L"),BAR("OL"))=""
+17 FOR
SET BAR("L")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L")))
IF BAR("L")=""!($GET(BAR("F1")))
QUIT
DO LOC
End DoDot:2
End DoDot:1
+18 IF $GET(BAR("F1"))
QUIT
+19 WRITE !,BAREQUAL
+20 WRITE !,"REPORT TOTAL"
+21 WRITE ?15,$JUSTIFY($FNUMBER(BAR("0TOTA"),",",2),10)
+22 WRITE ?26,$JUSTIFY($FNUMBER(BAR("0TOTB"),",",2),10)
+23 WRITE ?37,$JUSTIFY($FNUMBER(BAR("0TOTC"),",",2),10)
+24 WRITE ?48,$JUSTIFY($FNUMBER(BAR("0TOTD"),",",2),10)
+25 WRITE ?59,$JUSTIFY($FNUMBER(BAR("0TOTE"),",",2),10)
+26 WRITE ?70,$JUSTIFY($FNUMBER(BAR("0TOTF"),",",2),10)
+27 QUIT
+28 ; *********************************************************************
+29 ;
LOC ;
+1 SET BAR("B")=""
+2 FOR
SET BAR("B")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B")))
IF BAR("B")=""!($GET(BAR("F1")))
QUIT
DO BATCH
+3 IF $GET(BAR("F1"))
QUIT
+4 WRITE !,BARDASH
+5 WRITE !,"Location Tot:"
+6 WRITE ?15,$JUSTIFY($FNUMBER(BAR("1TOTA"),",",2),10)
+7 WRITE ?26,$JUSTIFY($FNUMBER(BAR("1TOTB"),",",2),10)
+8 WRITE ?37,$JUSTIFY($FNUMBER(BAR("1TOTC"),",",2),10)
+9 WRITE ?48,$JUSTIFY($FNUMBER(BAR("1TOTD"),",",2),10)
+10 WRITE ?59,$JUSTIFY($FNUMBER(BAR("1TOTE"),",",2),10)
+11 WRITE ?70,$JUSTIFY($FNUMBER(BAR("1TOTF"),",",2),10)
+12 QUIT
+13 ; *********************************************************************
+14 ;
BATCH ;
+1 SET BAR("IT")=""
+2 FOR
SET BAR("IT")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT")))
IF BAR("IT")=""!($GET(BAR("F1")))
QUIT
DO ITEM
+3 IF $GET(BAR("F1"))
QUIT
+4 WRITE !,BARDASH
+5 WRITE !," Batch Tot:"
+6 WRITE ?15,$JUSTIFY($FNUMBER(BAR("2TOTA"),",",2),10)
+7 WRITE ?26,$JUSTIFY($FNUMBER(BAR("2TOTB"),",",2),10)
+8 WRITE ?37,$JUSTIFY($FNUMBER(BAR("2TOTC"),",",2),10)
+9 WRITE ?48,$JUSTIFY($FNUMBER(BAR("2TOTD"),",",2),10)
+10 WRITE ?59,$JUSTIFY($FNUMBER(BAR("2TOTE"),",",2),10)
+11 WRITE ?70,$JUSTIFY($FNUMBER(BAR("2TOTF"),",",2),10)
+12 QUIT
+13 ; *********************************************************************
+14 ;
ITEM ;
+1 SET BAR("S")=""
+2 FOR
SET BAR("S")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S")))
IF BAR("S")=""!($GET(BAR("F1")))
QUIT
DO SORT
+3 IF $GET(BAR("F1"))
QUIT
+4 WRITE !,BARDASH
+5 WRITE !," Item Tot:"
+6 WRITE ?15,$JUSTIFY($FNUMBER(BAR("3TOTA"),",",2),10)
+7 WRITE ?26,$JUSTIFY($FNUMBER(BAR("3TOTB"),",",2),10)
+8 WRITE ?37,$JUSTIFY($FNUMBER(BAR("3TOTC"),",",2),10)
+9 WRITE ?48,$JUSTIFY($FNUMBER(BAR("3TOTD"),",",2),10)
+10 WRITE ?59,$JUSTIFY($FNUMBER(BAR("3TOTE"),",",2),10)
+11 WRITE ?70,$JUSTIFY($FNUMBER(BAR("3TOTF"),",",2),10)
+12 QUIT
+13 ; *********************************************************************
+14 ;
SORT ;
+1 SET BAR("ACCT")=""
+2 FOR
SET BAR("ACCT")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S"),BAR("ACCT")))
IF BAR("ACCT")=""!($GET(BAR("F1")))
QUIT
DO ACCT
+3 IF $GET(BAR("F1"))
QUIT
+4 WRITE !,BARDASH
+5 IF BARY("SORT")="C"
WRITE !," Clinic Tot:"
+6 IF '$TEST
WRITE !," Visit Tot:"
+7 WRITE ?15,$JUSTIFY($FNUMBER(BAR("4TOTA"),",",2),10)
+8 WRITE ?26,$JUSTIFY($FNUMBER(BAR("4TOTB"),",",2),10)
+9 WRITE ?37,$JUSTIFY($FNUMBER(BAR("4TOTC"),",",2),10)
+10 WRITE ?48,$JUSTIFY($FNUMBER(BAR("4TOTD"),",",2),10)
+11 WRITE ?59,$JUSTIFY($FNUMBER(BAR("4TOTE"),",",2),10)
+12 WRITE ?70,$JUSTIFY($FNUMBER(BAR("4TOTF"),",",2),10)
+13 QUIT
+14 ; *********************************************************************
+15 ;
ACCT ;
+1 IF $GET(BAR("F1"))
QUIT
+2 IF $Y>(IOSL-5)
DO HD^BARRTAR2
IF $GET(BAR("F1"))
QUIT
+3 IF BAR("OL")'=BAR("L")
WRITE !
DO HD1
WRITE !
+4 IF '$TEST
IF BAR("OB")'=BAR("B")
WRITE !
DO HD2
WRITE !
+5 IF '$TEST
IF BAR("OIT")'=BAR("IT")
WRITE !
DO HD3
WRITE !
+6 IF '$TEST
IF BAR("OS")'=BAR("S")
WRITE !
DO HD4
WRITE !
+7 SET BAR("DATA")=^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S"),BAR("ACCT"))
+8 ; A/R Account
WRITE !,$EXTRACT(BAR("ACCT"),1,14)
+9 ; Pay Amt
WRITE ?15,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,2),",",2),10)
+10 ; Prev Credit
WRITE ?26,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,3),",",2),10)
+11 ; Refunds
WRITE ?37,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,4),",",2),10)
+12 ; payment
WRITE ?48,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,5),",",2),10)
+13 ; bill amt
WRITE ?59,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,6),",",2),10)
+14 ; adjustments
WRITE ?70,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,7),",",2),10)
+15 ; Accumulate totals
FOR I=0:1:4
Begin DoDot:1
+16 SET Y=1
+17 FOR X="TOTA","TOTB","TOTC","TOTD","TOTE","TOTF"
Begin DoDot:2
+18 SET Y=Y+1
+19 SET BARV=I_X
+20 SET BARV2="BAR("""_BARV_""")"
+21 SET @BARV2=@BARV2+$PIECE(BAR("DATA"),U,Y)
End DoDot:2
End DoDot:1
+22 KILL I,X,Y
+23 QUIT
+24 ; *********************************************************************
+25 ;
HD1 ;
+1 WRITE !?10,"Visit Location.......: ",BAR("L")
+2 SET BAR("OL")=BAR("L")
+3 SET (BAR("1TOTA"),BAR("1TOTB"),BAR("1TOTC"),BAR("1TOTD"),BAR("1TOTE"),BAR("1TOTF"))=0
+4 DO HD2
+5 QUIT
+6 ; *********************************************************************
+7 ;
HD2 ;
+1 WRITE !?10,"Collection Batch.....: "
+2 ;I +BAR("B") W $P(^BARCOL(DUZ(2),BAR("B"),0),U)
+3 IF +BAR("B")
IF $PIECE($GET(^BARCOL(DUZ(2),BAR("B"),0)),U)'=""
Begin DoDot:1
+4 ;IM17362
WRITE $PIECE(^BARCOL(DUZ(2),BAR("B"),0),U)
End DoDot:1
+5 IF '$TEST
WRITE BAR("B")
+6 SET BAR("OB")=BAR("B")
+7 SET (BAR("2TOTA"),BAR("2TOTB"),BAR("2TOTC"),BAR("2TOTD"),BAR("2TOTE"),BAR("2TOTF"))=0
+8 DO HD3
+9 QUIT
+10 ; *********************************************************************
+11 ;
HD3 ;
+1 WRITE !?10,"Collection Batch Item: ",BAR("IT")
+2 SET BAR("OIT")=BAR("IT")
+3 SET (BAR("3TOTA"),BAR("3TOTB"),BAR("3TOTC"),BAR("3TOTD"),BAR("3TOTE"),BAR("3TOTF"))=0
+4 DO HD4
+5 QUIT
+6 ; *********************************************************************
+7 ;
HD4 ;
+1 WRITE !?10
+2 IF BARY("SORT")="C"
Begin DoDot:1
+3 WRITE "Clinic Type..........: "
+4 IF BAR("S")=99999
WRITE "NO CLINIC"
QUIT
+5 WRITE $PIECE(^DIC(40.7,BAR("S"),0),U)
End DoDot:1
+6 IF BARY("SORT")="V"
Begin DoDot:1
+7 WRITE "Visit Type...........: "
+8 IF BAR("S")=99999
WRITE "NO VISIT TYPE"
QUIT
+9 WRITE $PIECE(^ABMDVTYP(BAR("S"),0),U)
End DoDot:1
+10 SET BAR("OS")=BAR("S")
+11 SET (BAR("4TOTA"),BAR("4TOTB"),BAR("4TOTC"),BAR("4TOTD"),BAR("4TOTE"),BAR("4TOTF"))=0
+12 QUIT
