BARFPST4 ; IHS/SD/LSL - A/R FLAT RATE POSTING #3 ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;;
DOC ;
; LSL - 01/01/2000 - Created routine
; Contains code for Reviewing bills in A/R FLAT RATE POSTING File
; May be called from FBL View Flat Rate Bills Option or
; by choosing REVIEW from Select Command Prompt in the
; FRP Flat Rate Posting Option.
;;
Q
; *********************************************************************
;
EN ; EP
; EP - View flate rate posting entries
D FRPENTRY ; Get Flat Rate Posting Entry to view
I Y<1 D EXIT^BARFPST Q ; Quit if don't select FRP Batch
D REVIEW ; View entry using XBLM
Q
; *********************************************************************
;
FRPENTRY ;
;Look up Flate Rate Posting entry
W !
K DIC
S DIC="^BARFRP(DUZ(2),"
S DIC(0)="AEMQZ"
S DIC("A")="Select FRP batch: "
D ^DIC
I Y<1 Q
S BARIEN=+Y ; IEN to A/R FLAT RATE POSTING File
S BARNAME=Y(0,0) ; Name of FRP batch
Q
; *********************************************************************
;
REVIEW ; EP
; EP - Review entries
D VIEWR^XBLM("REVIEW2^BARFPST4","A/R Flat Rate Posting Summary")
S BARFLAG=1
Q
; *********************************************************************
;
REVIEW2 ;
; Print Report code used in XBLM call
; Get batch, item, payment, item amount from FRP file
K DA,DIC,DR,DIQ,BARREV
S DIC=90054.01
S DA=BARIEN ; IEN to A/R FLAT RATE POSTING File
S DR=".04;.05;.09;.1"
S DIQ="BARREV("
S DIQ(0)="2I"
D ENP^XBDIQ1(DIC,DA,DR,DIQ,DIQ(0))
; Count all bills (all visit locations)
S (BARA,BARC)=0
F S BARA=$O(^BARFRP(DUZ(2),BARIEN,2,BARA)) Q:'+BARA D
. S BARB=0
. F S BARB=$O(^BARFRP(DUZ(2),BARIEN,2,BARA,3,BARB)) Q:'+BARB D
. . S BARC=BARC+1 ; Bill counter
S BARIN1=BARREV(BARIEN,.04,"I") ; IEN to A/R COLLECTION BATCH File
S BARIN2=BARREV(BARIEN,.05,"I") ; IEN to ITEM mult of A/R COLL BATCH
S BARBEG=$$VAL^XBDIQ1(90051.1101,"BARIN1,BARIN2",19) ; Beginning balan
S BAREND=BARBEG-(BARC*BARREV(BARIEN,.09)) ; Ending balance
; Write header
W !?7,"Batch Name: ",BARREV(BARIEN,.04)
W ?50,"Starting Balance: ",$J(BARBEG,9,2)
K DA,DIC,DR,DIQ
S DA(1)=BARIN1,DA=BARIN2
W !?6,"Item Number: ",$$VAL^XBDIQ1(90051.1101,"BARIN1,BARIN2",.01)
W ?52,"Ending Balance: ",$J(BAREND,9,2)
W !?5,"Check Number: ",$$VAL^XBDIQ1(90051.1101,"BARIN1,BARIN2",11)
W ?48,"# of Bills to Post: ",$J(BARC,9)
W !?12,"Payor: ",$$VAL^XBDIQ1(90051.1101,"BARIN1,BARIN2",201)
W !?3,"Payment Amount: ",$J(BARREV(BARIEN,.09),9,2)
; Write Adjustment data in header portion
S BARA=0
F S BARA=$O(^BARFRP(DUZ(2),BARIEN,1,BARA)) Q:'+BARA D ADJHDR
W !!,"Bill #",?21,"Patient Name",?41,"Billed Amt",?56,"DOS",?67,"Payor Billed"
W !
; Loop facilities to get data lines and print data
S BARA=0
F S BARA=$O(^BARFRP(DUZ(2),BARIEN,2,BARA)) Q:'+BARA D FACLINE
Q
; *********************************************************************
;
ADJHDR ;
; Get and print data for Adjustments in header portion of view
K DIC,DA,DIQ,DR,BARREV2
S DIC=90054.0101
S DA(1)=BARIEN ; IEN to A/R FLAT RATE POSTING File
S DA=BARA ; IEN to ADJUSTMENTS mult in FRP File
S DR=".01;.02;.03" ; Category, Type, Amount
S DIQ="BARREV2("
S DIQ(0)="2I"
D ENP^XBDIQ1(DIC,"BARIEN,BARA",DR,DIQ,DIQ(0))
W !,"Adjustment Amount: ",$J(BARREV2(BARIEN,BARA,.03),9,2)
W ?35,"Category: ",BARREV2(BARIEN,BARA,.01)
W ?60,"Type: ",BARREV2(BARIEN,BARA,.02)
Q
; *********************************************************************
;
FACLINE ;
; Get facility, if bills under facility, write facility
K DIC,DA,DIQ,DR
S DA(1)=BARIEN ; IEN to A/R FLAT RATE POSTING File
S DA=BARA ; IEN to VISIT LOCATION mult in FRP file
S BARRF=$$VAL^XBDIQ1(90054.0102,"BARIEN,BARA",.01) ; Facility name
I $D(^BARFRP(DUZ(2),BARIEN,2,BARA,3,"B")) W !?10,BARRF,!
S BARB=0
; Loop bills and print data line
F S BARB=$O(^BARFRP(DUZ(2),BARIEN,2,BARA,3,BARB)) Q:'+BARB D BILLINE
Q
; *********************************************************************
;
BILLINE ;
; Get bill data and print data line
K DIC,DA,DIQ,DR,BARREV3
S DA(2)=BARIEN ; IEN to A/R FLAT RATE POSTING File
S DA(1)=BARA ; IEN to VISIT LOCATION mut if FRP File
S DA=BARB ; IEN to A/R BILLS mult of VISIT mult of FRP File
S BARVBL=$$VALI^XBDIQ1(90054.0103,"BARIEN,BARA,BARB",.01)
K DIC,DA,DR,DIQ
S DIC=90050.01
S DA=BARVBL ; IEN to A/R BILL File
; DR = Bill Number, Patient, Amount Billed, DOS Begin, A/R Account
S DR=".01;101;13;102;3"
S DIQ="BARREV3("
S DIQ(0)="2I"
D ENP^XBDIQ1(DIC,DA,DR,DIQ,DIQ(0))
W !,BARREV3(BARVBL,.01) ; Bill Number
W ?21,BARREV3(BARVBL,101) ; Patient
W ?43,$J(BARREV3(BARVBL,13),8,2) ; Amount Billed
W ?53,$$SDT^BARDUTL(BARREV3(BARVBL,102,"I")) ; DOS Begin
W ?66,BARREV3(BARVBL,3) ; A/R Account
Q
BARFPST4 ; IHS/SD/LSL - A/R FLAT RATE POSTING #3 ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;;
DOC ;
+1 ; LSL - 01/01/2000 - Created routine
+2 ; Contains code for Reviewing bills in A/R FLAT RATE POSTING File
+3 ; May be called from FBL View Flat Rate Bills Option or
+4 ; by choosing REVIEW from Select Command Prompt in the
+5 ; FRP Flat Rate Posting Option.
+6 ;;
+7 QUIT
+8 ; *********************************************************************
+9 ;
EN ; EP
+1 ; EP - View flate rate posting entries
+2 ; Get Flat Rate Posting Entry to view
DO FRPENTRY
+3 ; Quit if don't select FRP Batch
IF Y<1
DO EXIT^BARFPST
QUIT
+4 ; View entry using XBLM
DO REVIEW
+5 QUIT
+6 ; *********************************************************************
+7 ;
FRPENTRY ;
+1 ;Look up Flate Rate Posting entry
+2 WRITE !
+3 KILL DIC
+4 SET DIC="^BARFRP(DUZ(2),"
+5 SET DIC(0)="AEMQZ"
+6 SET DIC("A")="Select FRP batch: "
+7 DO ^DIC
+8 IF Y<1
QUIT
+9 ; IEN to A/R FLAT RATE POSTING File
SET BARIEN=+Y
+10 ; Name of FRP batch
SET BARNAME=Y(0,0)
+11 QUIT
+12 ; *********************************************************************
+13 ;
REVIEW ; EP
+1 ; EP - Review entries
+2 DO VIEWR^XBLM("REVIEW2^BARFPST4","A/R Flat Rate Posting Summary")
+3 SET BARFLAG=1
+4 QUIT
+5 ; *********************************************************************
+6 ;
REVIEW2 ;
+1 ; Print Report code used in XBLM call
+2 ; Get batch, item, payment, item amount from FRP file
+3 KILL DA,DIC,DR,DIQ,BARREV
+4 SET DIC=90054.01
+5 ; IEN to A/R FLAT RATE POSTING File
SET DA=BARIEN
+6 SET DR=".04;.05;.09;.1"
+7 SET DIQ="BARREV("
+8 SET DIQ(0)="2I"
+9 DO ENP^XBDIQ1(DIC,DA,DR,DIQ,DIQ(0))
+10 ; Count all bills (all visit locations)
+11 SET (BARA,BARC)=0
+12 FOR
SET BARA=$ORDER(^BARFRP(DUZ(2),BARIEN,2,BARA))
IF '+BARA
QUIT
Begin DoDot:1
+13 SET BARB=0
+14 FOR
SET BARB=$ORDER(^BARFRP(DUZ(2),BARIEN,2,BARA,3,BARB))
IF '+BARB
QUIT
Begin DoDot:2
+15 ; Bill counter
SET BARC=BARC+1
End DoDot:2
End DoDot:1
+16 ; IEN to A/R COLLECTION BATCH File
SET BARIN1=BARREV(BARIEN,.04,"I")
+17 ; IEN to ITEM mult of A/R COLL BATCH
SET BARIN2=BARREV(BARIEN,.05,"I")
+18 ; Beginning balan
SET BARBEG=$$VAL^XBDIQ1(90051.1101,"BARIN1,BARIN2",19)
+19 ; Ending balance
SET BAREND=BARBEG-(BARC*BARREV(BARIEN,.09))
+20 ; Write header
+21 WRITE !?7,"Batch Name: ",BARREV(BARIEN,.04)
+22 WRITE ?50,"Starting Balance: ",$JUSTIFY(BARBEG,9,2)
+23 KILL DA,DIC,DR,DIQ
+24 SET DA(1)=BARIN1
SET DA=BARIN2
+25 WRITE !?6,"Item Number: ",$$VAL^XBDIQ1(90051.1101,"BARIN1,BARIN2",.01)
+26 WRITE ?52,"Ending Balance: ",$JUSTIFY(BAREND,9,2)
+27 WRITE !?5,"Check Number: ",$$VAL^XBDIQ1(90051.1101,"BARIN1,BARIN2",11)
+28 WRITE ?48,"# of Bills to Post: ",$JUSTIFY(BARC,9)
+29 WRITE !?12,"Payor: ",$$VAL^XBDIQ1(90051.1101,"BARIN1,BARIN2",201)
+30 WRITE !?3,"Payment Amount: ",$JUSTIFY(BARREV(BARIEN,.09),9,2)
+31 ; Write Adjustment data in header portion
+32 SET BARA=0
+33 FOR
SET BARA=$ORDER(^BARFRP(DUZ(2),BARIEN,1,BARA))
IF '+BARA
QUIT
DO ADJHDR
+34 WRITE !!,"Bill #",?21,"Patient Name",?41,"Billed Amt",?56,"DOS",?67,"Payor Billed"
+35 WRITE !
+36 ; Loop facilities to get data lines and print data
+37 SET BARA=0
+38 FOR
SET BARA=$ORDER(^BARFRP(DUZ(2),BARIEN,2,BARA))
IF '+BARA
QUIT
DO FACLINE
+39 QUIT
+40 ; *********************************************************************
+41 ;
ADJHDR ;
+1 ; Get and print data for Adjustments in header portion of view
+2 KILL DIC,DA,DIQ,DR,BARREV2
+3 SET DIC=90054.0101
+4 ; IEN to A/R FLAT RATE POSTING File
SET DA(1)=BARIEN
+5 ; IEN to ADJUSTMENTS mult in FRP File
SET DA=BARA
+6 ; Category, Type, Amount
SET DR=".01;.02;.03"
+7 SET DIQ="BARREV2("
+8 SET DIQ(0)="2I"
+9 DO ENP^XBDIQ1(DIC,"BARIEN,BARA",DR,DIQ,DIQ(0))
+10 WRITE !,"Adjustment Amount: ",$JUSTIFY(BARREV2(BARIEN,BARA,.03),9,2)
+11 WRITE ?35,"Category: ",BARREV2(BARIEN,BARA,.01)
+12 WRITE ?60,"Type: ",BARREV2(BARIEN,BARA,.02)
+13 QUIT
+14 ; *********************************************************************
+15 ;
FACLINE ;
+1 ; Get facility, if bills under facility, write facility
+2 KILL DIC,DA,DIQ,DR
+3 ; IEN to A/R FLAT RATE POSTING File
SET DA(1)=BARIEN
+4 ; IEN to VISIT LOCATION mult in FRP file
SET DA=BARA
+5 ; Facility name
SET BARRF=$$VAL^XBDIQ1(90054.0102,"BARIEN,BARA",.01)
+6 IF $DATA(^BARFRP(DUZ(2),BARIEN,2,BARA,3,"B"))
WRITE !?10,BARRF,!
+7 SET BARB=0
+8 ; Loop bills and print data line
+9 FOR
SET BARB=$ORDER(^BARFRP(DUZ(2),BARIEN,2,BARA,3,BARB))
IF '+BARB
QUIT
DO BILLINE
+10 QUIT
+11 ; *********************************************************************
+12 ;
BILLINE ;
+1 ; Get bill data and print data line
+2 KILL DIC,DA,DIQ,DR,BARREV3
+3 ; IEN to A/R FLAT RATE POSTING File
SET DA(2)=BARIEN
+4 ; IEN to VISIT LOCATION mut if FRP File
SET DA(1)=BARA
+5 ; IEN to A/R BILLS mult of VISIT mult of FRP File
SET DA=BARB
+6 SET BARVBL=$$VALI^XBDIQ1(90054.0103,"BARIEN,BARA,BARB",.01)
+7 KILL DIC,DA,DR,DIQ
+8 SET DIC=90050.01
+9 ; IEN to A/R BILL File
SET DA=BARVBL
+10 ; DR = Bill Number, Patient, Amount Billed, DOS Begin, A/R Account
+11 SET DR=".01;101;13;102;3"
+12 SET DIQ="BARREV3("
+13 SET DIQ(0)="2I"
+14 DO ENP^XBDIQ1(DIC,DA,DR,DIQ,DIQ(0))
+15 ; Bill Number
WRITE !,BARREV3(BARVBL,.01)
+16 ; Patient
WRITE ?21,BARREV3(BARVBL,101)
+17 ; Amount Billed
WRITE ?43,$JUSTIFY(BARREV3(BARVBL,13),8,2)
+18 ; DOS Begin
WRITE ?53,$$SDT^BARDUTL(BARREV3(BARVBL,102,"I"))
+19 ; A/R Account
WRITE ?66,BARREV3(BARVBL,3)
+20 QUIT
