Routine: BARRPTD

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

 ; *********************************************************************

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

 ; *********************************************************************

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,!

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"

 ; ********************************************************************

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

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

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

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

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      ;

BARRPTD.m