BARRPTD ; IHS/SD/PKD - Payment Summary Report by TDN or Date Range ;05/25/2010
;;1.8;IHS ACCOUNTS RECEIVABLE;**19,23**;OCT 26, 2005
; IHS/SD/PKD - 05/25/10 - V1.8*19 Based on BARRPRP
; JULY 2013 FIXED BAREND IN DATE LOOP
Q
; *********************************************************************
;
EN ; EP
N TOTFIL,TCT,STR,LOC,LINE,QUIT,DUZ2
N BARTOT,BARTOT2,BARTOLD,BARSRT,BARSAT,BARIEN,BARLTOT
N BARGRDT,BARDASH,BARASK,SORT1,SORT2,SORTKEY,FILEHDR
D:'$D(BARUSR) INIT^BARUTL ; Setup basic A/R variables
S DUZ2=DUZ(2)
K ^TMP($J,"BAR-PTD")
S BARQ("RC")="COMPUTE^BARRPTD" ; Compute routine
S BARQ("RP")="PRINT^BARRPTD2" ; Print routine
S BARQ("NS")="BAR" ; Namespace for variables
S BARQ("RX")="POUT^BARRUTL" ; Clean-up routine
S BARP("RTN")="BARRPTD" ; Routine used to get data
;S BAR("PRIVACY")=1 ; Privacy act applies
S BAR("LOC")="BILLING" ; Location is ALWAYS billing
SLCT D ^BARRSEL ; Select exclusion parameters
Q:X="^"!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
I '$D(BARY("DT"))&('$D(BARY("TDN"))) W *7,!!,?10,"*** Dates or TDN's Required ***" G SLCT
I $D(BARY("DT"))
S LOC=DUZ(2)
S DUZ(2)=DUZ2
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
;
; Select entry of DATE RANGE or List of TDN's
SEL ;
K DIR ;
N BARTEXT
S DIR("A")="Output to Text Delimited File? "
S DIR(0)="Y;;"
S DIR("B")="N"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
S BARTEXT=Y
K DIR
;
I BARTEXT D ^%ZIS D COMPUTE Q
U IO
D ^BARDBQUE ; Double queuing
PAZ D POUT^BARRUTL ;D PAZ^BARRUTL
Q
; *********************************************************************
QUE ; EP
K IO("Q")
S ZTRTN="COMPUTE^BARRPTD",ZTDESC="TDN SUMMARY REPORT"
S ZTSAVE("BAR*")=""
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"REPORT CANCELLED!"
E W !!?5,"REQUEST QUEUED AS TASK # "_ZTSK,!
Q
;
DATES ;
; Ask Collection Batch Open Date Range
W !!," ============ Entry of COLLECTION BATCH DATE Range =============",!
K BARY("TDN") ; Dates **OR** TDN's
S BARSTART=$$DATE^BARDUTL(1)
I BARSTART<1 Q
I BARSTART>DT W *7,!,"Future dates invalid. Please re-enter." G DATES
S BAREND=$$DATE^BARDUTL(2)
I BAREND<1 W ! G DATES
I BAREND<BARSTART!(BAREND>DT) D G DATES
.W *7
.W !!,"The END date must not be before the START date, or Future Date.",!
S BARY("DT",1)=BARSTART
S BARY("DT",2)=BAREND
S BAREND=BAREND+.9
S BARY("DT")="CB"
Q
; ********************************************************************
;
COMPUTE ; EP BY Date Range
; Find bills matching criteria and store in ^TMP($J,"BAR-PTD")
K ^TMP($J,"BAR-PTD")
; Collection batch by Date Range
; Sort by Loc/Date/TDN/Collection Batch
I BARSRT=1 D DTS
I BARSRT=2 D TDN
I BARTEXT D
. D PRINT^BARRPTD2,POUT^BARRUTL
. N TP S TP="C IO U 0" X TP
Q
;
DTS S BARDT=BARSTART-1 ; DATE.TIME
F S BARDT=$O(^BARCOL(DUZ(2),"C",BARDT)) Q:((BARDT\1>BAREND)!(BARDT="")) D ;P.OTT
. S SORT1=$P(BARDT,"."),BARGRDT=0
. S BARIEN="" F S BARIEN=$O(^BARCOL(DUZ(2),"C",BARDT,BARIEN)) Q:'BARIEN D
. . S GLODATA=$G(^BARCOL(DUZ(2),BARIEN,0)) Q:GLODATA=""
. . N QUIT,VISLOC S QUIT=0
. . S VISLOC=$P(GLODATA,U,8) I $D(BARY("LOC")) D Q:QUIT
. . . I BARY("LOC")'=VISLOC S QUIT=1
. . S SORT2=$$GET1^DIQ(90051.01,BARIEN,28) I SORT2="" Q:SORT2="" ; TDN/IPAC - Sort
. . D DATA
Q
; ********************************************************************
;
TDN ; Pick-up all Collection batches w/ 1 TDN
S (BARIEN,BARTDN)=""
F S BARTDN=$O(BARY("TDN",BARTDN)) Q:BARTDN="" D
. F S BARIEN=$O(^BARCOL(DUZ(2),"E",BARTDN,BARIEN)) Q:BARIEN="" D
. . S GLODATA=$G(^BARCOL(DUZ(2),BARIEN,0)) Q:GLODATA=""
. . N QUIT,VISLOC S QUIT=0
. . S VISLOC=$P(GLODATA,U,8) I $D(BARY("LOC")) D Q:QUIT
. . . I BARY("LOC")'=VISLOC S QUIT=1
. . S SORT2=+$P(GLODATA,"^",4) ; Date Used for sort in ^TMP
. . S SORT1=$$GET1^DIQ(90051.01,BARIEN,28) ; Get the TDN/IPAC - use for Sort
. . D DATA
Q
; ********************************************************************
;
DATA ;
; Collect data for report
K BARB
S BARB("NAME")=$P(^BARCOL(DUZ(2),BARIEN,0),U) ;Collection batch name
S BARB("AMT")=$$GET1^DIQ(90051.01,BARIEN,15) ; Batched amount
S BARB("PST")=$$GET1^DIQ(90051.01,BARIEN,16) ; Batch posted amount
S BARB("UPST")=$$GET1^DIQ(90051.01,BARIEN,17) ; Batch unposted amount
S BARB("UNALL")=$$GET1^DIQ(90051.01,BARIEN,23) ; True Unallocated
S BARB("RFND")=$$GET1^DIQ(90051.01,BARIEN,22) ; Batch Refunded
S BARB("XFR")=$$GET1^DIQ(90051.01,BARIEN,560) ; Transfer Amount
; will save in string STR as: 15/16/23/22/560/17
; GrandTotalBatchedAmount:16
S STR=BARB("AMT")_","_BARB("PST")_","_BARB("UNALL")_","_BARB("RFND")_","_BARB("XFR")_","_BARB("UPST")
S ^TMP($J,"BAR-PTD",VISLOC,SORT1,SORT2,BARB("NAME"))=STR
S TOTFIL="^TMP($J,""BAR-PTD"",VISLOC)" D TOTALS(TOTFIL) ; Location totals
S TOTFIL="^TMP($J,""BAR-PTD"")" D TOTALS(TOTFIL) ; Grand Totals
Q
; ********************************************************************
;
TOTALS(TOTFIL) ; Accumulate Totals
S BARTOLD=$G(@TOTFIL)
S $P(BARTOLD,U)=$P(BARTOLD,U)+1 ;counter
; STR doesn't include a counter, SO piece in STR is 1 less
S $P(BARTOLD,U,2)=$P(BARTOLD,U,2)+$P(STR,",",1)
S $P(BARTOLD,U,3)=$P(BARTOLD,U,3)+$P(STR,",",2)
S $P(BARTOLD,U,4)=$P(BARTOLD,U,4)+$P(STR,",",3)
S $P(BARTOLD,U,5)=$P(BARTOLD,U,5)+$P(STR,",",4)
S $P(BARTOLD,U,6)=$P(BARTOLD,U,6)+$P(STR,",",5)
S $P(BARTOLD,U,7)=$P(BARTOLD,U,7)+$P(STR,",",6)
S @TOTFIL=BARTOLD
Q
;
BARRPTD ; IHS/SD/PKD - Payment Summary Report by TDN or Date Range ;05/25/2010
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**19,23**;OCT 26, 2005
+2 ; IHS/SD/PKD - 05/25/10 - V1.8*19 Based on BARRPRP
+3 ; JULY 2013 FIXED BAREND IN DATE LOOP
+4 QUIT
+5 ; *********************************************************************
+6 ;
EN ; EP
+1 NEW TOTFIL,TCT,STR,LOC,LINE,QUIT,DUZ2
+2 NEW BARTOT,BARTOT2,BARTOLD,BARSRT,BARSAT,BARIEN,BARLTOT
+3 NEW BARGRDT,BARDASH,BARASK,SORT1,SORT2,SORTKEY,FILEHDR
+4 ; Setup basic A/R variables
IF '$DATA(BARUSR)
DO INIT^BARUTL
+5 SET DUZ2=DUZ(2)
+6 KILL ^TMP($JOB,"BAR-PTD")
+7 ; Compute routine
SET BARQ("RC")="COMPUTE^BARRPTD"
+8 ; Print routine
SET BARQ("RP")="PRINT^BARRPTD2"
+9 ; Namespace for variables
SET BARQ("NS")="BAR"
+10 ; Clean-up routine
SET BARQ("RX")="POUT^BARRUTL"
+11 ; Routine used to get data
SET BARP("RTN")="BARRPTD"
+12 ;S BAR("PRIVACY")=1 ; Privacy act applies
+13 ; Location is ALWAYS billing
SET BAR("LOC")="BILLING"
SLCT ; Select exclusion parameters
DO ^BARRSEL
+1 IF X="^"!$DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+2 IF '$DATA">DATA(BARY("DT"))&('$DATA">DATA(BARY("TDN")))
WRITE *7,!!,?10,"*** Dates or TDN's Required ***"
GOTO SLCT
+3 IF $DATA(BARY("DT"))
+4 SET LOC=DUZ(2)
+5 SET DUZ(2)=DUZ2
+6 IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+7 ;
+8 ; Select entry of DATE RANGE or List of TDN's
SEL ;
+1 ;
KILL DIR
+2 NEW BARTEXT
+3 SET DIR("A")="Output to Text Delimited File? "
+4 SET DIR(0)="Y;;"
+5 SET DIR("B")="N"
+6 DO ^DIR
+7 IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+8 SET BARTEXT=Y
+9 KILL DIR
+10 ;
+11 IF BARTEXT
DO ^%ZIS
DO COMPUTE
QUIT
+12 USE IO
+13 ; Double queuing
DO ^BARDBQUE
PAZ ;D PAZ^BARRUTL
DO POUT^BARRUTL
+1 QUIT
+2 ; *********************************************************************
QUE ; EP
+1 KILL IO("Q")
+2 SET ZTRTN="COMPUTE^BARRPTD"
SET ZTDESC="TDN SUMMARY REPORT"
+3 SET ZTSAVE("BAR*")=""
+4 DO ^%ZTLOAD
+5 IF $DATA(ZTSK)[0
WRITE !!?5,"REPORT CANCELLED!"
+6 IF '$TEST
WRITE !!?5,"REQUEST QUEUED AS TASK # "_ZTSK,!
+7 QUIT
+8 ;
DATES ;
+1 ; Ask Collection Batch Open Date Range
+2 WRITE !!," ============ Entry of COLLECTION BATCH DATE Range =============",!
+3 ; Dates **OR** TDN's
KILL BARY("TDN")
+4 SET BARSTART=$$DATE^BARDUTL(1)
+5 IF BARSTART<1
QUIT
+6 IF BARSTART>DT
WRITE *7,!,"Future dates invalid. Please re-enter."
GOTO DATES
+7 SET BAREND=$$DATE^BARDUTL(2)
+8 IF BAREND<1
WRITE !
GOTO DATES
+9 IF BAREND<BARSTART!(BAREND>DT)
Begin DoDot:1
+10 WRITE *7
+11 WRITE !!,"The END date must not be before the START date, or Future Date.",!
End DoDot:1
GOTO DATES
+12 SET BARY("DT",1)=BARSTART
+13 SET BARY("DT",2)=BAREND
+14 SET BAREND=BAREND+.9
+15 SET BARY("DT")="CB"
+16 QUIT
+17 ; ********************************************************************
+18 ;
COMPUTE ; EP BY Date Range
+1 ; Find bills matching criteria and store in ^TMP($J,"BAR-PTD")
+2 KILL ^TMP($JOB,"BAR-PTD")
+3 ; Collection batch by Date Range
+4 ; Sort by Loc/Date/TDN/Collection Batch
+5 IF BARSRT=1
DO DTS
+6 IF BARSRT=2
DO TDN
+7 IF BARTEXT
Begin DoDot:1
+8 DO PRINT^BARRPTD2
DO POUT^BARRUTL
+9 NEW TP
SET TP="C IO U 0"
XECUTE TP
End DoDot:1
+10 QUIT
+11 ;
DTS ; DATE.TIME
SET BARDT=BARSTART-1
+1 ;P.OTT
FOR
SET BARDT=$ORDER(^BARCOL(DUZ(2),"C",BARDT))
IF ((BARDT\1>BAREND)!(BARDT=""))
QUIT
Begin DoDot:1
+2 SET SORT1=$PIECE(BARDT,".")
SET BARGRDT=0
+3 SET BARIEN=""
FOR
SET BARIEN=$ORDER(^BARCOL(DUZ(2),"C",BARDT,BARIEN))
IF 'BARIEN
QUIT
Begin DoDot:2
+4 SET GLODATA=$GET(^BARCOL(DUZ(2),BARIEN,0))
IF GLODATA=""
QUIT
+5 NEW QUIT,VISLOC
SET QUIT=0
+6 SET VISLOC=$PIECE(GLODATA,U,8)
IF $DATA(BARY("LOC"))
Begin DoDot:3
+7 IF BARY("LOC")'=VISLOC
SET QUIT=1
End DoDot:3
IF QUIT
QUIT
+8 ; TDN/IPAC - Sort
SET SORT2=$$GET1^DIQ(90051.01,BARIEN,28)
IF SORT2=""
IF SORT2=""
QUIT
+9 DO DATA
End DoDot:2
End DoDot:1
+10 QUIT
+11 ; ********************************************************************
+12 ;
TDN ; Pick-up all Collection batches w/ 1 TDN
+1 SET (BARIEN,BARTDN)=""
+2 FOR
SET BARTDN=$ORDER(BARY("TDN",BARTDN))
IF BARTDN=""
QUIT
Begin DoDot:1
+3 FOR
SET BARIEN=$ORDER(^BARCOL(DUZ(2),"E",BARTDN,BARIEN))
IF BARIEN=""
QUIT
Begin DoDot:2
+4 SET GLODATA=$GET(^BARCOL(DUZ(2),BARIEN,0))
IF GLODATA=""
QUIT
+5 NEW QUIT,VISLOC
SET QUIT=0
+6 SET VISLOC=$PIECE(GLODATA,U,8)
IF $DATA(BARY("LOC"))
Begin DoDot:3
+7 IF BARY("LOC")'=VISLOC
SET QUIT=1
End DoDot:3
IF QUIT
QUIT
+8 ; Date Used for sort in ^TMP
SET SORT2=+$PIECE(GLODATA,"^",4)
+9 ; Get the TDN/IPAC - use for Sort
SET SORT1=$$GET1^DIQ(90051.01,BARIEN,28)
+10 DO DATA
End DoDot:2
End DoDot:1
+11 QUIT
+12 ; ********************************************************************
+13 ;
DATA ;
+1 ; Collect data for report
+2 KILL BARB
+3 ;Collection batch name
SET BARB("NAME")=$PIECE(^BARCOL(DUZ(2),BARIEN,0),U)
+4 ; Batched amount
SET BARB("AMT")=$$GET1^DIQ(90051.01,BARIEN,15)
+5 ; Batch posted amount
SET BARB("PST")=$$GET1^DIQ(90051.01,BARIEN,16)
+6 ; Batch unposted amount
SET BARB("UPST")=$$GET1^DIQ(90051.01,BARIEN,17)
+7 ; True Unallocated
SET BARB("UNALL")=$$GET1^DIQ(90051.01,BARIEN,23)
+8 ; Batch Refunded
SET BARB("RFND")=$$GET1^DIQ(90051.01,BARIEN,22)
+9 ; Transfer Amount
SET BARB("XFR")=$$GET1^DIQ(90051.01,BARIEN,560)
+10 ; will save in string STR as: 15/16/23/22/560/17
+11 ; GrandTotalBatchedAmount:16
+12 SET STR=BARB("AMT")_","_BARB("PST")_","_BARB("UNALL")_","_BARB("RFND")_","_BARB("XFR")_","_BARB("UPST")
+13 SET ^TMP($JOB,"BAR-PTD",VISLOC,SORT1,SORT2,BARB("NAME"))=STR
+14 ; Location totals
SET TOTFIL="^TMP($J,""BAR-PTD"",VISLOC)"
DO TOTALS(TOTFIL)
+15 ; Grand Totals
SET TOTFIL="^TMP($J,""BAR-PTD"")"
DO TOTALS(TOTFIL)
+16 QUIT
+17 ; ********************************************************************
+18 ;
TOTALS(TOTFIL) ; Accumulate Totals
+1 SET BARTOLD=$GET(@TOTFIL)
+2 ;counter
SET $PIECE(BARTOLD,U)=$PIECE(BARTOLD,U)+1
+3 ; STR doesn't include a counter, SO piece in STR is 1 less
+4 SET $PIECE(BARTOLD,U,2)=$PIECE(BARTOLD,U,2)+$PIECE(STR,",",1)
+5 SET $PIECE(BARTOLD,U,3)=$PIECE(BARTOLD,U,3)+$PIECE(STR,",",2)
+6 SET $PIECE(BARTOLD,U,4)=$PIECE(BARTOLD,U,4)+$PIECE(STR,",",3)
+7 SET $PIECE(BARTOLD,U,5)=$PIECE(BARTOLD,U,5)+$PIECE(STR,",",4)
+8 SET $PIECE(BARTOLD,U,6)=$PIECE(BARTOLD,U,6)+$PIECE(STR,",",5)
+9 SET $PIECE(BARTOLD,U,7)=$PIECE(BARTOLD,U,7)+$PIECE(STR,",",6)
+10 SET @TOTFIL=BARTOLD
+11 QUIT
+12 ;
