Routine: BARBAD5

BARBAD5 ; IHS/SD/LSL - LIST TRANSACTION HISTORY OF A BILL ; 03/31/2008

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,4,5,6,19,20,23**;OCT 26, 2005

 ; IHS/SD/SDR - 03/11/2002 - V1.6 Patch 2 - NOIS HQW-0801-100024

 ;     Modified routine to output insurer field as well as Entry By,

 ;     Complete entry for Transaction Type, and A/R Account.  Also fixed

 ;     line in CHKLINE to fix unrelated <DPARM> error if "^" out of bill

 ; IHS/SD/SDR - 4/4/2002 - V1.6 Patch 2 - NOIS HQW-0302-100166

 ;     Modified so it won't display any of the following transaction

 ;     types.  They are causing confusion and are not necessary to

 ;     display.

 ;          COL BAT TO ACC POST - 115

 ;          COL BAT TO ACC UN-DIST -116

 ;          COL BAT TO FACILITY -117

 ;          COL BAT TO UN-DIST -118

 ; IHS/SD/LSL - 09/23/02 - V1.6 Patch 3 - HIPAA

 ;     Display PENDING and GENERAL INFORMATION (2 new Adjustment

 ;     Categories) on the Transaction History.  These categories

 ;     should not affect the balance.

 ; IHS/SD/LSL - 10/17/03 - V1.7 Patch 4 - HIPAA

 ;      Display "e" next to transactions that were posted via Post

 ;      ERA Claims.

 ; IHS/SD/LSL - 02/13/04 - V1.7 Patch 5 - Remark Codes

 ;       Display Remark Code and NCPDP Reject/Payment codes

 ;       on Transaction on history

 ;IHS/SD/RLT - 02/15/05 - V1.8 Patch 1 - IM15887

 ;       balances should not be affected by transaction

 ;       types of PENDING or GENERAL INFORMATION but should always

 ;       be displayed

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

 ;** List Detail command from posting command prompt

 ;** lists details from a single bill

 ; JULY 2012 P.OTTIS ADDRESS TRIEN HEAT #76003

EN(BARBLDA) ; EP - Display bill history

EN1 ;

 N DIC,DR,BARCL,BARHLP,BARCLV,BARCLIT,BARITV,BARPSAT,BARSITE,BARSPAR,BARUSR

 N BARVSIT,BAREOV,BARBL,BARTRX,BARTR,BARBAL,BARX,BARQ,BARTRDA,BARBAL,BARPTA

 S DR=".01;3;14;15;101;102;103;104;108"

 S DIC=$$DIC^XBSFGBL(90050.01)

 D ENP^XBDIQ1(DIC,BARBLDA,DR,"BARBL(","")

 S BARBL(101,"I")=$$GET1^DIQ(90050.01,BARBLDA,101,"I")

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

GETPT ;

 I 'BARBL(101,"I") S BARBL(101,"I")=$G(BARPAT)

 I 'BARBL(101,"I") D  G GETTX

 .F BARJ=.111,.114,.115,.116,.131 S BARPTA(BARJ)=""

 S DIC="^DPT("

 S DR=".111;.114;.115;.116;.131"

 D ENP^XBDIQ1(DIC,BARBL(101,"I"),DR,"BARPTA(","")

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

GETTX ;

 ;S DR="2;3;6;13;14;15;101;102;103;107;108"

 S DR="2;3;6;13;14;15;101;102;103;107;108;110;111;112"  ;BAR*1.8*4 SCR56,SCR58

 ; End coding change V1.7 Patch 5

 S DIC=$$DIC^XBSFGBL(90050.03)

 S BARTRDA=0

 F  S BARTRDA=$O(^BARTR(DUZ(2),"AC",BARBLDA,BARTRDA)) Q:'BARTRDA  D

 .I '$D(^BARTR(DUZ(2),BARTRDA)) K ^BARTR(DUZ(2),"AC",BARBLDA,BARTRDA) Q

 .S BARTEST=","_$P($G(^BARTR(DUZ(2),BARTRDA,1)),U)_","

 .Q:BARTEST=",,"               ; No transaction type

 .I ",115,116,117,118,"[BARTEST Q

 .W "."

 .D ENP^XBDIQ1(DIC,BARTRDA,DR,"BARTRX(","1")

 .S BARTRX(BARTRDA,12)=$$GET1^DIQ(90050.03,BARTRDA,12,"I")

 .S BARTRX(BARTRDA,13)=$$GET1^DIQ(90050.03,BARTRDA,13,"I")

 .S BARTRX(BARTRDA,14,"I")=$$GET1^DIQ(90050.03,BARTRDA,14,"I") ;BAR*1.8*4 SCR56,SCR58

 .S BARTRX(BARTRDA,15,"I")=$$GET1^DIQ(90050.03,BARTRDA,15,"I") ;BAR*1.8*4

 .S BARTRX(BARTRDA,106)=$$GET1^DIQ(90050.03,BARTRDA,106,"I")

 .S BARTRX(BARTRDA,110)=$$GET1^DIQ(90050.03,BARTRDA,110,"I")  ;REVERSAL DATE;BAR*1.8*4 SCR56,SCR58

 .;S BARTRX(BARTRDA,111)=$$GET1^DIQ(90050.03,BARTRDA,111,"I")  ;SCHEDULE NUMBER/IPAC;BAR*1.8*4 SCR56,SCR58  ;IHS/SD/SDR BAR*1.8*6 4.2.3

 .S BARTRX(BARTRDA,111)=$$GET1^DIQ(90050.03,BARTRDA,111,"E")  ;SCHEDULE NUMBER/IPAC;BAR*1.8*4 SCR56,SCR58  ;IHS/SD/SDR BAR*1.8*6 4.2.3

 .S BARTRX(BARTRDA,112)=$$GET1^DIQ(90050.03,BARTRDA,112,"E")  ;IGNORE FLAG;BAR*1.8*4 SCR80 4.1.1

 .S BARTRX(BARTRDA,501)=$$GET1^DIQ(90050.03,BARTRDA,501,"E")  ;PAYMENT CREDIT APPLIED TO ;BAR*1.8*5 IHS/SD/TPF 6/17/2008

 .S BARTRX(BARTRDA,502)=$$GET1^DIQ(90050.03,BARTRDA,502,"E")  ;PAYMENT CREDIT APPLIED FROM ;BAR*1.8*5 IHS/SD/TPF 6/17/2008

W !

 D HEAD

 S BARTRDA=0,BARBAL=0,BARQ=0

 F  S BARTRDA=$O(BARTRX(BARTRDA)) Q:'BARTRDA  D  Q:BARQ

 .S BARQ=$$CHKLINE()

 .Q:BARQ

 .W !

 .W $$SDT^BARDUTL($G(BARTRX(BARTRDA,12)))

 .I $G(BARTRX(BARTRDA,13))'="" W ?11,$P($G(^VA(200,BARTRX(BARTRDA,13),0)),U,2)

 .S BARBATCH=$S($L($G(BARTRX(BARTRDA,14))):BARTRX(BARTRDA,14),1:"NO BATCH")

 .S BARITEM=$S($L($G(BARTRX(BARTRDA,15))):BARTRX(BARTRDA,15),1:"")

 .;S:$G(BARTRX(BARTRDA,102))'="" BARTRX(BARTRDA,102)=BARTRX(BARTRDA,102)_"/"_$G(BARTRX(BARTRDA,103))  ;bar*1.8*20

 .S:$G(BARTRX(BARTRDA,102))'="" BARTRX(BARTRDA,102)=$E(BARTRX(BARTRDA,102),1,19)_"/"_$E($G(BARTRX(BARTRDA,103)),1,19)  ;bar*1.8*20

 .S BARTT=$S($G(BARTRX(BARTRDA,101))["REFUND":BARTRX(BARTRDA,101),$L($G(BARTRX(BARTRDA,102))):BARTRX(BARTRDA,102),1:$G(BARTRX(BARTRDA,101)))

 . S BARPRE=""

 . I BARTRX(BARTRDA,106)="e" S BARPRE="e "

 . I BARTT["PENDING" S BARPRE="* "

 . I BARTRX(BARTRDA,106)="e",BARTT["PENDING" S BARPRE="*e "

 . S BARTT=BARPRE_BARTT

 .W ?15,BARTT

 . I BARTT["REMARK" W ?45,BARTRX(BARTRDA,107)

 . I BARTT["NCPDP" W ?45,BARTRX(BARTRDA,108)

 .S (BARX,X)=$S($G(BARTRX(BARTRDA,2)):-BARTRX(BARTRDA,2),1:$G(BARTRX(BARTRDA,3)))

 .S X2=2

 .S X3=11

 .D COMMA^%DTC

 .I BARTT["PENDING" S X="**"_X_"**"

 .;start old code bar*1.8*20

 .;I $G(BARTRX(BARTRDA,101))="STATUS CHANGE" D

 .;. W:$G(BARTRX(BARTRDA,2)) ?54,X

 .;. W:'$G(BARTRX(BARTRDA,2)) ?54,$P(X,"(")_"(-"_$P(X,"(",2)

 .;W:$G(BARTRX(BARTRDA,101))'="STATUS CHANGE" ?54,X

 .;end old code bar*1.8*20

 .W ?54,X  ;bar*1.8*20

 .N X

 .;I BARTT'["PENDING" D         ;IM15887 BAR*1.8*1

 .I BARTT'["PENDING"&(BARTT'["GENERAL") D

 ..;start old code bar*1.8*20

 ..;I $G(BARTRX(BARTRDA,101))="STATUS CHANGE" D

 ..;.S:$G(BARTRX(BARTRDA,2)) BARBAL=BARBAL+BARX

 ..;.S:'$G(BARTRX(BARTRDA,2)) BARBAL=BARBAL-BARX

 ..;S:$G(BARTRX(BARTRDA,101))'="STATUS CHANGE" BARBAL=BARBAL+BARX

 ..;end old code bar*1.8*20

 ..S BARBAL=BARBAL+BARX  ;bar*1.8*20

 . S X=BARBAL,X2=2,X3=11 D COMMA^%DTC

 . W ?68,X

 .;END IM15887

 .W !

 .W ?15,BARTRX(BARTRDA,6)          ; A/R Account

 .W ?45,BARBATCH

 .W ?67,$J(BARITEM,3,0)

 .;BEGIN BAR*1.8*SCR56,SCR58

 .I BARTRX(BARTRDA,14,"I")'="",(BARTRX(BARTRDA,15,"I")'="") D

 ..N IENS

 ..S IENS=BARTRX(BARTRDA,15,"I")_","_BARTRX(BARTRDA,14,"I")_","

 ..W !?15,$$GET1^DIQ(90051.1101,IENS,20,"E")  ;SCHEDULE #\IPAC

 ..K IENS

 ..;END BAR*1.8*SCR56,SCR58

 . I BARTT["REMARK" D

 . . S BARMKDSC=$$GET1^DIQ(90050.03,BARTRDA,"107:.02")

 . . W !?15,$E(BARMKDSC,1,40)

 . . I $L(BARMKDSC)>40 W !?15,$E(BARMKDSC,41,80)

 . I BARTT["NCPDP" D

 . . S BARNCPDP=$$GET1^DIQ(90050.03,BARTRDA,"108:.02")

 . . W !?15,$E(BARNCPDP,1,40)

 . . I $L(BARNCPDP)>40 W !?15,$E(BARNCPDP,41,80)

 .I $G(BARTRX(BARTRDA,110)) D

 ..S Y=BARTRX(BARTRDA,110) X ^DD("DD")

 ..W !?5,"REVERSAL DATE: ",Y  ;BAR*1.8*4 SCR56,SCR58

 ..W !?5,"REV TREASURY DEPOSIT NUMBER/IPAC: ",$G(BARTRX(BARTRDA,111))

 .I $G(BARTRX(BARTRDA,112))]"" W !?15,BARTRX(BARTRDA,112) ;MRS:BAR*1.8*4 SCR80 4.1.1

 .I BARTRX(BARTRDA,501)'="" W !?15,"PAYMENT CREDIT APPLIED TO: ",BARTRX(BARTRDA,501)    ;BAR*1.8*5 IHS/SD/TPF 6/17/2008

 .I BARTRX(BARTRDA,502)'="" W !?15,"PAYMENT CREDIT APPLIED FROM: ",BARTRX(BARTRDA,502)  ;BAR*1.8*5 IHS/SD/TPF 6/17/2008

 . W !?15,BARTRDA ;P.OTT

 Q:BARQ

 D EOP^BARUTL(1)

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

HEAD ;

 W $$EN^BARVDF("IOF"),!

 S X="List of Transactions for Bill "_BARBL(.01)

 W ?80-$L(X)\2,X

 W !!,"Patient: "_BARBL(101),?45,"Beg DOS : "_BARBL(102)

 W !,"Address: "_$G(BARPTA(.111)),?45,"End DOS : "_BARBL(103)

 W !,$G(BARPTA(.114))_", "_$G(BARPTA(.115))_" "_$G(BARPTA(.116))

 W ?45,"LST STMT: "

 W !!,"Phone #: "_$G(BARPTA(.131)),?45,"Insurer: "_$G(BARBL(3))

 W !?45,"Balance: "_$J(BARBL(15),0,2)

 W !!,"Trans Dt",?11,"By",?15,"Trans Type",?57,"Amount",?70,"Balance"

 W !?15,"A/R Account",?45,"Batch",?67,"Item",!

 W !?15,"Transaction #",! ;P.OTT

 S BARDSH="",$P(BARDSH,"-",IOM)="" W BARDSH

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

CHKLINE() ;

 ; Q 0 = CONTINUE

 ; Q 1 = STOP

N X

 I ($Y+4)<IOSL Q 0

 I $E(IOST,1)="C" D  I 'Y Q 1

 .W !?(IOM-15),"continued==>"

 .D EOP^BARUTL(0)

 D HEAD

Q 0

BARBAD5   ; IHS/SD/LSL - LIST TRANSACTION HISTORY OF A BILL ; 03/31/2008

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,4,5,6,19,20,23**;OCT 26, 2005

 +2       ;

 +3       ; IHS/SD/SDR - 03/11/2002 - V1.6 Patch 2 - NOIS HQW-0801-100024

 +4       ;     Modified routine to output insurer field as well as Entry By,

 +5       ;     Complete entry for Transaction Type, and A/R Account.  Also fixed

 +6       ;     line in CHKLINE to fix unrelated <DPARM> error if "^" out of bill

 +7       ;

 +8       ; IHS/SD/SDR - 4/4/2002 - V1.6 Patch 2 - NOIS HQW-0302-100166

 +9       ;     Modified so it won't display any of the following transaction

 +10      ;     types.  They are causing confusion and are not necessary to

 +11      ;     display.

 +12      ;          COL BAT TO ACC POST - 115

 +13      ;          COL BAT TO ACC UN-DIST -116

 +14      ;          COL BAT TO FACILITY -117

 +15      ;          COL BAT TO UN-DIST -118

 +16      ;

 +17      ; IHS/SD/LSL - 09/23/02 - V1.6 Patch 3 - HIPAA

 +18      ;     Display PENDING and GENERAL INFORMATION (2 new Adjustment

 +19      ;     Categories) on the Transaction History.  These categories

 +20      ;     should not affect the balance.

 +21      ;

 +22      ; IHS/SD/LSL - 10/17/03 - V1.7 Patch 4 - HIPAA

 +23      ;      Display "e" next to transactions that were posted via Post

 +24      ;      ERA Claims.

 +25      ;

 +26      ; IHS/SD/LSL - 02/13/04 - V1.7 Patch 5 - Remark Codes

 +27      ;       Display Remark Code and NCPDP Reject/Payment codes

 +28      ;       on Transaction on history

 +29      ;

 +30      ;IHS/SD/RLT - 02/15/05 - V1.8 Patch 1 - IM15887

 +31      ;       balances should not be affected by transaction

 +32      ;       types of PENDING or GENERAL INFORMATION but should always

 +33      ;       be displayed

 +34      ; *********************************************************************

 +35      ;

 +36      ;** List Detail command from posting command prompt

 +37      ;** lists details from a single bill

 +38      ; JULY 2012 P.OTTIS ADDRESS TRIEN HEAT #76003

 +39      ;

EN(BARBLDA) ; EP - Display bill history

 +1       ;

EN1       ;

 +1        NEW DIC,DR,BARCL,BARHLP,BARCLV,BARCLIT,BARITV,BARPSAT,BARSITE,BARSPAR,BARUSR

 +2        NEW BARVSIT,BAREOV,BARBL,BARTRX,BARTR,BARBAL,BARX,BARQ,BARTRDA,BARBAL,BARPTA

 +3        SET DR=".01;3;14;15;101;102;103;104;108"

 +4        SET DIC=$$DIC^XBSFGBL(90050.01)

 +5        DO ENP^XBDIQ1(DIC,BARBLDA,DR,"BARBL(","")

 +6        SET BARBL(101,"I")=$$GET1^DIQ(90050.01,BARBLDA,101,"I")

 +7       ; -------------------------------

 +8       ;

GETPT     ;

 +1        IF 'BARBL(101,"I")

               SET BARBL(101,"I")=$GET(BARPAT)

 +2        IF 'BARBL(101,"I")

               Begin DoDot:1

 +3                FOR BARJ=.111,.114,.115,.116,.131

                       SET BARPTA(BARJ)=""

               End DoDot:1

               GOTO GETTX

 +4        SET DIC="^DPT("

 +5        SET DR=".111;.114;.115;.116;.131"

 +6        DO ENP^XBDIQ1(DIC,BARBL(101,"I"),DR,"BARPTA(","")

 +7       ; -------------------------------

 +8       ;

GETTX     ;

 +1       ;S DR="2;3;6;13;14;15;101;102;103;107;108"

 +2       ;BAR*1.8*4 SCR56,SCR58

           SET DR="2;3;6;13;14;15;101;102;103;107;108;110;111;112"

 +3       ; End coding change V1.7 Patch 5

 +4        SET DIC=$$DIC^XBSFGBL(90050.03)

 +5        SET BARTRDA=0

 +6        FOR

               SET BARTRDA=$ORDER(^BARTR(DUZ(2),"AC",BARBLDA,BARTRDA))

               IF 'BARTRDA

                   QUIT

               Begin DoDot:1

 +7                IF '$DATA(^BARTR(DUZ(2),BARTRDA))

                       KILL ^BARTR(DUZ(2),"AC",BARBLDA,BARTRDA)

                       QUIT

 +8                SET BARTEST=","_$PIECE($GET(^BARTR(DUZ(2),BARTRDA,1)),U)_","

 +9       ; No transaction type

                   IF BARTEST=",,"

                       QUIT

 +10               IF ",115,116,117,118,"[BARTEST

                       QUIT

 +11               WRITE "."

 +12               DO ENP^XBDIQ1(DIC,BARTRDA,DR,"BARTRX(","1")

 +13               SET BARTRX(BARTRDA,12)=$$GET1^DIQ(90050.03,BARTRDA,12,"I")

 +14               SET BARTRX(BARTRDA,13)=$$GET1^DIQ(90050.03,BARTRDA,13,"I")

 +15      ;BAR*1.8*4 SCR56,SCR58

                   SET BARTRX(BARTRDA,14,"I")=$$GET1^DIQ(90050.03,BARTRDA,14,"I")

 +16      ;BAR*1.8*4

                   SET BARTRX(BARTRDA,15,"I")=$$GET1^DIQ(90050.03,BARTRDA,15,"I")

 +17               SET BARTRX(BARTRDA,106)=$$GET1^DIQ(90050.03,BARTRDA,106,"I")

 +18      ;REVERSAL DATE;BAR*1.8*4 SCR56,SCR58

                   SET BARTRX(BARTRDA,110)=$$GET1^DIQ(90050.03,BARTRDA,110,"I")

 +19      ;S BARTRX(BARTRDA,111)=$$GET1^DIQ(90050.03,BARTRDA,111,"I")  ;SCHEDULE NUMBER/IPAC;BAR*1.8*4 SCR56,SCR58  ;IHS/SD/SDR BAR*1.8*6 4.2.3

 +20      ;SCHEDULE NUMBER/IPAC;BAR*1.8*4 SCR56,SCR58  ;IHS/SD/SDR BAR*1.8*6 4.2.3

                   SET BARTRX(BARTRDA,111)=$$GET1^DIQ(90050.03,BARTRDA,111,"E")

 +21      ;IGNORE FLAG;BAR*1.8*4 SCR80 4.1.1

                   SET BARTRX(BARTRDA,112)=$$GET1^DIQ(90050.03,BARTRDA,112,"E")

 +22      ;PAYMENT CREDIT APPLIED TO ;BAR*1.8*5 IHS/SD/TPF 6/17/2008

                   SET BARTRX(BARTRDA,501)=$$GET1^DIQ(90050.03,BARTRDA,501,"E")

 +23      ;PAYMENT CREDIT APPLIED FROM ;BAR*1.8*5 IHS/SD/TPF 6/17/2008

                   SET BARTRX(BARTRDA,502)=$$GET1^DIQ(90050.03,BARTRDA,502,"E")

               End DoDot:1

 +24       WRITE !

 +25       DO HEAD

 +26       SET BARTRDA=0

           SET BARBAL=0

           SET BARQ=0

 +27       FOR

               SET BARTRDA=$ORDER(BARTRX(BARTRDA))

               IF 'BARTRDA

                   QUIT

               Begin DoDot:1

 +28               SET BARQ=$$CHKLINE()

 +29               IF BARQ

                       QUIT

 +30               WRITE !

 +31               WRITE $$SDT^BARDUTL($GET(BARTRX(BARTRDA,12)))

 +32               IF $GET(BARTRX(BARTRDA,13))'=""

                       WRITE ?11,$PIECE($GET(^VA(200,BARTRX(BARTRDA,13),0)),U,2)

 +33               SET BARBATCH=$SELECT($LENGTH($GET(BARTRX(BARTRDA,14))):BARTRX(BARTRDA,14),1:"NO BATCH")

 +34               SET BARITEM=$SELECT($LENGTH($GET(BARTRX(BARTRDA,15))):BARTRX(BARTRDA,15),1:"")

 +35      ;S:$G(BARTRX(BARTRDA,102))'="" BARTRX(BARTRDA,102)=BARTRX(BARTRDA,102)_"/"_$G(BARTRX(BARTRDA,103))  ;bar*1.8*20

 +36      ;bar*1.8*20

                   IF $GET(BARTRX(BARTRDA,102))'=""

                       SET BARTRX(BARTRDA,102)=$EXTRACT(BARTRX(BARTRDA,102),1,19)_"/"_$EXTRACT($GET(BARTRX(BARTRDA,103)),1,19)

 +37               SET BARTT=$SELECT($GET(BARTRX(BARTRDA,101))["REFUND":BARTRX(BARTRDA,101),$LENGTH($GET(BARTRX(BARTRDA,102))):BARTRX(BARTRDA,102),1:$GET(BARTRX(BARTRDA,101)))

 +38               SET BARPRE=""

 +39               IF BARTRX(BARTRDA,106)="e"

                       SET BARPRE="e "

 +40               IF BARTT["PENDING"

                       SET BARPRE="* "

 +41               IF BARTRX(BARTRDA,106)="e"

                       IF BARTT["PENDING"

                           SET BARPRE="*e "

 +42               SET BARTT=BARPRE_BARTT

 +43               WRITE ?15,BARTT

 +44               IF BARTT["REMARK"

                       WRITE ?45,BARTRX(BARTRDA,107)

 +45               IF BARTT["NCPDP"

                       WRITE ?45,BARTRX(BARTRDA,108)

 +46               SET (BARX,X)=$SELECT($GET(BARTRX(BARTRDA,2)):-BARTRX(BARTRDA,2),1:$GET(BARTRX(BARTRDA,3)))

 +47               SET X2=2

 +48               SET X3=11

 +49               DO COMMA^%DTC

 +50               IF BARTT["PENDING"

                       SET X="**"_X_"**"

 +51      ;start old code bar*1.8*20

 +52      ;I $G(BARTRX(BARTRDA,101))="STATUS CHANGE" D

 +53      ;. W:$G(BARTRX(BARTRDA,2)) ?54,X

 +54      ;. W:'$G(BARTRX(BARTRDA,2)) ?54,$P(X,"(")_"(-"_$P(X,"(",2)

 +55      ;W:$G(BARTRX(BARTRDA,101))'="STATUS CHANGE" ?54,X

 +56      ;end old code bar*1.8*20

 +57      ;bar*1.8*20

                   WRITE ?54,X

 +58               NEW X

 +59      ;I BARTT'["PENDING" D         ;IM15887 BAR*1.8*1

 +60               IF BARTT'["PENDING"&(BARTT'["GENERAL")

                       Begin DoDot:2

 +61      ;start old code bar*1.8*20

 +62      ;I $G(BARTRX(BARTRDA,101))="STATUS CHANGE" D

 +63      ;.S:$G(BARTRX(BARTRDA,2)) BARBAL=BARBAL+BARX

 +64      ;.S:'$G(BARTRX(BARTRDA,2)) BARBAL=BARBAL-BARX

 +65      ;S:$G(BARTRX(BARTRDA,101))'="STATUS CHANGE" BARBAL=BARBAL+BARX

 +66      ;end old code bar*1.8*20

 +67      ;bar*1.8*20

                           SET BARBAL=BARBAL+BARX

                       End DoDot:2

 +68               SET X=BARBAL

                   SET X2=2

                   SET X3=11

                   DO COMMA^%DTC

 +69               WRITE ?68,X

 +70      ;END IM15887

 +71               WRITE !

 +72      ; A/R Account

                   WRITE ?15,BARTRX(BARTRDA,6)

 +73               WRITE ?45,BARBATCH

 +74               WRITE ?67,$JUSTIFY(BARITEM,3,0)

 +75      ;BEGIN BAR*1.8*SCR56,SCR58

 +76               IF BARTRX(BARTRDA,14,"I")'=""

                       IF (BARTRX(BARTRDA,15,"I")'="")

                           Begin DoDot:2

 +77                           NEW IENS

 +78                           SET IENS=BARTRX(BARTRDA,15,"I")_","_BARTRX(BARTRDA,14,"I")_","

 +79      ;SCHEDULE #\IPAC

                               WRITE !?15,$$GET1^DIQ(90051.1101,IENS,20,"E")

 +80                           KILL IENS

 +81      ;END BAR*1.8*SCR56,SCR58

                           End DoDot:2

 +82               IF BARTT["REMARK"

                       Begin DoDot:2

 +83                       SET BARMKDSC=$$GET1^DIQ(90050.03,BARTRDA,"107:.02")

 +84                       WRITE !?15,$EXTRACT(BARMKDSC,1,40)

 +85                       IF $LENGTH(BARMKDSC)>40

                               WRITE !?15,$EXTRACT(BARMKDSC,41,80)

                       End DoDot:2

 +86               IF BARTT["NCPDP"

                       Begin DoDot:2

 +87                       SET BARNCPDP=$$GET1^DIQ(90050.03,BARTRDA,"108:.02")

 +88                       WRITE !?15,$EXTRACT(BARNCPDP,1,40)

 +89                       IF $LENGTH(BARNCPDP)>40

                               WRITE !?15,$EXTRACT(BARNCPDP,41,80)

                       End DoDot:2

 +90               IF $GET(BARTRX(BARTRDA,110))

                       Begin DoDot:2

 +91                       SET Y=BARTRX(BARTRDA,110)

                           XECUTE ^DD("DD")

 +92      ;BAR*1.8*4 SCR56,SCR58

                           WRITE !?5,"REVERSAL DATE: ",Y

 +93                       WRITE !?5,"REV TREASURY DEPOSIT NUMBER/IPAC: ",$GET(BARTRX(BARTRDA,111))

                       End DoDot:2

 +94      ;MRS:BAR*1.8*4 SCR80 4.1.1

                   IF $GET(BARTRX(BARTRDA,112))]""

                       WRITE !?15,BARTRX(BARTRDA,112)

 +95      ;BAR*1.8*5 IHS/SD/TPF 6/17/2008

                   IF BARTRX(BARTRDA,501)'=""

                       WRITE !?15,"PAYMENT CREDIT APPLIED TO: ",BARTRX(BARTRDA,501)

 +96      ;BAR*1.8*5 IHS/SD/TPF 6/17/2008

                   IF BARTRX(BARTRDA,502)'=""

                       WRITE !?15,"PAYMENT CREDIT APPLIED FROM: ",BARTRX(BARTRDA,502)

 +97      ;P.OTT

                   WRITE !?15,BARTRDA

               End DoDot:1

               IF BARQ

                   QUIT

 +98       IF BARQ

               QUIT

 +99       DO EOP^BARUTL(1)

 +100      QUIT

 +101     ; *********************************************************************

 +102     ;

HEAD      ;

 +1        WRITE $$EN^BARVDF("IOF"),!

 +2        SET X="List of Transactions for Bill "_BARBL(.01)

 +3        WRITE ?80-$LENGTH(X)\2,X

 +4        WRITE !!,"Patient: "_BARBL(101),?45,"Beg DOS : "_BARBL(102)

 +5        WRITE !,"Address: "_$GET(BARPTA(.111)),?45,"End DOS : "_BARBL(103)

 +6        WRITE !,$GET(BARPTA(.114))_", "_$GET(BARPTA(.115))_" "_$GET(BARPTA(.116))

 +7        WRITE ?45,"LST STMT: "

 +8        WRITE !!,"Phone #: "_$GET(BARPTA(.131)),?45,"Insurer: "_$GET(BARBL(3))

 +9        WRITE !?45,"Balance: "_$JUSTIFY(BARBL(15),0,2)

 +10       WRITE !!,"Trans Dt",?11,"By",?15,"Trans Type",?57,"Amount",?70,"Balance"

 +11       WRITE !?15,"A/R Account",?45,"Batch",?67,"Item",!

 +12      ;P.OTT

           WRITE !?15,"Transaction #",!

 +13       SET BARDSH=""

           SET $PIECE(BARDSH,"-",IOM)=""

           WRITE BARDSH

 +14       QUIT

 +15      ; *********************************************************************

 +16      ;

CHKLINE() ;

 +1       ; Q 0 = CONTINUE

 +2       ; Q 1 = STOP

 +3        NEW X

 +4        IF ($Y+4)<IOSL

               QUIT 0

 +5        IF $EXTRACT(IOST,1)="C"

               Begin DoDot:1

 +6                WRITE !?(IOM-15),"continued==>"

 +7                DO EOP^BARUTL(0)

               End DoDot:1

               IF 'Y

                   QUIT 1

 +8        DO HEAD

 +9        QUIT 0

BARBAD5.m