BARBL ; IHS/SD/LSL - AGE DAY LETTER AND LIST ; 07/30/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,23**;OCT 26, 2005
; NOV 2012 P.OTTIS HEAT #75153 ADDED PAT DOB
; SPLIT LONG BILL #
; JAN 2013 ADDED PAT SSN
; MAY 2013 HEAT 117349 UNDEF BARA(.01)
; AUG 2013 FIXED UNDEF ENTRY IN ^BARBL (YAKAMA) ONEAC+3
; OCT 2013 REFORMATING DOB & LONG NAMES BETA P23 10/24/2013
;*************************************************************
W !!,"Enter the minimum age (in days) of bills to be itemized."
K DIR
S DIR(0)="N0^0:9000"
D ^DIR
K DIR
Q:Y'>0
S BARAGE=Y
D SELACC
Q:$G(BARQUIT)
S DIR("A")="Summary Only"
S DIR("B")="NO"
S DIR(0)="Y"
D ^DIR
K DIR
S BARSUM=Y
S BARSBY=1
I '$G(BARSUM) D
.S DIR(0)="S^1:POLICY HOLDER;2:POLICY NUMBER;3:PATIENT;4:DATE OF SERVICE"
.S DIR("A")="Within Account Sort By"
.S DIR("B")=1
.D ^DIR
.K DIR
.S BARSBY=Y
S %ZIS="NQ"
S %ZIS("A")="Print to Device: "
D ^%ZIS
Q:POP
I IO'=IO(0) D QUE,EXIT,HOME^%ZIS Q
I $D(IO("S")) D
. S IOP=ION
. D ^%ZIS
;
AGE ; *
; * dequeing compute point
K ^TMP("BAR",$J,"BLAGE")
S BARSVC=$$GET1^DIQ(200,DUZ,29)
I '$D(BARSAC) D
.S BARACDA=0
.F S BARACDA=$O(^BARBL(DUZ(2),"ABAL",BARACDA)) Q:'BARACDA D ONEAC
I $D(BARSAC) D
.S BARACDA=0
.F S BARACDA=$O(BARSAC(BARACDA)) Q:'BARACDA D ONEAC
D PRINT
I $D(IO("S")) D ^%ZISC
D EXIT
Q
; *********************************************************************
;
ONEAC ;ONE A/R ACCOUNT
S DA=0
F S DA=$O(^BARBL(DUZ(2),"ABAL",BARACDA,DA)) Q:'DA D
.I '$D(^BARBL(DUZ(2),DA)) Q ;P.OTT
.K BART
.D ENP^XBDIQ1(90050.01,DA,"3;7.2;10;15","BART(","I")
.I BART(7.2)<BARAGE Q ;age
.I BART(10)'=BARSVC Q ;SVC
.S BARSVAL=$G(^BARBL(DUZ(2),DA,7))
.Q:BARSVAL="" ;MRS:BAR*1.8*6 IM29966
.S $P(BARSVAL,"^",3)=$P(^BARBL(DUZ(2),DA,1),"^",16)
.S $P(BARSVAL,"^",4)=$P(^BARBL(DUZ(2),DA,1),"^",2)
.S BARSVAL=$P(BARSVAL,"^",BARSBY)
.S:BARSVAL="" BARSVAL="UNKNOWN"
.S ^TMP("BAR",$J,"BLAGE",BARACDA,BARSVAL,DA)=BART(15)
.S ^TMP("BAR",$J,"BLAGE",BARACDA)=$G(^TMP("BAR",$J,"BLAGE",BARACDA))+BART(15)
Q
; *********************************************************************
;
PRINT ;
;** deque for print
D SUMMARY
Q:$G(BARQUIT)
Q:$G(BARSUM)
S BARACDA=0
F S BARACDA=$O(^TMP("BAR",$J,"BLAGE",BARACDA)) Q:BARACDA'>0 S BARTOT=^(BARACDA) Q:$G(BARQUIT) D
.K BARA
.D ENP^XBDIQ1(90050.02,BARACDA,".01;1:1.99","BARA(","N")
.D LETTER
.Q:$G(BARQUIT)
.D LIST
Q
; *********************************************************************
;
LETTER ;
; ** print letter
W $$EN^BARVDF("IOF")
D ENP^XBDIQ1(90052.03,2,".01;100","BARLT(")
S BARL=0
;** header
F BARL=BARL+1:1 Q:'$D(BARLT(100,BARL)) Q:$E(BARLT(100,BARL))="~" W !,BARLT(100,BARL)
;** address
W !,"DATE:",?10,$$MDT2^BARDUTL(DT)
;W !!,"TO:",?10,BARA(.01)
W !!,"TO:",?10,$G(BARA(.01)) ;BAR*1.8*4 IM????? OCCURRED DURING BETA TESTING
S DR=1.01
;W !,?10,BARA(1.01)
W !,?10,$G(BARA(1.01)) ;IHS/SD/TPF BAR*1.8*3 IM25704
F S DR=$O(BARA(DR)) Q:DR'>0 W !,?10,BARA(DR)
;** from
S BARFDA=$$GET1^DIQ(9002274.5,1,.23,"I")
G:BARFDA'>0 CNT
K BARF
D ENP^XBDIQ1(9999999.06,BARFDA,".14:.17","BARF(")
W !!,"FROM: ",$G(BARUSR(29))," address for payments"
W !,?5,BARF(.14)
W !,?5,BARF(.15)
W !,?5,BARF(.16)
W !,?5,BARF(.17)
K BARF
CNT F BARL=BARL+1:1 Q:'$D(BARLT(100,BARL)) Q:$E(BARLT(100,BARL))="~" W !,BARLT(100,BARL)
;** regarding
W !,"Regarding Past due bills over ",BARAGE," days totaling $ ",$FN(BARTOT,",",2)
;** body
F BARL=BARL+1:1 Q:'$D(BARLT(100,BARL)) Q:$E(BARLT(100,BARL))="~" W !,BARLT(100,BARL)
F BARL=BARL+1:1 Q:'$D(BARLT(100,BARL)) Q:$E(BARLT(100,BARL))="~" W !,BARLT(100,BARL)
D EOP
Q
; *********************************************************************
;
LIST ;** list bills
NEW BARTMP1,BARTMP2,BARSSN
S BARBLDA=0,BARSVAL=0
S BARPG("HDR")=$G(BARA(.01),"UNKNOWN")_" over "_BARAGE_" days" ;P.OTT MAY 2013
D BARHDR
F S BARSVAL=$O(^TMP("BAR",$J,"BLAGE",BARACDA,BARSVAL)) Q:BARSVAL="" D
.F S BARBLDA=$O(^TMP("BAR",$J,"BLAGE",BARACDA,BARSVAL,BARBLDA)) Q:BARBLDA'>0 Q:$G(BARQUIT) D Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))
..K BARB
..D ENP^XBDIQ1(90050.01,BARBLDA,".01;101;102;13;15;7.2;701;702","BARB(","I")
.. S BARPIEN=$P(^BARBL(DUZ(2),BARBLDA,1),U)
.. S BARDOB=$$GET1^DIQ(2,BARPIEN,".03","E")
.. S BARSSN=$P($G(^DPT(BARPIEN,0)),U,9) ;S BARSSN=$P($G(^DPT(BARPTDA,0)),U,9)
..W !,$E(BARB(701),1,22)
..W ?25,$E(BARB(702),1,12)
..S BARTMP2=BARB(.01),BARTMP1=$P(BARTMP2,"-"),BARTMP2=$P(BARTMP2,"-",2,99)
..W ?39,BARTMP1
..W ?49,$$FMDT(BARB(102,"I"))
..W ?58,$J(BARB(13),10,2)
..W ?69,$J(BARB(15),10,2)
..W !,"Pat: ",BARB(101)
..I BARTMP2]"" W ?39,BARTMP2
..W ?49,BARDOB
..W !,BARSSN
..;;;;W !,"Pat DOB: "
..W " Comment:"
..F W "_" Q:$X+3>IOM
.. ;-----------------------------------
..W !
..I $Y+4>IOSL D
...D EOP
...D PG
W !!,"TOTAL: ",?67,$J("$"_$FN(BARTOT,",",2),12)
D EOP
Q
; *********************************************************************
;
SUMMARY ;
S BARPG("HDR")="Summary of bills/accounts over "_BARAGE_" days"
D BARHDR
S (BARAC,BARTOT,BARCNT)=0
F S BARAC=$O(^TMP("BAR",$J,"BLAGE",BARAC)) Q:BARAC'>0 Q:$G(BARQUIT) S X=^(BARAC) S BARTOT=BARTOT+X D Q:$G(BARQUIT)
.W !,$$GET1^DIQ(90050.02,BARAC,.01),?50,$J($FN(X,",",2),12)
.Q:$Y+6'>IOSL
.D EOP
.D PG
Q:$G(BARQUIT)
W !!,"TOTAL ALL ACCOUNTS:",?50,$J($FN(BARTOT,",",2),12),!!
W !!,?15,"E N D O F R E P O R T",!!
D EOP
Q
; *********************************************************************
;
SELACC ;
; ** select accounts to print
K BARSAC
W !,"Select individual A/R accounts or hit RETURN for ALL accounts."
S DIC=$$DIC^XBDIQ1(90050.02)
S DIC(0)="AEQMZ"
S DIC("S")="I $P(^(0),U,10)=$$VALI^XBDIQ1(200,DUZ,29)"
F D ^DIC Q:Y'>0 S BARSAC(+Y)=Y(0,0)
Q:'$D(BARSAC)
S DA=0
W !
F S DA=$O(BARSAC(DA)) Q:'DA W !,BARSAC(DA)
W !
K DIR
S DIR(0)="Y"
S DIR("B")="YES"
S DIR("A")="Selected Account(s) Correct"
D ^DIR
I Y Q
K BARSAC
G SELACC
; *********************************************************************
;
FMDT(X) ;
; cvt fmdt to mm/dd/yyyy
S X=$$SDT^BARDUTL(X)
Q X
; *********************************************************************
;
PG ;
BARPG ;EP PAGE CONTROLLER
; this utility uses variables BARPG("HDR"),BARPG("DT"),BARPG("LINE"),BARPG("PG")
; kill variables by D EBARPG
;
S BARPG("PG")=+$G(BARPG("PG"))+1
;
BARHDR ;EP
; write page header
W $$EN^BARVDF("IOF")
W !
Q:'$D(BARPG("HDR"))
S:'$D(BARPG("LINE")) $P(BARPG("LINE"),"=",IOM)=""
S:'$D(BARDASH) $P(BARDASH,"-",IOM)=""
S:'$D(BARPG("PG")) BARPG("PG")=1
W ?(IOM-40-$L(BARPG("HDR"))/2),BARPG("HDR")
W ?(IOM-24),$$SDT^BARDUTL(DT)
W ?(IOM-10),"PAGE: ",BARPG("PG")
W !,BARPG("LINE")
;
BARHD ;EP
; Write column header / message
W !
I BARPG("HDR")'["mmary" D
. W "Policy Holder",?25,"Policy #",?39,"Claim #",?49,"DOS",?58,$J("Amt Bld",10),?69,$J("Balance",10)
. W !,"PT. SS #",?49,"DOB"
W !,BARDASH,!
Q
; *********************************************************************
;
EBARPG ;
K BARPG("LINE"),BARPG("PG"),BARPG("HDR"),BARPG("DT")
Q
; *********************************************************************
;
QUE ;QUE
N I
F I="BARSAC*","BARSBY","BARAGE","BARSUM" S ZTSAVE(I)=""
S ZTRTN="AGE^BARBL"
S ZTDESC="AGED DAY LETTER"
K ZTSK
D ^%ZTLOAD
W:$G(ZTSK) !,"Task # ",ZTSK," queued.",!
Q
; *********************************************************************
;
EXIT ;clean up and quit
K DIC,BARSAC,BARSBY,BARA,BARB,BARPG,BARAC,BARACDA,BARAGE,BARBLDS
K BARCNT,BARFDA,BARJOB,BARL,BARLT,BARQUIT,BARSVAL,BARSVC,BART,BARTOT
W $$EN^BARVDF("IOF")
Q
; *********************************************************************
;
EOP ;end of page
I IO=IO(0),'$D(IO("S")),'$G(ZTQUEUED) D
.F W ! Q:$Y+4>IOSL
.D EOP^BARUTL(0)
.S:'Y BARQUIT=1
Q
BARBL ; IHS/SD/LSL - AGE DAY LETTER AND LIST ; 07/30/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,23**;OCT 26, 2005
+2 ; NOV 2012 P.OTTIS HEAT #75153 ADDED PAT DOB
+3 ; SPLIT LONG BILL #
+4 ; JAN 2013 ADDED PAT SSN
+5 ; MAY 2013 HEAT 117349 UNDEF BARA(.01)
+6 ; AUG 2013 FIXED UNDEF ENTRY IN ^BARBL (YAKAMA) ONEAC+3
+7 ; OCT 2013 REFORMATING DOB & LONG NAMES BETA P23 10/24/2013
+8 ;*************************************************************
+9 WRITE !!,"Enter the minimum age (in days) of bills to be itemized."
+10 KILL DIR
+11 SET DIR(0)="N0^0:9000"
+12 DO ^DIR
+13 KILL DIR
+14 IF Y'>0
QUIT
+15 SET BARAGE=Y
+16 DO SELACC
+17 IF $GET(BARQUIT)
QUIT
+18 SET DIR("A")="Summary Only"
+19 SET DIR("B")="NO"
+20 SET DIR(0)="Y"
+21 DO ^DIR
+22 KILL DIR
+23 SET BARSUM=Y
+24 SET BARSBY=1
+25 IF '$GET(BARSUM)
Begin DoDot:1
+26 SET DIR(0)="S^1:POLICY HOLDER;2:POLICY NUMBER;3:PATIENT;4:DATE OF SERVICE"
+27 SET DIR("A")="Within Account Sort By"
+28 SET DIR("B")=1
+29 DO ^DIR
+30 KILL DIR
+31 SET BARSBY=Y
End DoDot:1
+32 SET %ZIS="NQ"
+33 SET %ZIS("A")="Print to Device: "
+34 DO ^%ZIS
+35 IF POP
QUIT
+36 IF IO'=IO(0)
DO QUE
DO EXIT
DO HOME^%ZIS
QUIT
+37 IF $DATA(IO("S"))
Begin DoDot:1
+38 SET IOP=ION
+39 DO ^%ZIS
End DoDot:1
+40 ;
AGE ; *
+1 ; * dequeing compute point
+2 KILL ^TMP("BAR",$JOB,"BLAGE")
+3 SET BARSVC=$$GET1^DIQ(200,DUZ,29)
+4 IF '$DATA(BARSAC)
Begin DoDot:1
+5 SET BARACDA=0
+6 FOR
SET BARACDA=$ORDER(^BARBL(DUZ(2),"ABAL",BARACDA))
IF 'BARACDA
QUIT
DO ONEAC
End DoDot:1
+7 IF $DATA(BARSAC)
Begin DoDot:1
+8 SET BARACDA=0
+9 FOR
SET BARACDA=$ORDER(BARSAC(BARACDA))
IF 'BARACDA
QUIT
DO ONEAC
End DoDot:1
+10 DO PRINT
+11 IF $DATA(IO("S"))
DO ^%ZISC
+12 DO EXIT
+13 QUIT
+14 ; *********************************************************************
+15 ;
ONEAC ;ONE A/R ACCOUNT
+1 SET DA=0
+2 FOR
SET DA=$ORDER(^BARBL(DUZ(2),"ABAL",BARACDA,DA))
IF 'DA
QUIT
Begin DoDot:1
+3 ;P.OTT
IF '$DATA(^BARBL(DUZ(2),DA))
QUIT
+4 KILL BART
+5 DO ENP^XBDIQ1(90050.01,DA,"3;7.2;10;15","BART(","I")
+6 ;age
IF BART(7.2)<BARAGE
QUIT
+7 ;SVC
IF BART(10)'=BARSVC
QUIT
+8 SET BARSVAL=$GET(^BARBL(DUZ(2),DA,7))
+9 ;MRS:BAR*1.8*6 IM29966
IF BARSVAL=""
QUIT
+10 SET $PIECE(BARSVAL,"^",3)=$PIECE(^BARBL(DUZ(2),DA,1),"^",16)
+11 SET $PIECE(BARSVAL,"^",4)=$PIECE(^BARBL(DUZ(2),DA,1),"^",2)
+12 SET BARSVAL=$PIECE(BARSVAL,"^",BARSBY)
+13 IF BARSVAL=""
SET BARSVAL="UNKNOWN"
+14 SET ^TMP("BAR",$JOB,"BLAGE",BARACDA,BARSVAL,DA)=BART(15)
+15 SET ^TMP("BAR",$JOB,"BLAGE",BARACDA)=$GET(^TMP("BAR",$JOB,"BLAGE",BARACDA))+BART(15)
End DoDot:1
+16 QUIT
+17 ; *********************************************************************
+18 ;
PRINT ;
+1 ;** deque for print
+2 DO SUMMARY
+3 IF $GET(BARQUIT)
QUIT
+4 IF $GET(BARSUM)
QUIT
+5 SET BARACDA=0
+6 FOR
SET BARACDA=$ORDER(^TMP("BAR",$JOB,"BLAGE",BARACDA))
IF BARACDA'>0
QUIT
SET BARTOT=^(BARACDA)
IF $GET(BARQUIT)
QUIT
Begin DoDot:1
+7 KILL BARA
+8 DO ENP^XBDIQ1(90050.02,BARACDA,".01;1:1.99","BARA(","N")
+9 DO LETTER
+10 IF $GET(BARQUIT)
QUIT
+11 DO LIST
End DoDot:1
+12 QUIT
+13 ; *********************************************************************
+14 ;
LETTER ;
+1 ; ** print letter
+2 WRITE $$EN^BARVDF("IOF")
+3 DO ENP^XBDIQ1(90052.03,2,".01;100","BARLT(")
+4 SET BARL=0
+5 ;** header
+6 FOR BARL=BARL+1:1
IF '$DATA(BARLT(100,BARL))
QUIT
IF $EXTRACT(BARLT(100,BARL))="~"
QUIT
WRITE !,BARLT(100,BARL)
+7 ;** address
+8 WRITE !,"DATE:",?10,$$MDT2^BARDUTL(DT)
+9 ;W !!,"TO:",?10,BARA(.01)
+10 ;BAR*1.8*4 IM????? OCCURRED DURING BETA TESTING
WRITE !!,"TO:",?10,$GET(BARA(.01))
+11 SET DR=1.01
+12 ;W !,?10,BARA(1.01)
+13 ;IHS/SD/TPF BAR*1.8*3 IM25704
WRITE !,?10,$GET(BARA(1.01))
+14 FOR
SET DR=$ORDER(BARA(DR))
IF DR'>0
QUIT
WRITE !,?10,BARA(DR)
+15 ;** from
+16 SET BARFDA=$$GET1^DIQ(9002274.5,1,.23,"I")
+17 IF BARFDA'>0
GOTO CNT
+18 KILL BARF
+19 DO ENP^XBDIQ1(9999999.06,BARFDA,".14:.17","BARF(")
+20 WRITE !!,"FROM: ",$GET(BARUSR(29))," address for payments"
+21 WRITE !,?5,BARF(.14)
+22 WRITE !,?5,BARF(.15)
+23 WRITE !,?5,BARF(.16)
+24 WRITE !,?5,BARF(.17)
+25 KILL BARF
CNT FOR BARL=BARL+1:1
IF '$DATA(BARLT(100,BARL))
QUIT
IF $EXTRACT(BARLT(100,BARL))="~"
QUIT
WRITE !,BARLT(100,BARL)
+1 ;** regarding
+2 WRITE !,"Regarding Past due bills over ",BARAGE," days totaling $ ",$FNUMBER(BARTOT,",",2)
+3 ;** body
+4 FOR BARL=BARL+1:1
IF '$DATA(BARLT(100,BARL))
QUIT
IF $EXTRACT(BARLT(100,BARL))="~"
QUIT
WRITE !,BARLT(100,BARL)
+5 FOR BARL=BARL+1:1
IF '$DATA(BARLT(100,BARL))
QUIT
IF $EXTRACT(BARLT(100,BARL))="~"
QUIT
WRITE !,BARLT(100,BARL)
+6 DO EOP
+7 QUIT
+8 ; *********************************************************************
+9 ;
LIST ;** list bills
+1 NEW BARTMP1,BARTMP2,BARSSN
+2 SET BARBLDA=0
SET BARSVAL=0
+3 ;P.OTT MAY 2013
SET BARPG("HDR")=$GET(BARA(.01),"UNKNOWN")_" over "_BARAGE_" days"
+4 DO BARHDR
+5 FOR
SET BARSVAL=$ORDER(^TMP("BAR",$JOB,"BLAGE",BARACDA,BARSVAL))
IF BARSVAL=""
QUIT
Begin DoDot:1
+6 FOR
SET BARBLDA=$ORDER(^TMP("BAR",$JOB,"BLAGE",BARACDA,BARSVAL,BARBLDA))
IF BARBLDA'>0
QUIT
IF $GET(BARQUIT)
QUIT
Begin DoDot:2
+7 KILL BARB
+8 DO ENP^XBDIQ1(90050.01,BARBLDA,".01;101;102;13;15;7.2;701;702","BARB(","I")
+9 SET BARPIEN=$PIECE(^BARBL(DUZ(2),BARBLDA,1),U)
+10 SET BARDOB=$$GET1^DIQ(2,BARPIEN,".03","E")
+11 ;S BARSSN=$P($G(^DPT(BARPTDA,0)),U,9)
SET BARSSN=$PIECE($GET(^DPT(BARPIEN,0)),U,9)
+12 WRITE !,$EXTRACT(BARB(701),1,22)
+13 WRITE ?25,$EXTRACT(BARB(702),1,12)
+14 SET BARTMP2=BARB(.01)
SET BARTMP1=$PIECE(BARTMP2,"-")
SET BARTMP2=$PIECE(BARTMP2,"-",2,99)
+15 WRITE ?39,BARTMP1
+16 WRITE ?49,$$FMDT(BARB(102,"I"))
+17 WRITE ?58,$JUSTIFY(BARB(13),10,2)
+18 WRITE ?69,$JUSTIFY(BARB(15),10,2)
+19 WRITE !,"Pat: ",BARB(101)
+20 IF BARTMP2]""
WRITE ?39,BARTMP2
+21 WRITE ?49,BARDOB
+22 WRITE !,BARSSN
+23 ;;;;W !,"Pat DOB: "
+24 WRITE " Comment:"
+25 FOR
WRITE "_"
IF $X+3>IOM
QUIT
+26 ;-----------------------------------
+27 WRITE !
+28 IF $Y+4>IOSL
Begin DoDot:3
+29 DO EOP
+30 DO PG
End DoDot:3
End DoDot:2
IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))
QUIT
End DoDot:1
+31 WRITE !!,"TOTAL: ",?67,$JUSTIFY("$"_$FNUMBER(BARTOT,",",2),12)
+32 DO EOP
+33 QUIT
+34 ; *********************************************************************
+35 ;
SUMMARY ;
+1 SET BARPG("HDR")="Summary of bills/accounts over "_BARAGE_" days"
+2 DO BARHDR
+3 SET (BARAC,BARTOT,BARCNT)=0
+4 FOR
SET BARAC=$ORDER(^TMP("BAR",$JOB,"BLAGE",BARAC))
IF BARAC'>0
QUIT
IF $GET(BARQUIT)
QUIT
SET X=^(BARAC)
SET BARTOT=BARTOT+X
Begin DoDot:1
+5 WRITE !,$$GET1^DIQ(90050.02,BARAC,.01),?50,$JUSTIFY($FNUMBER(X,",",2),12)
+6 IF $Y+6'>IOSL
QUIT
+7 DO EOP
+8 DO PG
End DoDot:1
IF $GET(BARQUIT)
QUIT
+9 IF $GET(BARQUIT)
QUIT
+10 WRITE !!,"TOTAL ALL ACCOUNTS:",?50,$JUSTIFY($FNUMBER(BARTOT,",",2),12),!!
+11 WRITE !!,?15,"E N D O F R E P O R T",!!
+12 DO EOP
+13 QUIT
+14 ; *********************************************************************
+15 ;
SELACC ;
+1 ; ** select accounts to print
+2 KILL BARSAC
+3 WRITE !,"Select individual A/R accounts or hit RETURN for ALL accounts."
+4 SET DIC=$$DIC^XBDIQ1(90050.02)
+5 SET DIC(0)="AEQMZ"
+6 SET DIC("S")="I $P(^(0),U,10)=$$VALI^XBDIQ1(200,DUZ,29)"
+7 FOR
DO ^DIC
IF Y'>0
QUIT
SET BARSAC(+Y)=Y(0,0)
+8 IF '$DATA(BARSAC)
QUIT
+9 SET DA=0
+10 WRITE !
+11 FOR
SET DA=$ORDER(BARSAC(DA))
IF 'DA
QUIT
WRITE !,BARSAC(DA)
+12 WRITE !
+13 KILL DIR
+14 SET DIR(0)="Y"
+15 SET DIR("B")="YES"
+16 SET DIR("A")="Selected Account(s) Correct"
+17 DO ^DIR
+18 IF Y
QUIT
+19 KILL BARSAC
+20 GOTO SELACC
+21 ; *********************************************************************
+22 ;
FMDT(X) ;
+1 ; cvt fmdt to mm/dd/yyyy
+2 SET X=$$SDT^BARDUTL(X)
+3 QUIT X
+4 ; *********************************************************************
+5 ;
PG ;
BARPG ;EP PAGE CONTROLLER
+1 ; this utility uses variables BARPG("HDR"),BARPG("DT"),BARPG("LINE"),BARPG("PG")
+2 ; kill variables by D EBARPG
+3 ;
+4 SET BARPG("PG")=+$GET(BARPG("PG"))+1
+5 ;
BARHDR ;EP
+1 ; write page header
+2 WRITE $$EN^BARVDF("IOF")
+3 WRITE !
+4 IF '$DATA(BARPG("HDR"))
QUIT
+5 IF '$DATA(BARPG("LINE"))
SET $PIECE(BARPG("LINE"),"=",IOM)=""
+6 IF '$DATA(BARDASH)
SET $PIECE(BARDASH,"-",IOM)=""
+7 IF '$DATA(BARPG("PG"))
SET BARPG("PG")=1
+8 WRITE ?(IOM-40-$LENGTH(BARPG("HDR"))/2),BARPG("HDR")
+9 WRITE ?(IOM-24),$$SDT^BARDUTL(DT)
+10 WRITE ?(IOM-10),"PAGE: ",BARPG("PG")
+11 WRITE !,BARPG("LINE")
+12 ;
BARHD ;EP
+1 ; Write column header / message
+2 WRITE !
+3 IF BARPG("HDR")'["mmary"
Begin DoDot:1
+4 WRITE "Policy Holder",?25,"Policy #",?39,"Claim #",?49,"DOS",?58,$JUSTIFY("Amt Bld",10),?69,$JUSTIFY("Balance",10)
+5 WRITE !,"PT. SS #",?49,"DOB"
End DoDot:1
+6 WRITE !,BARDASH,!
+7 QUIT
+8 ; *********************************************************************
+9 ;
EBARPG ;
+1 KILL BARPG("LINE"),BARPG("PG"),BARPG("HDR"),BARPG("DT")
+2 QUIT
+3 ; *********************************************************************
+4 ;
QUE ;QUE
+1 NEW I
+2 FOR I="BARSAC*","BARSBY","BARAGE","BARSUM"
SET ZTSAVE(I)=""
+3 SET ZTRTN="AGE^BARBL"
+4 SET ZTDESC="AGED DAY LETTER"
+5 KILL ZTSK
+6 DO ^%ZTLOAD
+7 IF $GET(ZTSK)
WRITE !,"Task # ",ZTSK," queued.",!
+8 QUIT
+9 ; *********************************************************************
+10 ;
EXIT ;clean up and quit
+1 KILL DIC,BARSAC,BARSBY,BARA,BARB,BARPG,BARAC,BARACDA,BARAGE,BARBLDS
+2 KILL BARCNT,BARFDA,BARJOB,BARL,BARLT,BARQUIT,BARSVAL,BARSVC,BART,BARTOT
+3 WRITE $$EN^BARVDF("IOF")
+4 QUIT
+5 ; *********************************************************************
+6 ;
EOP ;end of page
+1 IF IO=IO(0)
IF '$DATA(IO("S"))
IF '$GET(ZTQUEUED)
Begin DoDot:1
+2 FOR
WRITE !
IF $Y+4>IOSL
QUIT
+3 DO EOP^BARUTL(0)
+4 IF 'Y
SET BARQUIT=1
End DoDot:1
+5 QUIT
