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)
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
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
