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
Q
INIT ;
D PAR^BARDMU
K ^TMP("BARDMQN",$J)
Q:$G(BARQ) ;HEAT152452 - BAR*1.8*.24
Q
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
Q
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
Q
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
Q
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
