Routine: BARDMXX

BARDMXX ; IHS/SD/LSL - Debt Letter Management Report of printed letters;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**23,24**;OCT 26, 2005;Build 69

 ;IHS/SD/POT New routine 5-SEP-2012 for Debt Letter Management- BAR*1.8*.23

 ;Routine to print report of printed letters for selected date / batch

 ;IHS/SD/POT NOHEAT AUG 2013 ADDED SELECTION BATCH / DATE RANGE - BAR*1.8*.23

 ;IHS/SD/POT HEAT152452 2/10/2014 CHK IF PAR/SAT FILE CORECTLY SET UP  - BAR*1.8*.24

 D INIT

 Q:$G(BARQ)  ;P.OTT HEAT152452 - BAR*1.8*.24

 D BARMODE I BARQ QUIT  ;SELECT REPORT SCOPE

 I BARMODE="B" D SEL I BARQ QUIT  ;SELECT BATCH

 I BARMODE="B" D BUILD(BARBAT),PRINT QUIT

 I BARMODE="D" D ASKFROM I BARQ QUIT  ;SELECT DATE FORM-TO AUG 2013 - BAR*1.8*.23

 ;(1575,"B",3130823.120044)

 S BARDT=BARFROM\1 F  S BARDT=$O(^BARDMLG(DUZ(2),"B",BARDT)) Q:+BARDT=0!(BARDT\1>BARTO)  D

 . S BARBAT="" F  S BARBAT=$O(^BARDMLG(DUZ(2),"B",BARDT,BARBAT)) Q:+BARBAT=0  D BUILD(BARBAT)

 D PRINT

INIT ;

 D PAR^BARDMU

 K ^TMP("BARDMQN",$J)

 Q:$G(BARQ)  ;HEAT152452 - BAR*1.8*.24

SEL ;

 W !!

 S (BARQ,BARREQ)=0

 S DIC="^BARDMLG("_DUZ(2)_","

 S DIC("A")="Enter the Debt Management Batch Date: "

 S DIC(0)="AEQ"

 D ^DIC

 I +Y<1 S BARQ=1 Q

 S BARBAT=+Y

BARMODE ;

 K DIRUT,DIR,Y

 S (BARQ,BARMODE)=0

 S Y=$$DIR^XBDIR("S^B:Select batch;D:Select date from - to","Select scope of the report ","","","","",1)

 K DA

 I (X[U) S BARQ=1 Q

 S BARMODE=Y

ASKFROM ;EP - ASK FROM DATE

 ;S BARJOB=$J

 S BARQ=0

 K %DT

 S %DT="AET"

 S %DT("A")="Enter beginning date: "

W !

 D ^%DT

 I X=""!(X[U) S BARQ=1 Q

 I Y<0 W !,"INVALID DATE. TRY AGAIN!" H 2 G ASKFROM

 S BARFROM=Y

ASKTO ;EP - ASK TO DATE

 K %DT

 S %DT="AET"

 S %DT("A")="Enter ending date: "

W !

 D ^%DT

 G:X=""!(X[U) ASKFROM

 I Y<0 W !,"INVALID DATE. TRY AGAIN!" H 2 G ASKTO

 S BARTO=Y

 I BARTO<BARFROM W !!,"END DATE MUST BE GREATER THAN BEGINNING DATE" H 2 G ASKFROM

BUILD(BARBAT) ;

 NEW BARBIEN,BARCNT,BARCY,BARCYCLE,BARD3P,BARD3PD,BARDM,BARDMINS

 S BARCY=0 F  S BARCY=$O(^BARDMLG(DUZ(2),BARBAT,100,BARCY))  Q:'BARCY  D

 . S BARCYCLE=$P(^BARDMLG(DUZ(2),BARBAT,100,BARCY,0),"^",1)

 . S BARCNT=0 F  S BARCNT=$O(^BARDMLG(DUZ(2),BARBAT,100,BARCY,10,BARCNT)) Q:'BARCNT  D

 . . S BARDM=^BARDMLG(DUZ(2),BARBAT,100,BARCY,10,BARCNT,0)

 . . S BARBIEN=$P(^BARDM(DUZ(2),BARDM,0),U)

 . . I '$D(^BARBL(DUZ(2),BARBIEN,0)) QUIT  ;11/19/2013

 . . S BARD3P=$P(^BARBL(DUZ(2),BARBIEN,0),U,17)

 . . S BARD3PD=$P($G(^BARBL(DUZ(2),BARBIEN,0)),U,22)

 . . S BARDMINS=$P($G(^ABMDBILL(BARD3PD,BARD3P,0)),U,8)

 . . S ^TMP("BARDMQN",$J,BARCYCLE,BARDM,1)=BARDMINS

PRINT D ^BARDMRQN

 Q  ;EOR

BARDMXX   ; IHS/SD/LSL - Debt Letter Management Report of printed letters;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**23,24**;OCT 26, 2005;Build 69

 +2       ;IHS/SD/POT New routine 5-SEP-2012 for Debt Letter Management- BAR*1.8*.23

 +3       ;Routine to print report of printed letters for selected date / batch

 +4       ;IHS/SD/POT NOHEAT AUG 2013 ADDED SELECTION BATCH / DATE RANGE - BAR*1.8*.23

 +5       ;IHS/SD/POT HEAT152452 2/10/2014 CHK IF PAR/SAT FILE CORECTLY SET UP  - BAR*1.8*.24

 +6        DO INIT

 +7       ;P.OTT HEAT152452 - BAR*1.8*.24

           IF $GET(BARQ)

               QUIT

 +8       ;SELECT REPORT SCOPE

           DO BARMODE

           IF BARQ

               QUIT

 +9       ;SELECT BATCH

           IF BARMODE="B"

               DO SEL

               IF BARQ

                   QUIT

 +10       IF BARMODE="B"

               DO BUILD(BARBAT)

               DO PRINT

               QUIT

 +11      ;SELECT DATE FORM-TO AUG 2013 - BAR*1.8*.23

           IF BARMODE="D"

               DO ASKFROM

               IF BARQ

                   QUIT

 +12      ;(1575,"B",3130823.120044)

 +13       SET BARDT=BARFROM\1

FOR

               SET BARDT=$ORDER(^BARDMLG(DUZ(2),"B",BARDT))

               IF +BARDT=0!(BARDT\1>BARTO)

                   QUIT

               Begin DoDot:1

 +14               SET BARBAT=""

FOR

                       SET BARBAT=$ORDER(^BARDMLG(DUZ(2),"B",BARDT,BARBAT))

                       IF +BARBAT=0

                           QUIT

                       DO BUILD(BARBAT)

               End DoDot:1

 +15       DO PRINT

 +16       QUIT

INIT      ;

 +1        DO PAR^BARDMU

 +2        KILL ^TMP("BARDMQN",$JOB)

 +3       ;HEAT152452 - BAR*1.8*.24

           IF $GET(BARQ)

               QUIT

 +4        QUIT

SEL       ;

 +1        WRITE !!

 +2        SET (BARQ,BARREQ)=0

 +3        SET DIC="^BARDMLG("_DUZ(2)_","

 +4        SET DIC("A")="Enter the Debt Management Batch Date: "

 +5        SET DIC(0)="AEQ"

 +6        DO ^DIC

 +7        IF +Y<1

               SET BARQ=1

               QUIT

 +8        SET BARBAT=+Y

 +9        QUIT

BARMODE   ;

 +1        KILL DIRUT,DIR,Y

 +2        SET (BARQ,BARMODE)=0

 +3        SET Y=$$DIR^XBDIR("S^B:Select batch;D:Select date from - to","Select scope of the report ","","","","",1)

 +4        KILL DA

 +5        IF (X[U)

               SET BARQ=1

               QUIT

 +6        SET BARMODE=Y

 +7        QUIT

ASKFROM   ;EP - ASK FROM DATE

 +1       ;S BARJOB=$J

 +2        SET BARQ=0

 +3        KILL %DT

 +4        SET %DT="AET"

 +5        SET %DT("A")="Enter beginning date: "

 +6        WRITE !

 +7        DO ^%DT

 +8        IF X=""!(X[U)

               SET BARQ=1

               QUIT

 +9        IF Y<0

               WRITE !,"INVALID DATE. TRY AGAIN!"

               HANG 2

               GOTO ASKFROM

 +10       SET BARFROM=Y

ASKTO     ;EP - ASK TO DATE

 +1        KILL %DT

 +2        SET %DT="AET"

 +3        SET %DT("A")="Enter ending date: "

 +4        WRITE !

 +5        DO ^%DT

 +6        IF X=""!(X[U)

               GOTO ASKFROM

 +7        IF Y<0

               WRITE !,"INVALID DATE. TRY AGAIN!"

               HANG 2

               GOTO ASKTO

 +8        SET BARTO=Y

 +9        IF BARTO<BARFROM

               WRITE !!,"END DATE MUST BE GREATER THAN BEGINNING DATE"

               HANG 2

               GOTO ASKFROM

 +10      ;

BUILD(BARBAT) ;

 +1        NEW BARBIEN,BARCNT,BARCY,BARCYCLE,BARD3P,BARD3PD,BARDM,BARDMINS

 +2        SET BARCY=0

FOR

               SET BARCY=$ORDER(^BARDMLG(DUZ(2),BARBAT,100,BARCY))

               IF 'BARCY

                   QUIT

               Begin DoDot:1

 +3                SET BARCYCLE=$PIECE(^BARDMLG(DUZ(2),BARBAT,100,BARCY,0),"^",1)

 +4                SET BARCNT=0

FOR

                       SET BARCNT=$ORDER(^BARDMLG(DUZ(2),BARBAT,100,BARCY,10,BARCNT))

                       IF 'BARCNT

                           QUIT

                       Begin DoDot:2

 +5                        SET BARDM=^BARDMLG(DUZ(2),BARBAT,100,BARCY,10,BARCNT,0)

 +6                        SET BARBIEN=$PIECE(^BARDM(DUZ(2),BARDM,0),U)

 +7       ;11/19/2013

                           IF '$DATA(^BARBL(DUZ(2),BARBIEN,0))

                               QUIT

 +8                        SET BARD3P=$PIECE(^BARBL(DUZ(2),BARBIEN,0),U,17)

 +9                        SET BARD3PD=$PIECE($GET(^BARBL(DUZ(2),BARBIEN,0)),U,22)

 +10                       SET BARDMINS=$PIECE($GET(^ABMDBILL(BARD3PD,BARD3P,0)),U,8)

 +11                       SET ^TMP("BARDMQN",$JOB,BARCYCLE,BARDM,1)=BARDMINS

                       End DoDot:2

               End DoDot:1

 +12       QUIT

PRINT      DO ^BARDMRQN

 +1       ;EOR

           QUIT

BARDMXX.m