Routine: BARCHKLU

BARCHKLU ; IHS/SD/LSL - Look up Collection Information for Insurance Company by Check Number ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 ; IHS/SD/LSL - 11/14/02 - V1.7 - NOIS XCA-0802-200093

 ;      Modify code that $O thru the "D" x-ref to check for checks

 ;      in all upper case if check entered in lower case and lower case

 ;      check fails.

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

 ;** Collection Batch information by check number

 ;** option Check Posting Summary (CPS)**

ONE ;EP

 N DIC,BARCHKNO,BARCBDA,BARITMNO

 ; -------------------------------

ASK W !!

 S DIC=$$DIC^XBDIQ1(90051.01)

 S DIC(0)="AEQZ"

 S D="D"

 S DIC("A")="Select Check Number: "

 D IX^DIC

 I X=" " W !,"  Must enter a Check Number " G ASK

 Q:+Y<0

 S BARCHKNO=X

 S BARCBDA=+Y

 S BARITMNO=0

 S BARCBNM=$P(Y,U,2)

 S BARITMNO=$O(^BARCOL(DUZ(2),"D",BARCHKNO,BARCBDA,BARITMNO))

 I BARITMNO="" D  I BARITMNO="" K BARCBDA,BARITMNO,BARCHKNO G ASK

 . S BARCHKNO=$$UPC^BARUTL(X)

 . S BARCBDA=+Y

 . S BARITMNO=0

 . S BARITMNO=$O(^BARCOL(DUZ(2),"D",BARCHKNO,BARCBDA,BARITMNO))

 . I BARITMNO="" W !,"Couldn't find ITEM for this CHECK NUMBER.  Please select again."

 I '$D(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,0)) D  G ASK

 . W !,"PROBLEM WITH THIS ITEM SET UP CONTACT YOUR SUPPORT PERSONNEL"

 . K BARCBDA,BARITMNO,BARCHKNO

 I '$D(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,1)) D  G ASK

 . W !,"PROBLEM WITH THIS ITEM SET UP CONTACT YOUR SUPPORT PERSONNEL"

 . K BARCBDA,BARITMNO,BARCHKNO

 I '$D(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,2)) D  G ASK

 . W !,"PROBLEM WITH THIS ITEM SET UP CONTACT YOUR SUPPORT PERSONNEL"

 . K BARCBDA,BARITMNO,BARCHKNO

 S (BARCKAMT,BARINSNM,BARITMPD,BARITMBL,BARITMUD,BARITMUA,BARITMRF)=0

 S BARCKAMT=$P(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,1),"^")

 S BARINSNM=$P(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,2),"^")

 S BARITMPD=$$VAL^XBDIQ1(90051.1101,"BARCBDA,BARITMNO",18)

 S BARITMBL=$$VAL^XBDIQ1(90051.1101,"BARCBDA,BARITMNO",19)

 S BARITMUD=$P(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,1),"^",3)

 S BAR23=1

 S BARITMUA=$$ITT^BARCBC(BARCBDA,BARITMNO,"UN-ALLOCATED")

 K BAR23

 S BARITMRF=$$ITT^BARCBC(BARCBDA,BARITMNO,"REFUND")*-1

 W !,"Check No: ",BARCHKNO,?25,"From: ",$E(BARINSNM,1,30),?65,"For: ",$J(BARCKAMT,10,2),!

 K DIR

 S DIR(0)="Y"

 S DIR("A")="  CORRECT "

 S DIR("B")="YES"

 D ^DIR

 K DIR

 I Y'=1 G ASK

 D PRINT

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

HEADER ;

 I IOSL=6000 D

 .W $$EN^BARVDF("IOF")

 .W !?5,"Collection Batch: ",BARCBNM

 .W ?50,"Item Number: ",BARITMNO

 .W !,"Check Number: ",BARCHKNO

 .W ?32,"Issued By: ",BARINSNM

 .W !,"Check Amount: ",$J(BARCKAMT,10,2)

 .W ?27,"Amount Posted : ",$J(BARITMPD,10,2)

 .W ?55,"Balance : ",$J(BARITMBL,10,2)

 .W !,"Un-Allocated: ",$J(BARITMUA,10,2)

 .W ?55,"Refunded: ",$J(BARITMRF,10,2),!

 .W !,"Patient Name",?19,"3P Bill DT",?30,"Bill Name",?48,"DOS",?70,"Paid Amt.",!

 .D EBARPG

 I IOSL<6000 D BARHDR

 ; -------------------------------

DETAILS ;

 ; Collect information on what bills this check applied to

 S BARBCNT=0

 S (BARDTTM,BARCHKPD)=0

 F  S BARDTTM=$O(^BARTR(DUZ(2),"AD",BARCBDA,BARDTTM)) Q:BARDTTM'>0  D  Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))

 .I $P(^BARTR(DUZ(2),BARDTTM,0),"^",15)'=BARITMNO Q

 .I '$D(^BARTR(DUZ(2),BARDTTM,1)) Q

 .I $P(^BARTR(DUZ(2),BARDTTM,1),"^")'=40 Q

 .S (BARBLDA,BARBLPT,BARPDAMT)=0

 .S (BARBLNM,BARBLPTN)=""

 .S BARPDAMT=$P(^BARTR(DUZ(2),BARDTTM,0),U,2)

 .S BARBLDA=$P(^BARTR(DUZ(2),BARDTTM,0),U,4)

 .S BARBLPT=$P(^BARTR(DUZ(2),BARDTTM,0),U,5)

 .S BARBLPTN=$E($$VAL^XBDIQ1(90050.01,BARBLDA,101),1,25)

 .S BARDOSB=$$VALI^XBDIQ1(90050.01,BARBLDA,102)

 .S BARDOSE=$$VALI^XBDIQ1(90050.01,BARBLDA,103)

 .S BARDOSEF=$$SDT^BARDUTL(BARDOSE)

 .S BARDOSBF=$$SDT^BARDUTL(BARDOSB)  ;Y2000

 .S BARBLNM=$E($$VAL^XBDIQ1(90050.01,BARBLDA,.01),1,15)

 .S BAR3PAP=$$SDT^BARDUTL($P($G(^BARBL(DUZ(2),BARBLDA,0)),U,18))

 .W !,$E(BARBLPTN,1,18)

 .W ?19,BAR3PAP

 .W ?30,$E(BARBLNM,1,17)

 .W ?48,BARDOSBF_"-"_BARDOSEF

 .W ?70,$J(BARPDAMT,10,2)

 .S BARBCNT=BARBCNT+1

 .S BARCHKPD=BARCHKPD+BARPDAMT

 .D PG

.Q

 W !!?40,"Bill Count: ",BARBCNT,?60,"TOTALS:",?68,$J(BARCHKPD,12,2),!

 D EBARPG

 I $E(IOST)="C",IOT["TRM" D EOP^BARUTL(0)

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

PRINT ;**Print

 ; GET DEVICE (QUEUEING ALLOWED)

 S Y=$$DIR^XBDIR("S^P:PRINT Output;B:BROWSE Output on Screen","Do you wish to ","P","","","",1)

 K DA

 Q:$D(DIRUT)

 I Y="B" D  Q

 . S XBFLD("BROWSE")=1

 . S BARIOSL=IOSL

 . S IOSL=600

 . D VIEWR^XBLM("HEADER^BARCHKLU")

 . D FULL^VALM1

 . W $$EN^BARVDF("IOF")

 .D CLEAR^VALM1  ;clears out all list man stuff

 .K XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF

 .K VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMLFT,VALMLST,VALMMENU,VALMSGR

 .K VALMUP,VALMWD,VALMY,XQORS,XQORSPEW,VALMCOFF

.;

 .; ------------------------------

DEVE .;

 .S IOSL=BARIOSL

 .K BARIOSL

.Q

 S XBRP="HEADER^BARCHKLU"

 S XBNS="BAR"

 S XBRX="EXIT^BARCHKLU"

 D ^XBDBQUE

ENDJOB Q

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

PG ;**page controller

BARPG ;EP PAGE CONTROLLER

 ; This utility uses variables BARPG("HDR"),BARPG("DT"),BARPG("LINE"),BARPG("PG")

 ; kill variables by D EBARPG

 Q:($Y<(IOSL-6))!($G(DOUT)!$G(DFOUT))

 S:'$D(BARPG("PG")) BARPG("PG")=0

 S BARPG("PG")=BARPG("PG")+1

 I $E(IOST)="C",IOT["TRM" D EOP^BARUTL(0)  Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))

 ; -------------------------------

Q ;

 Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))

 ; -------------------------------

BARHDR ; Write the Report Header

 S BARPG("HDR")="Check Posting Summary"

 W:$Y @IOF

W !

 Q:'$D(BARPG("HDR"))

 S:'$D(BARPG("LINE")) $P(BARPG("LINE"),"-",IOM-2)=""

 S:'$D(BARPG("PG")) BARPG("PG")=1

 I '$D(BARPG("DT")) D

 . S %H=$H

 . D YX^%DTC

 . S BARPG("DT")=Y

 U IO

 W ?(IOM-$L(BARPG("HDR"))/2),BARPG("HDR")

 W !?(IOM-75),BARPG("DT"),?(IOM-15),"PAGE: ",BARPG("PG")

 W !,BARPG("LINE")

 ; -------------------------------

BARHD ;EP

 ; Write column header / message

 W !?5,"Collection Batch: ",BARCBNM

 W ?50,"Item Number: ",BARITMNO

 W !,"Check Number: ",BARCHKNO

 W ?32,"Issued By: ",BARINSNM

 W !,"Check Amount: ",$J(BARCKAMT,10,2)

 W ?27,"Amount Posted : ",$J(BARITMPD,10,2)

 W ?55,"Balance : ",$J(BARITMBL,10,2),!

 W "Un-Allocated: ",$J(BARITMUA,10,2)

 W ?55,"Refunded: ",$J(BARITMRF,10,2),!

 W !,"Patient Name"

 W ?19,"3P Bill DT"

 W ?30,"Bill Name"

 W ?48,"DOS"

 W ?70,"Paid Amt.",!

 I ($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT)) S BARQUIT=1

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

EBARPG ;

 K BARPG("LINE"),BARPG("PG"),BARPG("HDR"),BARPG("DT")

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

EXIT ; Exit routine

BARCHKLU  ; IHS/SD/LSL - Look up Collection Information for Insurance Company by Check Number ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 +2       ;

 +3       ; IHS/SD/LSL - 11/14/02 - V1.7 - NOIS XCA-0802-200093

 +4       ;      Modify code that $O thru the "D" x-ref to check for checks

 +5       ;      in all upper case if check entered in lower case and lower case

 +6       ;      check fails.

 +7       ;

 +8       ; ********************************************************************

 +9       ;

 +10      ;** Collection Batch information by check number

 +11      ;** option Check Posting Summary (CPS)**

 +12      ;

ONE       ;EP

 +1        NEW DIC,BARCHKNO,BARCBDA,BARITMNO

 +2       ;

 +3       ; -------------------------------

ASK        WRITE !!

 +1        SET DIC=$$DIC^XBDIQ1(90051.01)

 +2        SET DIC(0)="AEQZ"

 +3        SET D="D"

 +4        SET DIC("A")="Select Check Number: "

 +5        DO IX^DIC

 +6        IF X=" "

               WRITE !,"  Must enter a Check Number "

               GOTO ASK

 +7        IF +Y<0

               QUIT

 +8        SET BARCHKNO=X

 +9        SET BARCBDA=+Y

 +10       SET BARITMNO=0

 +11       SET BARCBNM=$PIECE(Y,U,2)

 +12       SET BARITMNO=$ORDER(^BARCOL(DUZ(2),"D",BARCHKNO,BARCBDA,BARITMNO))

 +13       IF BARITMNO=""

               Begin DoDot:1

 +14               SET BARCHKNO=$$UPC^BARUTL(X)

 +15               SET BARCBDA=+Y

 +16               SET BARITMNO=0

 +17               SET BARITMNO=$ORDER(^BARCOL(DUZ(2),"D",BARCHKNO,BARCBDA,BARITMNO))

 +18               IF BARITMNO=""

                       WRITE !,"Couldn't find ITEM for this CHECK NUMBER.  Please select again."

               End DoDot:1

               IF BARITMNO=""

                   KILL BARCBDA,BARITMNO,BARCHKNO

                   GOTO ASK

 +19       IF '$DATA(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,0))

               Begin DoDot:1

 +20               WRITE !,"PROBLEM WITH THIS ITEM SET UP CONTACT YOUR SUPPORT PERSONNEL"

 +21               KILL BARCBDA,BARITMNO,BARCHKNO

               End DoDot:1

               GOTO ASK

 +22       IF '$DATA(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,1))

               Begin DoDot:1

 +23               WRITE !,"PROBLEM WITH THIS ITEM SET UP CONTACT YOUR SUPPORT PERSONNEL"

 +24               KILL BARCBDA,BARITMNO,BARCHKNO

               End DoDot:1

               GOTO ASK

 +25       IF '$DATA(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,2))

               Begin DoDot:1

 +26               WRITE !,"PROBLEM WITH THIS ITEM SET UP CONTACT YOUR SUPPORT PERSONNEL"

 +27               KILL BARCBDA,BARITMNO,BARCHKNO

               End DoDot:1

               GOTO ASK

 +28       SET (BARCKAMT,BARINSNM,BARITMPD,BARITMBL,BARITMUD,BARITMUA,BARITMRF)=0

 +29       SET BARCKAMT=$PIECE(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,1),"^")

 +30       SET BARINSNM=$PIECE(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,2),"^")

 +31       SET BARITMPD=$$VAL^XBDIQ1(90051.1101,"BARCBDA,BARITMNO",18)

 +32       SET BARITMBL=$$VAL^XBDIQ1(90051.1101,"BARCBDA,BARITMNO",19)

 +33       SET BARITMUD=$PIECE(^BARCOL(DUZ(2),BARCBDA,1,BARITMNO,1),"^",3)

 +34       SET BAR23=1

 +35       SET BARITMUA=$$ITT^BARCBC(BARCBDA,BARITMNO,"UN-ALLOCATED")

 +36       KILL BAR23

 +37       SET BARITMRF=$$ITT^BARCBC(BARCBDA,BARITMNO,"REFUND")*-1

 +38       WRITE !,"Check No: ",BARCHKNO,?25,"From: ",$EXTRACT(BARINSNM,1,30),?65,"For: ",$JUSTIFY(BARCKAMT,10,2),!

 +39       KILL DIR

 +40       SET DIR(0)="Y"

 +41       SET DIR("A")="  CORRECT "

 +42       SET DIR("B")="YES"

 +43       DO ^DIR

 +44       KILL DIR

 +45       IF Y'=1

               GOTO ASK

 +46       DO PRINT

 +47       QUIT

 +48      ; *********************************************************************

 +49      ;

HEADER    ;

 +1        IF IOSL=6000

               Begin DoDot:1

 +2                WRITE $$EN^BARVDF("IOF")

 +3                WRITE !?5,"Collection Batch: ",BARCBNM

 +4                WRITE ?50,"Item Number: ",BARITMNO

 +5                WRITE !,"Check Number: ",BARCHKNO

 +6                WRITE ?32,"Issued By: ",BARINSNM

 +7                WRITE !,"Check Amount: ",$JUSTIFY(BARCKAMT,10,2)

 +8                WRITE ?27,"Amount Posted : ",$JUSTIFY(BARITMPD,10,2)

 +9                WRITE ?55,"Balance : ",$JUSTIFY(BARITMBL,10,2)

 +10               WRITE !,"Un-Allocated: ",$JUSTIFY(BARITMUA,10,2)

 +11               WRITE ?55,"Refunded: ",$JUSTIFY(BARITMRF,10,2),!

 +12               WRITE !,"Patient Name",?19,"3P Bill DT",?30,"Bill Name",?48,"DOS",?70,"Paid Amt.",!

 +13               DO EBARPG

               End DoDot:1

 +14       IF IOSL<6000

               DO BARHDR

 +15      ;

 +16      ; -------------------------------

DETAILS   ;

 +1       ; Collect information on what bills this check applied to

 +2        SET BARBCNT=0

 +3        SET (BARDTTM,BARCHKPD)=0

 +4        FOR

               SET BARDTTM=$ORDER(^BARTR(DUZ(2),"AD",BARCBDA,BARDTTM))

               IF BARDTTM'>0

                   QUIT

               Begin DoDot:1

 +5                IF $PIECE(^BARTR(DUZ(2),BARDTTM,0),"^",15)'=BARITMNO

                       QUIT

 +6                IF '$DATA(^BARTR(DUZ(2),BARDTTM,1))

                       QUIT

 +7                IF $PIECE(^BARTR(DUZ(2),BARDTTM,1),"^")'=40

                       QUIT

 +8                SET (BARBLDA,BARBLPT,BARPDAMT)=0

 +9                SET (BARBLNM,BARBLPTN)=""

 +10               SET BARPDAMT=$PIECE(^BARTR(DUZ(2),BARDTTM,0),U,2)

 +11               SET BARBLDA=$PIECE(^BARTR(DUZ(2),BARDTTM,0),U,4)

 +12               SET BARBLPT=$PIECE(^BARTR(DUZ(2),BARDTTM,0),U,5)

 +13               SET BARBLPTN=$EXTRACT($$VAL^XBDIQ1(90050.01,BARBLDA,101),1,25)

 +14               SET BARDOSB=$$VALI^XBDIQ1(90050.01,BARBLDA,102)

 +15               SET BARDOSE=$$VALI^XBDIQ1(90050.01,BARBLDA,103)

 +16               SET BARDOSEF=$$SDT^BARDUTL(BARDOSE)

 +17      ;Y2000

                   SET BARDOSBF=$$SDT^BARDUTL(BARDOSB)

 +18               SET BARBLNM=$EXTRACT($$VAL^XBDIQ1(90050.01,BARBLDA,.01),1,15)

 +19               SET BAR3PAP=$$SDT^BARDUTL($PIECE($GET(^BARBL(DUZ(2),BARBLDA,0)),U,18))

 +20               WRITE !,$EXTRACT(BARBLPTN,1,18)

 +21               WRITE ?19,BAR3PAP

 +22               WRITE ?30,$EXTRACT(BARBLNM,1,17)

 +23               WRITE ?48,BARDOSBF_"-"_BARDOSEF

 +24               WRITE ?70,$JUSTIFY(BARPDAMT,10,2)

 +25               SET BARBCNT=BARBCNT+1

 +26               SET BARCHKPD=BARCHKPD+BARPDAMT

 +27               DO PG

 +28               QUIT

               End DoDot:1

               IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))

                   QUIT

 +29       WRITE !!?40,"Bill Count: ",BARBCNT,?60,"TOTALS:",?68,$JUSTIFY(BARCHKPD,12,2),!

 +30       DO EBARPG

 +31       IF $EXTRACT(IOST)="C"

               IF IOT["TRM"

                   DO EOP^BARUTL(0)

 +32       QUIT

 +33      ; *********************************************************************

 +34      ;

PRINT     ;**Print

 +1       ;

 +2       ; GET DEVICE (QUEUEING ALLOWED)

 +3        SET Y=$$DIR^XBDIR("S^P:PRINT Output;B:BROWSE Output on Screen","Do you wish to ","P","","","",1)

 +4        KILL DA

 +5        IF $DATA(DIRUT)

               QUIT

 +6        IF Y="B"

               Begin DoDot:1

 +7                SET XBFLD("BROWSE")=1

 +8                SET BARIOSL=IOSL

 +9                SET IOSL=600

 +10               DO VIEWR^XBLM("HEADER^BARCHKLU")

 +11               DO FULL^VALM1

 +12               WRITE $$EN^BARVDF("IOF")

 +13      ;clears out all list man stuff

                   DO CLEAR^VALM1

 +14               KILL XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF

 +15               KILL VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMLFT,VALMLST,VALMMENU,VALMSGR

 +16               KILL VALMUP,VALMWD,VALMY,XQORS,XQORSPEW,VALMCOFF

 +17      ;

 +18      ; ------------------------------

DEVE      ;

 +1                SET IOSL=BARIOSL

 +2                KILL BARIOSL

 +3                QUIT

               End DoDot:1

               QUIT

 +4        SET XBRP="HEADER^BARCHKLU"

 +5        SET XBNS="BAR"

 +6        SET XBRX="EXIT^BARCHKLU"

 +7        DO ^XBDBQUE

ENDJOB     QUIT

 +1       ; *********************************************************************

PG        ;**page controller

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        IF ($Y<(IOSL-6))!($GET(DOUT)!$GET(DFOUT))

               QUIT

 +5        IF '$DATA(BARPG("PG"))

               SET BARPG("PG")=0

 +6        SET BARPG("PG")=BARPG("PG")+1

 +7        IF $EXTRACT(IOST)="C"

               IF IOT["TRM"

                   DO EOP^BARUTL(0)

                   IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))

                       QUIT

 +8       ;

 +9       ; -------------------------------

Q         ;

 +1        IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))

               QUIT

 +2       ;

 +3       ; -------------------------------

BARHDR    ; Write the Report Header

 +1        SET BARPG("HDR")="Check Posting Summary"

 +2        IF $Y

               WRITE @IOF

 +3        WRITE !

 +4        IF '$DATA(BARPG("HDR"))

               QUIT

 +5        IF '$DATA(BARPG("LINE"))

               SET $PIECE(BARPG("LINE"),"-",IOM-2)=""

 +6        IF '$DATA(BARPG("PG"))

               SET BARPG("PG")=1

 +7        IF '$DATA(BARPG("DT"))

               Begin DoDot:1

 +8                SET %H=$HOROLOG

 +9                DO YX^%DTC

 +10               SET BARPG("DT")=Y

               End DoDot:1

 +11       USE IO

 +12       WRITE ?(IOM-$LENGTH(BARPG("HDR"))/2),BARPG("HDR")

 +13       WRITE !?(IOM-75),BARPG("DT"),?(IOM-15),"PAGE: ",BARPG("PG")

 +14       WRITE !,BARPG("LINE")

 +15      ;

 +16      ; -------------------------------

BARHD     ;EP

 +1       ; Write column header / message

 +2        WRITE !?5,"Collection Batch: ",BARCBNM

 +3        WRITE ?50,"Item Number: ",BARITMNO

 +4        WRITE !,"Check Number: ",BARCHKNO

 +5        WRITE ?32,"Issued By: ",BARINSNM

 +6        WRITE !,"Check Amount: ",$JUSTIFY(BARCKAMT,10,2)

 +7        WRITE ?27,"Amount Posted : ",$JUSTIFY(BARITMPD,10,2)

 +8        WRITE ?55,"Balance : ",$JUSTIFY(BARITMBL,10,2),!

 +9        WRITE "Un-Allocated: ",$JUSTIFY(BARITMUA,10,2)

 +10       WRITE ?55,"Refunded: ",$JUSTIFY(BARITMRF,10,2),!

 +11       WRITE !,"Patient Name"

 +12       WRITE ?19,"3P Bill DT"

 +13       WRITE ?30,"Bill Name"

 +14       WRITE ?48,"DOS"

 +15       WRITE ?70,"Paid Amt.",!

 +16       IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))

               SET BARQUIT=1

 +17       QUIT

 +18      ; *********************************************************************

 +19      ;

EBARPG    ;

 +1        KILL BARPG("LINE"),BARPG("PG"),BARPG("HDR"),BARPG("DT")

 +2        QUIT

 +3       ; *********************************************************************

 +4       ;

EXIT      ; Exit routine

 +1        QUIT

BARCHKLU.m