BARRATS ; IHS/SD/LSL - File Synchronization ;09/15/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**7,19,20,24**;OCT 26, 2005;Build 69
;
; IHS/SD/LSL - 06/04/02 - V1.6 Patch 2
; Routine created
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
;
; IHS/SD/POT HEAT141692 CHANGE DEFAULT VALUE (detail or summary) BAR*1.8*24
; *********************************************************************
;
; This routine will compare the Current Bill Amount of the A/R Bill
; File to the A/R Transaction history balance. If they are not
; equal, relevant data will be stored in a temp global. A report
; (A/R BILL AND TRANSACTION SYNCHRONIZATION REPORT) will be
; generated containing A/R Bill, Date of Service, A/R Account,
; Current Bill Amount, Transaction History Balance, and the
; difference between the two.
;
; The user may select a visit location for the report.
; The user may choose to print a detail report. If detail, then
; the transaction history will show as well (Transaction Date,
; Transaction Type, A/R Account, Transaction Amount, and
; Transaction Balance)
;
; *********************************************************************
Q
; *********************************************************************
;
EN ; EP
;
K BARY,BAR
D:'$D(BARUSR) INIT^BARUTL ; Set up basic A/R variables
S BARP("RTN")="BARRATS" ; Routine used to gather data
S BAR("PRIVACY")=1 ; Privacy act applies (used BARRHD)
S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16) ; BILLING or VISIT
I BAR("LOC")="" S BAR("LOC")="VISIT"
D MSG^BARRSEL ; Message about BILLING/VISIT loc
D LOC^BARRSL1 ; Ask location - BARY("LOC")
Q:$D(DTOUT)!($D(DUOUT))
W:'$D(BARY("LOC")) "ALL"
D RTYP ; Ask Report type
Q:$D(DTOUT)!($D(DUOUT))
D SETHDR ; Build header array
S BARQ("RC")="COMPUTE^BARRATS" ; Gather data
S BARQ("RP")="PRINT^BARRATS" ; Print report
S BARQ("NS")="BAR" ; Namespace for variables
S BARQ("RX")="POUT^BARRUTL" ; Clean-up routine
D ^BARDBQUE ; Double queuing
D PAZ^BARRUTL ; Press return to continue
Q
; *********************************************************************
;
RTYP ;
; Ask report type (detail or summary)
K DIR,BARY("RTYP")
S DIR(0)="SO^1:Detail;2:Summary"
S DIR("A")="Select TYPE of REPORT desired"
S DIR("B")=1 ;P.OTT HEAT141692 CHANGE DEFAULT VALUE
S DIR("?")="Select detail or summary. Detail contains transaction history"
D ^DIR
K DIR
I $D(DUOUT)!$D(DTOUT) Q
S BARY("RTYP")=Y
S BARY("RTYP","NM")=Y(0)
Q
; *********************************************************************
;
SETHDR ;
; Build header array
S BAR("LVL")=0
I $G(BARY("RTYP"))=2 S BAR("HD",0)="SUMMARY "
E S BAR("HD",0)="DETAIL "
S BAR("HD",0)=BAR("HD",0)_"A/R Bill and Transaction Synchronization Report"
S BAR("TXT")="ALL"
I $D(BARY("LOC")) S BAR("TXT")=$P(^DIC(4,BARY("LOC"),0),U)
I BAR("LOC")="BILLING" D
. S BAR("TXT")=BAR("TXT")_" Visit location(s) under "
. S BAR("TXT")=BAR("TXT")_$P(^DIC(4,DUZ(2),0),U)
. S BAR("TXT")=BAR("TXT")_" Billing Location"
E S BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
S BAR("CONJ")="at "
D CHK^BARRHD
Q
; *********************************************************************
; *********************************************************************
;
COMPUTE ;
; Build temporary data global
K ^TMP($J,"BAR-ATS")
I BAR("LOC")="BILLING" D DATA
E D LOOP
Q
; *********************************************************************
LOOP ;
S BARDUZ=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'+DUZ(2) D DATA
S DUZ(2)=BARDUZ
Q
; *********************************************************************
;
DATA ;
S BARBILL=0
F S BARBILL=$O(^BARBL(DUZ(2),BARBILL)) Q:'+BARBILL D
. Q:'$D(^BARBL(DUZ(2),BARBILL,0)) ; No data on bill
. D BILLDATA ; Gather A/R Bill data
. I $D(BARY("LOC")),BARY("LOC")'=BARVIS Q ; Not chosen visit location
. D TRDATA ; Gather A/R Transaction data
. Q:+BARBAMT=BARTAMT ; Files are in sync
. S BARDIF=BARBAMT-BARTAMT
. ;S ^TMP($J,"BAR-ATS",BARVISOU,BARAC,BARDOS,BARBILL)=BARBAMT_U_BARTAMT_U_DUZ(2) ;IHS/SD/AML 5/27/09 - Old code
. S ^TMP($J,"BAR-ATS",BARVISOU,BARAC,BARDOS,BARBILL,BARBAPP,BARHRN)=BARBAMT_U_BARTAMT_U_DUZ(2) ;IHS/SD/AML 5/27/09 - Add Appr date and HRN
Q
; *********************************************************************
;
BILLDATA ;
; Gather data from A/R Bill file.
F I=0:1:1 S BARBL(I)=$G(^BARBL(DUZ(2),BARBILL,I))
S BARBAMT=$P(BARBL(0),U,15) ; Current bill amount
S BARAC=$$GET1^DIQ(90050.01,BARBILL,3) ; A/R Account (external)
S:BARAC="" BARAC="NO A/R ACCOUNT"
S BARDOS=$P(BARBL(1),U,2) ; DOS Begin
I BARDOS="" S BARDOS=99
S BARVIS=$P(BARBL(1),U,8) ; Visit location
I +BARVIS S BARVISOU=$$GET1^DIQ(4,BARVIS,.01)
E S BARVISOU="NO VISIT LOCATION"
S BARBAPP=$P(BARBL(0),U,18) ;3P Approve date - IHS/SD/AML 4/13/09 - Added to make working ATS report easier
S BARHRN=$P(BARBL(1),U,7) ;HRN - IHS/SD/AML 4/13/09 - Added to make working ATS report easier
S:BARHRN="" BARHRN="NO HRN" ;Null if missing HRN
Q
; *********************************************************************
;
TRDATA ;
; Gather data for A/R Bill from A/R Transaction File via "AC" x-ref
; Find PSR transactions and do math to find balance
S (BARTR,BARTAMT)=0
F S BARTR=$O(^BARTR(DUZ(2),"AC",BARBILL,BARTR)) Q:'+BARTR D
. Q:'$D(^BARTR(DUZ(2),BARTR,0)) ; No transaction data
. F I=0:1:1 S BARTR(I)=$G(^BARTR(DUZ(2),BARTR,I))
. S BARTRTYP=$P(BARTR(1),U) ; Trans type (pointer)
. S BARADCAT=$P(BARTR(1),U,2) ; Adjust cat (pointer)
. S BARCDT=$P(BARTR(0),U,2)
. S BARDBT=$P(BARTR(0),U,3)
. ; IHS/SD/PKD 1.8*20 3/11/11 Include Sent to Collections as part of Adjustments
. ; 25 - Sent to Collections w/ TRANTYP = 993 - STATUS CHANGE
. ; I ",3,4,13,14,15,16,19,20,"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,"'[(","_BARTRTYP_",")) Q
. I ",3,4,13,14,15,16,19,20,25"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,993,"'[(","_BARTRTYP_",")) Q
. S BARTAMT=BARTAMT+BARDBT-BARCDT
Q
; *********************************************************************
; *********************************************************************
;
PRINT ;
; Print report
K BARRCNT,BARR1,BARR2,BARR3
S (BARRCNT,BARR1,BARR2,BARR3)=0 ;MRS:BAR*1.8*7 IM30525
S BAR("PG")=0
S BARDASH="W !?43,""---------- ---------- ----------"""
S BAREQUAL="W !?43,""========== ========== =========="""
D HDB ; Print page and column headers
I '$D(^TMP($J,"BAR-ATS")) D Q
. W !!!,"*** NO DATA TO PRINT ***"
. D EOP^BARUTL(0)
S BARVIS=""
F S BARVIS=$O(^TMP($J,"BAR-ATS",BARVIS)) Q:BARVIS=""!$G(BAR("F1")) D
. K BARVCNT,BARV1,BARV2,BARV3
. S (BARVCNT,BARV1,BARV2,BARV3)=0 ;MRS:BAR*1.8*7 IM30525
. W !!?5,"Visit Location: ",BARVIS,!
. S BARAC=""
. F S BARAC=$O(^TMP($J,"BAR-ATS",BARVIS,BARAC)) Q:BARAC=""!$G(BAR("F1")) D
. . S BARDOS=0
. . F S BARDOS=$O(^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS)) Q:'+BARDOS!$G(BAR("F1")) D
. . . S BARBILL=0
. . . F S BARBILL=$O(^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL)) Q:'+BARBILL!$G(BAR("F1")) D
. . . . ;IHS/SD/AML 5/27/09 - Added to ^TMP to allow Approval date and HRN to print on report
. . . . S BARBAPP=0
. . . . F S BARBAPP=$O(^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL,BARBAPP)) Q:'+BARBAPP!$G(BAR("F1")) D
. . . . . S BARHRN=0
. . . . . F S BARHRN=$O(^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL,BARBAPP,BARHRN)) Q:BARHRN=""!$G(BAR("F1")) D
. . . . . . S BARTMP=^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL,BARBAPP,BARHRN)
. . . . . . S BARHLD=DUZ(2)
. . . . . . S DUZ(2)=$P(BARTMP,U,3)
. . . . . . D PRNTLINE
. . . . . . I $G(BARY("RTYP"))=1 D HIST
. . . . . . S DUZ(2)=BARHLD
. . . . ;IHS/SD/AML 5/27/09 - End new code, begin old code
. . . . ;S BARTMP=^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL)
. . . . ;S BARHLD=DUZ(2)
. . . . ;S DUZ(2)=$P(BARTMP,U,3)
. . . . ;D PRNTLINE
. . . . ;I $G(BARY("RTYP"))=1 D HIST
. . . . ;S DUZ(2)=BARHLD
. . . . ;IHS/SD/AML 5/27/09 - End code changes to allow ^TMP global population of new fields
. X BARDASH
. W !," ** Visit Location Total (Bill cnt:"
. W ?37,$J(BARVCNT,4),")"
. W ?43,$J($FN(BARV1,",",2),10)
. W ?56,$J($FN(BARV2,",",2),10)
. W ?69,$J($FN(BARV3,",",2),10)
X BAREQUAL
W !,"*** REPORT TOTAL (Bill cnt:"
W ?37,$J(BARRCNT,4),")"
W ?43,$J($FN(BARR1,",",2),10)
W ?56,$J($FN(BARR2,",",2),10)
W ?69,$J($FN(BARR3,",",2),10)
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 ; Page header
W !?48,"BILL",?56,"TRANSACTION"
W !,"A/R BILL",?15,"DOS",?27,"A/R ACCOUNT",?46,"BALANCE"
W ?56,"HISTORY BAL",?69,"DIFFERENCE"
S $P(BAR("DASH"),"=",$S($D(BAR(132)):132,1:80))=""
W !,BAR("DASH"),!
Q
; *********************************************************************
;
PRNTLINE ;
; PRINT DATA LINES
S BARBAMT=$P(BARTMP,U)
S BARTAMT=$P(BARTMP,U,2)
S BARDIFF=BARBAMT-BARTAMT
;S BARBAPP=$G(BARBAPP) ;MRS:BAR*1.8*7 IM30525
;S BARHRN=$G(BARHRN) ;MRS:BAR*1.8*7 IM30525
I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))
W !,$E($$GET1^DIQ(90050.01,BARBILL,.01),1,12)
I BARDOS=99 W ?14,"NO DOS"
E W ?14,$$SDT^BARDUTL(BARDOS)
W ?26,$E(BARAC,1,15)
W ?43,$J($FN(BARBAMT,",",2),10)
W ?56,$J($FN(BARTAMT,",",2),10)
W ?69,$J($FN(BARDIFF,",",2),10)
;IHS/SD/AML 5/15/2008 - Begin new code - print additional items on ATS
W !,?3,"Appr Dt: "_$$CDT^BARDUTL(BARBAPP)_" ("_(BARBAPP)_")" ;IHS/SD/SDR 9/28/10
W ?47,"HRN: "_BARHRN ;IHS/SD/SDR 9/28/10
W ?64,$J($FN(($$GET1^DIQ(90050.01,BARBILL,13)),",",2),10) ;IHS/SD/SDR 9/28/10
W ?75,"[ ]" ;IHS/SD/SDR 9/28/10
;IHS/SD/AML 5/15/2008 - End new code - print additional lines on ATS
;
S BARVCNT=$G(BARVCNT)+1
S BARRCNT=$G(BARRCNT)+1
S BARV1=$G(BARV1)+BARBAMT
S BARV2=$G(BARV2)+BARTAMT
S BARV3=$G(BARV3)+BARDIFF
S BARR1=$G(BARR1)+BARBAMT
S BARR2=$G(BARR2)+BARTAMT
S BARR3=$G(BARR3)+BARDIFF
Q
; *********************************************************************
;
HIST ;
; Detail report...print transaction history
S (BARTR,BARTAMT,BARTBAL)=0
W !!?6,"TR DATE",?17,"TR TYPE",?33,"A/R ACCOUNT",?50,"TR AMOUNT",?65,"TR BALANCE"
W !?6,"----------",?17,"--------------",?33,"--------------",?50,"----------",?65,"----------" ;IHS/SD/SDR 9/28/10
F S BARTR=$O(^BARTR(DUZ(2),"AC",BARBILL,BARTR)) Q:'+BARTR!($G(BAR("F1"))) D
. Q:'$D(^BARTR(DUZ(2),BARTR,0)) ; No transaction data
. F I=0:1:1 S BARTR(I)=$G(^BARTR(DUZ(2),BARTR,I))
. S BARTRTYP=$P(BARTR(1),U) ; Trans type (pointer)
. S BARADCAT=$P(BARTR(1),U,2) ; Adjust cat (pointer)
. S BARCDT=$P(BARTR(0),U,2)
. S BARDBT=$P(BARTR(0),U,3)
. ;I ",3,4,13,14,15,16,19,20,"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,"'[(","_BARTRTYP_",")) Q ;bar*1.8*20
. ;include sent to collections
. I ",3,4,13,14,15,16,19,20,25"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,993,"'[(","_BARTRTYP_",")) Q ;bar*1.8*20
. ;
. S BARTAMT=BARDBT-BARCDT
. S BARTBAL=$G(BARTBAL)+BARTAMT
. I $Y>(IOSL-4) D HD Q:$G(BAR("F1"))
. ;I DUZ(0)="@" W !?2,BARTR ;IHS/SD/AML 5/27/09
. ;E W !?6,$$SDT^BARDUTL(BARTR) ;IHS/SD/AML 5/27/09
. W !?2,BARTR ;IHS/SD/AML 5/27/09
. W ?17,$E($$GET1^DIQ(90050.03,BARTR,101),1,14)
. W ?33,$E($$GET1^DIQ(90050.03,BARTR,6),1,14)
. W ?50,$J($FN(BARTAMT,",",2),10)
. W ?65,$J($FN(BARTBAL,",",2),10)
W ! F A=1:1:80 W "-" ;IHS/SD/SDR 9/28/10
W !
Q
BARRATS ; IHS/SD/LSL - File Synchronization ;09/15/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7,19,20,24**;OCT 26, 2005;Build 69
+2 ;
+3 ; IHS/SD/LSL - 06/04/02 - V1.6 Patch 2
+4 ; Routine created
+5 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+6 ;
+7 ; IHS/SD/POT HEAT141692 CHANGE DEFAULT VALUE (detail or summary) BAR*1.8*24
+8 ; *********************************************************************
+9 ;
+10 ; This routine will compare the Current Bill Amount of the A/R Bill
+11 ; File to the A/R Transaction history balance. If they are not
+12 ; equal, relevant data will be stored in a temp global. A report
+13 ; (A/R BILL AND TRANSACTION SYNCHRONIZATION REPORT) will be
+14 ; generated containing A/R Bill, Date of Service, A/R Account,
+15 ; Current Bill Amount, Transaction History Balance, and the
+16 ; difference between the two.
+17 ;
+18 ; The user may select a visit location for the report.
+19 ; The user may choose to print a detail report. If detail, then
+20 ; the transaction history will show as well (Transaction Date,
+21 ; Transaction Type, A/R Account, Transaction Amount, and
+22 ; Transaction Balance)
+23 ;
+24 ; *********************************************************************
+25 QUIT
+26 ; *********************************************************************
+27 ;
EN ; EP
+1 ;
+2 KILL BARY,BAR
+3 ; Set up basic A/R variables
IF '$DATA(BARUSR)
DO INIT^BARUTL
+4 ; Routine used to gather data
SET BARP("RTN")="BARRATS"
+5 ; Privacy act applies (used BARRHD)
SET BAR("PRIVACY")=1
+6 ; BILLING or VISIT
SET BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)
+7 IF BAR("LOC")=""
SET BAR("LOC")="VISIT"
+8 ; Message about BILLING/VISIT loc
DO MSG^BARRSEL
+9 ; Ask location - BARY("LOC")
DO LOC^BARRSL1
+10 IF $DATA">DATA(DTOUT)!($DATA">DATA(DUOUT))
QUIT
+11 IF '$DATA(BARY("LOC"))
WRITE "ALL"
+12 ; Ask Report type
DO RTYP
+13 IF $DATA">DATA(DTOUT)!($DATA">DATA(DUOUT))
QUIT
+14 ; Build header array
DO SETHDR
+15 ; Gather data
SET BARQ("RC")="COMPUTE^BARRATS"
+16 ; Print report
SET BARQ("RP")="PRINT^BARRATS"
+17 ; Namespace for variables
SET BARQ("NS")="BAR"
+18 ; Clean-up routine
SET BARQ("RX")="POUT^BARRUTL"
+19 ; Double queuing
DO ^BARDBQUE
+20 ; Press return to continue
DO PAZ^BARRUTL
+21 QUIT
+22 ; *********************************************************************
+23 ;
RTYP ;
+1 ; Ask report type (detail or summary)
+2 KILL DIR,BARY("RTYP")
+3 SET DIR(0)="SO^1:Detail;2:Summary"
+4 SET DIR("A")="Select TYPE of REPORT desired"
+5 ;P.OTT HEAT141692 CHANGE DEFAULT VALUE
SET DIR("B")=1
+6 SET DIR("?")="Select detail or summary. Detail contains transaction history"
+7 DO ^DIR
+8 KILL DIR
+9 IF $DATA">DATA(DUOUT)!$DATA">DATA(DTOUT)
QUIT
+10 SET BARY("RTYP")=Y
+11 SET BARY("RTYP","NM")=Y(0)
+12 QUIT
+13 ; *********************************************************************
+14 ;
SETHDR ;
+1 ; Build header array
+2 SET BAR("LVL")=0
+3 IF $GET(BARY("RTYP"))=2
SET BAR("HD",0)="SUMMARY "
+4 IF '$TEST
SET BAR("HD",0)="DETAIL "
+5 SET BAR("HD",0)=BAR("HD",0)_"A/R Bill and Transaction Synchronization Report"
+6 SET BAR("TXT")="ALL"
+7 IF $DATA(BARY("LOC"))
SET BAR("TXT")=$PIECE(^DIC(4,BARY("LOC"),0),U)
+8 IF BAR("LOC")="BILLING"
Begin DoDot:1
+9 SET BAR("TXT")=BAR("TXT")_" Visit location(s) under "
+10 SET BAR("TXT")=BAR("TXT")_$PIECE(^DIC(4,DUZ(2),0),U)
+11 SET BAR("TXT")=BAR("TXT")_" Billing Location"
End DoDot:1
+12 IF '$TEST
SET BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
+13 SET BAR("CONJ")="at "
+14 DO CHK^BARRHD
+15 QUIT
+16 ; *********************************************************************
+17 ; *********************************************************************
+18 ;
COMPUTE ;
+1 ; Build temporary data global
+2 KILL ^TMP($JOB,"BAR-ATS")
+3 IF BAR("LOC")="BILLING"
DO DATA
+4 IF '$TEST
DO LOOP
+5 QUIT
+6 ; *********************************************************************
LOOP ;
+1 SET BARDUZ=DUZ(2)
+2 SET DUZ(2)=0
+3 FOR
SET DUZ(2)=$ORDER(^BARBL(DUZ(2)))
IF '+DUZ(2)
QUIT
DO DATA
+4 SET DUZ(2)=BARDUZ
+5 QUIT
+6 ; *********************************************************************
+7 ;
DATA ;
+1 SET BARBILL=0
+2 FOR
SET BARBILL=$ORDER(^BARBL(DUZ(2),BARBILL))
IF '+BARBILL
QUIT
Begin DoDot:1
+3 ; No data on bill
IF '$DATA(^BARBL(DUZ(2),BARBILL,0))
QUIT
+4 ; Gather A/R Bill data
DO BILLDATA
+5 ; Not chosen visit location
IF $DATA(BARY("LOC"))
IF BARY("LOC")'=BARVIS
QUIT
+6 ; Gather A/R Transaction data
DO TRDATA
+7 ; Files are in sync
IF +BARBAMT=BARTAMT
QUIT
+8 SET BARDIF=BARBAMT-BARTAMT
+9 ;S ^TMP($J,"BAR-ATS",BARVISOU,BARAC,BARDOS,BARBILL)=BARBAMT_U_BARTAMT_U_DUZ(2) ;IHS/SD/AML 5/27/09 - Old code
+10 ;IHS/SD/AML 5/27/09 - Add Appr date and HRN
SET ^TMP($JOB,"BAR-ATS",BARVISOU,BARAC,BARDOS,BARBILL,BARBAPP,BARHRN)=BARBAMT_U_BARTAMT_U_DUZ(2)
End DoDot:1
+11 QUIT
+12 ; *********************************************************************
+13 ;
BILLDATA ;
+1 ; Gather data from A/R Bill file.
+2 FOR I=0:1:1
SET BARBL(I)=$GET(^BARBL(DUZ(2),BARBILL,I))
+3 ; Current bill amount
SET BARBAMT=$PIECE(BARBL(0),U,15)
+4 ; A/R Account (external)
SET BARAC=$$GET1^DIQ(90050.01,BARBILL,3)
+5 IF BARAC=""
SET BARAC="NO A/R ACCOUNT"
+6 ; DOS Begin
SET BARDOS=$PIECE(BARBL(1),U,2)
+7 IF BARDOS=""
SET BARDOS=99
+8 ; Visit location
SET BARVIS=$PIECE(BARBL(1),U,8)
+9 IF +BARVIS
SET BARVISOU=$$GET1^DIQ(4,BARVIS,.01)
+10 IF '$TEST
SET BARVISOU="NO VISIT LOCATION"
+11 ;3P Approve date - IHS/SD/AML 4/13/09 - Added to make working ATS report easier
SET BARBAPP=$PIECE(BARBL(0),U,18)
+12 ;HRN - IHS/SD/AML 4/13/09 - Added to make working ATS report easier
SET BARHRN=$PIECE(BARBL(1),U,7)
+13 ;Null if missing HRN
IF BARHRN=""
SET BARHRN="NO HRN"
+14 QUIT
+15 ; *********************************************************************
+16 ;
TRDATA ;
+1 ; Gather data for A/R Bill from A/R Transaction File via "AC" x-ref
+2 ; Find PSR transactions and do math to find balance
+3 SET (BARTR,BARTAMT)=0
+4 FOR
SET BARTR=$ORDER(^BARTR(DUZ(2),"AC",BARBILL,BARTR))
IF '+BARTR
QUIT
Begin DoDot:1
+5 ; No transaction data
IF '$DATA(^BARTR(DUZ(2),BARTR,0))
QUIT
+6 FOR I=0:1:1
SET BARTR(I)=$GET(^BARTR(DUZ(2),BARTR,I))
+7 ; Trans type (pointer)
SET BARTRTYP=$PIECE(BARTR(1),U)
+8 ; Adjust cat (pointer)
SET BARADCAT=$PIECE(BARTR(1),U,2)
+9 SET BARCDT=$PIECE(BARTR(0),U,2)
+10 SET BARDBT=$PIECE(BARTR(0),U,3)
+11 ; IHS/SD/PKD 1.8*20 3/11/11 Include Sent to Collections as part of Adjustments
+12 ; 25 - Sent to Collections w/ TRANTYP = 993 - STATUS CHANGE
+13 ; I ",3,4,13,14,15,16,19,20,"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,"'[(","_BARTRTYP_",")) Q
+14 IF ",3,4,13,14,15,16,19,20,25"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,993,"'[(","_BARTRTYP_","))
QUIT
+15 SET BARTAMT=BARTAMT+BARDBT-BARCDT
End DoDot:1
+16 QUIT
+17 ; *********************************************************************
+18 ; *********************************************************************
+19 ;
PRINT ;
+1 ; Print report
+2 KILL BARRCNT,BARR1,BARR2,BARR3
+3 ;MRS:BAR*1.8*7 IM30525
SET (BARRCNT,BARR1,BARR2,BARR3)=0
+4 SET BAR("PG")=0
+5 SET BARDASH="W !?43,""---------- ---------- ----------"""
+6 SET BAREQUAL="W !?43,""========== ========== =========="""
+7 ; Print page and column headers
DO HDB
+8 IF '$DATA(^TMP($JOB,"BAR-ATS"))
Begin DoDot:1
+9 WRITE !!!,"*** NO DATA TO PRINT ***"
+10 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+11 SET BARVIS=""
+12 FOR
SET BARVIS=$ORDER(^TMP($JOB,"BAR-ATS",BARVIS))
IF BARVIS=""!$GET(BAR("F1"))
QUIT
Begin DoDot:1
+13 KILL BARVCNT,BARV1,BARV2,BARV3
+14 ;MRS:BAR*1.8*7 IM30525
SET (BARVCNT,BARV1,BARV2,BARV3)=0
+15 WRITE !!?5,"Visit Location: ",BARVIS,!
+16 SET BARAC=""
+17 FOR
SET BARAC=$ORDER(^TMP($JOB,"BAR-ATS",BARVIS,BARAC))
IF BARAC=""!$GET(BAR("F1"))
QUIT
Begin DoDot:2
+18 SET BARDOS=0
+19 FOR
SET BARDOS=$ORDER(^TMP($JOB,"BAR-ATS",BARVIS,BARAC,BARDOS))
IF '+BARDOS!$GET(BAR("F1"))
QUIT
Begin DoDot:3
+20 SET BARBILL=0
+21 FOR
SET BARBILL=$ORDER(^TMP($JOB,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL))
IF '+BARBILL!$GET(BAR("F1"))
QUIT
Begin DoDot:4
+22 ;IHS/SD/AML 5/27/09 - Added to ^TMP to allow Approval date and HRN to print on report
+23 SET BARBAPP=0
+24 FOR
SET BARBAPP=$ORDER(^TMP($JOB,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL,BARBAPP))
IF '+BARBAPP!$GET(BAR("F1"))
QUIT
Begin DoDot:5
+25 SET BARHRN=0
+26 FOR
SET BARHRN=$ORDER(^TMP($JOB,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL,BARBAPP,BARHRN))
IF BARHRN=""!$GET(BAR("F1"))
QUIT
Begin DoDot:6
+27 SET BARTMP=^TMP($JOB,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL,BARBAPP,BARHRN)
+28 SET BARHLD=DUZ(2)
+29 SET DUZ(2)=$PIECE(BARTMP,U,3)
+30 DO PRNTLINE
+31 IF $GET(BARY("RTYP"))=1
DO HIST
+32 SET DUZ(2)=BARHLD
End DoDot:6
End DoDot:5
+33 ;IHS/SD/AML 5/27/09 - End new code, begin old code
+34 ;S BARTMP=^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL)
+35 ;S BARHLD=DUZ(2)
+36 ;S DUZ(2)=$P(BARTMP,U,3)
+37 ;D PRNTLINE
+38 ;I $G(BARY("RTYP"))=1 D HIST
+39 ;S DUZ(2)=BARHLD
+40 ;IHS/SD/AML 5/27/09 - End code changes to allow ^TMP global population of new fields
End DoDot:4
End DoDot:3
End DoDot:2
+41 XECUTE BARDASH
+42 WRITE !," ** Visit Location Total (Bill cnt:"
+43 WRITE ?37,$JUSTIFY(BARVCNT,4),")"
+44 WRITE ?43,$JUSTIFY($FNUMBER(BARV1,",",2),10)
+45 WRITE ?56,$JUSTIFY($FNUMBER(BARV2,",",2),10)
+46 WRITE ?69,$JUSTIFY($FNUMBER(BARV3,",",2),10)
End DoDot:1
+47 XECUTE BAREQUAL
+48 WRITE !,"*** REPORT TOTAL (Bill cnt:"
+49 WRITE ?37,$JUSTIFY(BARRCNT,4),")"
+50 WRITE ?43,$JUSTIFY($FNUMBER(BARR1,",",2),10)
+51 WRITE ?56,$JUSTIFY($FNUMBER(BARR2,",",2),10)
+52 WRITE ?69,$JUSTIFY($FNUMBER(BARR3,",",2),10)
+53 QUIT
+54 ; *********************************************************************
+55 ;
HD ; EP
+1 DO PAZ^BARRUTL
+2 IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
SET BAR("F1")=1
QUIT
+3 ;
HDB ; EP
+1 ; Page and column header
+2 SET BAR("PG")=BAR("PG")+1
+3 SET BAR("I")=""
+4 ; Page header
DO WHD^BARRHD
+5 WRITE !?48,"BILL",?56,"TRANSACTION"
+6 WRITE !,"A/R BILL",?15,"DOS",?27,"A/R ACCOUNT",?46,"BALANCE"
+7 WRITE ?56,"HISTORY BAL",?69,"DIFFERENCE"
+8 SET $PIECE(BAR("DASH"),"=",$SELECT($DATA(BAR(132)):132,1:80))=""
+9 WRITE !,BAR("DASH"),!
+10 QUIT
+11 ; *********************************************************************
+12 ;
PRNTLINE ;
+1 ; PRINT DATA LINES
+2 SET BARBAMT=$PIECE(BARTMP,U)
+3 SET BARTAMT=$PIECE(BARTMP,U,2)
+4 SET BARDIFF=BARBAMT-BARTAMT
+5 ;S BARBAPP=$G(BARBAPP) ;MRS:BAR*1.8*7 IM30525
+6 ;S BARHRN=$G(BARHRN) ;MRS:BAR*1.8*7 IM30525
+7 IF $Y>(IOSL-5)
DO HD
IF $GET(BAR("F1"))
QUIT
+8 WRITE !,$EXTRACT($$GET1^DIQ(90050.01,BARBILL,.01),1,12)
+9 IF BARDOS=99
WRITE ?14,"NO DOS"
+10 IF '$TEST
WRITE ?14,$$SDT^BARDUTL(BARDOS)
+11 WRITE ?26,$EXTRACT(BARAC,1,15)
+12 WRITE ?43,$JUSTIFY($FNUMBER(BARBAMT,",",2),10)
+13 WRITE ?56,$JUSTIFY($FNUMBER(BARTAMT,",",2),10)
+14 WRITE ?69,$JUSTIFY($FNUMBER(BARDIFF,",",2),10)
+15 ;IHS/SD/AML 5/15/2008 - Begin new code - print additional items on ATS
+16 ;IHS/SD/SDR 9/28/10
WRITE !,?3,"Appr Dt: "_$$CDT^BARDUTL(BARBAPP)_" ("_(BARBAPP)_")"
+17 ;IHS/SD/SDR 9/28/10
WRITE ?47,"HRN: "_BARHRN
+18 ;IHS/SD/SDR 9/28/10
WRITE ?64,$JUSTIFY($FNUMBER(($$GET1^DIQ(90050.01,BARBILL,13)),",",2),10)
+19 ;IHS/SD/SDR 9/28/10
WRITE ?75,"[ ]"
+20 ;IHS/SD/AML 5/15/2008 - End new code - print additional lines on ATS
+21 ;
+22 SET BARVCNT=$GET(BARVCNT)+1
+23 SET BARRCNT=$GET(BARRCNT)+1
+24 SET BARV1=$GET(BARV1)+BARBAMT
+25 SET BARV2=$GET(BARV2)+BARTAMT
+26 SET BARV3=$GET(BARV3)+BARDIFF
+27 SET BARR1=$GET(BARR1)+BARBAMT
+28 SET BARR2=$GET(BARR2)+BARTAMT
+29 SET BARR3=$GET(BARR3)+BARDIFF
+30 QUIT
+31 ; *********************************************************************
+32 ;
HIST ;
+1 ; Detail report...print transaction history
+2 SET (BARTR,BARTAMT,BARTBAL)=0
+3 WRITE !!?6,"TR DATE",?17,"TR TYPE",?33,"A/R ACCOUNT",?50,"TR AMOUNT",?65,"TR BALANCE"
+4 ;IHS/SD/SDR 9/28/10
WRITE !?6,"----------",?17,"--------------",?33,"--------------",?50,"----------",?65,"----------"
+5 FOR
SET BARTR=$ORDER(^BARTR(DUZ(2),"AC",BARBILL,BARTR))
IF '+BARTR!($GET(BAR("F1")))
QUIT
Begin DoDot:1
+6 ; No transaction data
IF '$DATA(^BARTR(DUZ(2),BARTR,0))
QUIT
+7 FOR I=0:1:1
SET BARTR(I)=$GET(^BARTR(DUZ(2),BARTR,I))
+8 ; Trans type (pointer)
SET BARTRTYP=$PIECE(BARTR(1),U)
+9 ; Adjust cat (pointer)
SET BARADCAT=$PIECE(BARTR(1),U,2)
+10 SET BARCDT=$PIECE(BARTR(0),U,2)
+11 SET BARDBT=$PIECE(BARTR(0),U,3)
+12 ;I ",3,4,13,14,15,16,19,20,"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,"'[(","_BARTRTYP_",")) Q ;bar*1.8*20
+13 ;include sent to collections
+14 ;bar*1.8*20
IF ",3,4,13,14,15,16,19,20,25"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,993,"'[(","_BARTRTYP_","))
QUIT
+15 ;
+16 SET BARTAMT=BARDBT-BARCDT
+17 SET BARTBAL=$GET(BARTBAL)+BARTAMT
+18 IF $Y>(IOSL-4)
DO HD
IF $GET(BAR("F1"))
QUIT
+19 ;I DUZ(0)="@" W !?2,BARTR ;IHS/SD/AML 5/27/09
+20 ;E W !?6,$$SDT^BARDUTL(BARTR) ;IHS/SD/AML 5/27/09
+21 ;IHS/SD/AML 5/27/09
WRITE !?2,BARTR
+22 WRITE ?17,$EXTRACT($$GET1^DIQ(90050.03,BARTR,101),1,14)
+23 WRITE ?33,$EXTRACT($$GET1^DIQ(90050.03,BARTR,6),1,14)
+24 WRITE ?50,$JUSTIFY($FNUMBER(BARTAMT,",",2),10)
+25 WRITE ?65,$JUSTIFY($FNUMBER(BARTBAL,",",2),10)
End DoDot:1
+26 ;IHS/SD/SDR 9/28/10
WRITE !
FOR A=1:1:80
WRITE "-"
+27 WRITE !
+28 QUIT
