BARFPST2 ; IHS/SD/LSL - A/R FLAT RATE POSTING (CONT) ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;;
DOC ;
; LSL - 12/31/1999 - Created routine
; Contains code for saving data to A/R FLAT RATE POSTING File
;;
Q
; *********************************************************************
BARSAV ; EP
; EP - Save data in A/R FLAT RATE POSTING File
S BARFRPC=$$VAL^XBDIQ1(200,DUZ,1) ; Initials of user
D NOW^%DTC ; Current date/time
S BARDT=% ; FM entry date
; FRP postable amount
S BARPAMT=$$VAL^XBDIQ1(90051.1101,"BARCOL,BARITM",19)
D:'$D(BARIEN) NEWENTRY ; Create new entry
Q:$D(BARNONE) ; Q if entry to FRP file fails
D CORDAT ; Save data not placed in a mult
D:$D(BARADJ) ADJDAT ; Save adjustment data
D FACDAT ; Save facility data
Q
; *********************************************************************
;
NEWENTRY ;
; Create new entry in A/R FLAT RATE POSTING File
; Build BARNAME
S Y=BARDT X ^DD("DD") ; Entry date in external format
S BARNAME=BARFRPC_"-"_Y ; FRP batch name (init-date)
; Create new entry
K DIC
S DIC="^BARFRP(DUZ(2),"
S DIC(0)="L"
S DIC("P")=$P(^DIC(90054.01,0),U,2)
S X=BARNAME
K DD,DO
D FILE^DICN ; Add entry to FRP
K DIC
I +Y<1 D Q
. W *7
. W !!,"Entry in A/R FLAT RATE POSTING File was not created."
. W !,"Contact your supervisor."
. S BARNONE=1 ; Flag - entry failed
S BARIEN=+Y ; IEN to A/R FLAT RATE POSTING File
Q
; *********************************************************************
;
CORDAT ;
; Enter data in A/R FLAT RATE POSTING File that doesn't go in a mult
K DA,DR,DIE
S DIE="^BARFRP(DUZ(2),"
S DA=BARIEN ; IEN to A/R FLAT RATE POSTING File
S DR=".02////"_BARDT ; Date Entered
S DR=DR_";.04////"_BARCOL ; Batch Name
S DR=DR_";.05////"_BARITM ; Batch Item Number
S DR=DR_";.06////"_DUZ ; FRP Entry Clerk
S DR=DR_";.08////"_DUZ(2) ; Parent Facility
S:$D(BARPAY) DR=DR_";.09///"_BARPAY ; Payment Amount
S DR=DR_";.1///"_BARPAMT ; Item postable amount
D ^DIE
Q
; *********************************************************************
;
ADJDAT ;
; Enter data in Adjustments multiple of A/R FLATE RATE POSTING File
; Kill current Adjustments multiple in A/R FLAT RATE POSTING File
S DA(1)=BARIEN ; IEN to A/R FLAT RATE POSTING File
S DIK="^BARFRP(DUZ(2),"_DA(1)_",1,"
S I=0
F S I=$O(^BARFRP(DUZ(2),DA(1),1,I)) Q:'+I D ; Loop adjustments
. S DA=I
. D ^DIK ; Kill Adjustment entry
S I=0
F S I=$O(BARADJ(I)) Q:'+I D ; Loop Adjustment array
. S BARSCAT=$P(BARADJ(I),U,2) ; IEN to A/R TABLE TYPE /IHS (Cat)
. S BARSTYP=$P(BARADJ(I),U,4) ; IEN to A/R TABLE ENTRY /IHS (Type)
. S BARSAMT=$P(BARADJ(I),U) ; Adjustment Amount
. K DIC
. S DIC="^BARFRP(DUZ(2),"_BARIEN_",1,"
. S DIC("P")=$P(^DD(90054.01,10,0),U,2)
. S DIC(0)="L"
. S DIC("DR")=".02////"_BARSTYP_";.03////"_BARSAMT
. S X=BARSCAT
. K DD,DO
. D FILE^DICN ; Create Adjustment entry
Q
; *********************************************************************
;
FACDAT ;
; Enter facility data
S BARENTF=$D(^BARFRP(DUZ(2),BARIEN,2,"B",BAREOB))
; If this Fac not in A/R FLAT RATE POSTING File, create new entry
I BARENTF=0!(BARENTF=1) D
. K DIC
. S DA(1)=BARIEN ; IEN to A/R FLAT RATE POSTING File
. S DIC="^BARFRP(DUZ(2),"_BARIEN_",2,"
. S DIC("P")=$P(^DD(90054.01,20,0),U,2)
. S DIC(0)="L"
. S X=BAREOB ; IEN to VISIT LOC mult of A/R COLL
. K DD,DO
. D FILE^DICN ; Create VISIT LOC entry in FRP
. S BARFIEN=+Y ; IEN to VISIT LOC mult of FRP
E S BARFIEN=$O(^BARFRP(DUZ(2),BARIEN,2,"B",BAREOB,""))
Q
; *********************************************************************
;
TOT(X) ; EP
; EP - Computed field ITEM BALANCE
; X = FRP Batch IEN
S (I,BARCNT)=0
F S I=$O(^BARFRP(DUZ(2),X,2,I)) Q:'+I D
. S J=0
. F S J=$O(^BARFRP(DUZ(2),X,2,I,3,J)) Q:'+J D
. . S BARCNT=BARCNT+1 ; Number of bills
S BARPAMNT=$P($G(^BARFRP(DUZ(2),X,0)),U,9) ; Payment amount
S BARTOT=BARPAMNT*BARCNT ; Total Payments
Q BARTOT
; *********************************************************************
;
FACTOT(X,Y) ; EP
; EP - computed field TOTAL POSTED AMOUNT (by visit location)
; X = FRP batch IEN
; Y = FAC IEN
S BARCNT=0
N I
S I=0
F S I=$O(^BARFRP(DUZ(2),X,2,Y,3,I)) Q:'+I D
. S BARCNT=BARCNT+1 ; Number of bills this FAC
S BARPAMNT=$P($G(^BARFRP(DUZ(2),X,0)),U,9) ; Payment amount
S BARFTOT=BARPAMNT*BARCNT ; Total payments
Q BARFTOT
BARFPST2 ; IHS/SD/LSL - A/R FLAT RATE POSTING (CONT) ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;;
DOC ;
+1 ; LSL - 12/31/1999 - Created routine
+2 ; Contains code for saving data to A/R FLAT RATE POSTING File
+3 ;;
+4 QUIT
+5 ; *********************************************************************
BARSAV ; EP
+1 ; EP - Save data in A/R FLAT RATE POSTING File
+2 ; Initials of user
SET BARFRPC=$$VAL^XBDIQ1(200,DUZ,1)
+3 ; Current date/time
DO NOW^%DTC
+4 ; FM entry date
SET BARDT=%
+5 ; FRP postable amount
+6 SET BARPAMT=$$VAL^XBDIQ1(90051.1101,"BARCOL,BARITM",19)
+7 ; Create new entry
IF '$DATA(BARIEN)
DO NEWENTRY
+8 ; Q if entry to FRP file fails
IF $DATA(BARNONE)
QUIT
+9 ; Save data not placed in a mult
DO CORDAT
+10 ; Save adjustment data
IF $DATA(BARADJ)
DO ADJDAT
+11 ; Save facility data
DO FACDAT
+12 QUIT
+13 ; *********************************************************************
+14 ;
NEWENTRY ;
+1 ; Create new entry in A/R FLAT RATE POSTING File
+2 ; Build BARNAME
+3 ; Entry date in external format
SET Y=BARDT
XECUTE ^DD("DD")
+4 ; FRP batch name (init-date)
SET BARNAME=BARFRPC_"-"_Y
+5 ; Create new entry
+6 KILL DIC
+7 SET DIC="^BARFRP(DUZ(2),"
+8 SET DIC(0)="L"
+9 SET DIC("P")=$PIECE(^DIC(90054.01,0),U,2)
+10 SET X=BARNAME
+11 KILL DD,DO
+12 ; Add entry to FRP
DO FILE^DICN
+13 KILL DIC
+14 IF +Y<1
Begin DoDot:1
+15 WRITE *7
+16 WRITE !!,"Entry in A/R FLAT RATE POSTING File was not created."
+17 WRITE !,"Contact your supervisor."
+18 ; Flag - entry failed
SET BARNONE=1
End DoDot:1
QUIT
+19 ; IEN to A/R FLAT RATE POSTING File
SET BARIEN=+Y
+20 QUIT
+21 ; *********************************************************************
+22 ;
CORDAT ;
+1 ; Enter data in A/R FLAT RATE POSTING File that doesn't go in a mult
+2 KILL DA,DR,DIE
+3 SET DIE="^BARFRP(DUZ(2),"
+4 ; IEN to A/R FLAT RATE POSTING File
SET DA=BARIEN
+5 ; Date Entered
SET DR=".02////"_BARDT
+6 ; Batch Name
SET DR=DR_";.04////"_BARCOL
+7 ; Batch Item Number
SET DR=DR_";.05////"_BARITM
+8 ; FRP Entry Clerk
SET DR=DR_";.06////"_DUZ
+9 ; Parent Facility
SET DR=DR_";.08////"_DUZ(2)
+10 ; Payment Amount
IF $DATA(BARPAY)
SET DR=DR_";.09///"_BARPAY
+11 ; Item postable amount
SET DR=DR_";.1///"_BARPAMT
+12 DO ^DIE
+13 QUIT
+14 ; *********************************************************************
+15 ;
ADJDAT ;
+1 ; Enter data in Adjustments multiple of A/R FLATE RATE POSTING File
+2 ; Kill current Adjustments multiple in A/R FLAT RATE POSTING File
+3 ; IEN to A/R FLAT RATE POSTING File
SET DA(1)=BARIEN
+4 SET DIK="^BARFRP(DUZ(2),"_DA(1)_",1,"
+5 SET I=0
+6 ; Loop adjustments
FOR
SET I=$ORDER(^BARFRP(DUZ(2),DA(1),1,I))
IF '+I
QUIT
Begin DoDot:1
+7 SET DA=I
+8 ; Kill Adjustment entry
DO ^DIK
End DoDot:1
+9 SET I=0
+10 ; Loop Adjustment array
FOR
SET I=$ORDER(BARADJ(I))
IF '+I
QUIT
Begin DoDot:1
+11 ; IEN to A/R TABLE TYPE /IHS (Cat)
SET BARSCAT=$PIECE(BARADJ(I),U,2)
+12 ; IEN to A/R TABLE ENTRY /IHS (Type)
SET BARSTYP=$PIECE(BARADJ(I),U,4)
+13 ; Adjustment Amount
SET BARSAMT=$PIECE(BARADJ(I),U)
+14 KILL DIC
+15 SET DIC="^BARFRP(DUZ(2),"_BARIEN_",1,"
+16 SET DIC("P")=$PIECE(^DD(90054.01,10,0),U,2)
+17 SET DIC(0)="L"
+18 SET DIC("DR")=".02////"_BARSTYP_";.03////"_BARSAMT
+19 SET X=BARSCAT
+20 KILL DD,DO
+21 ; Create Adjustment entry
DO FILE^DICN
End DoDot:1
+22 QUIT
+23 ; *********************************************************************
+24 ;
FACDAT ;
+1 ; Enter facility data
+2 SET BARENTF=$DATA(^BARFRP(DUZ(2),BARIEN,2,"B",BAREOB))
+3 ; If this Fac not in A/R FLAT RATE POSTING File, create new entry
+4 IF BARENTF=0!(BARENTF=1)
Begin DoDot:1
+5 KILL DIC
+6 ; IEN to A/R FLAT RATE POSTING File
SET DA(1)=BARIEN
+7 SET DIC="^BARFRP(DUZ(2),"_BARIEN_",2,"
+8 SET DIC("P")=$PIECE(^DD(90054.01,20,0),U,2)
+9 SET DIC(0)="L"
+10 ; IEN to VISIT LOC mult of A/R COLL
SET X=BAREOB
+11 KILL DD,DO
+12 ; Create VISIT LOC entry in FRP
DO FILE^DICN
+13 ; IEN to VISIT LOC mult of FRP
SET BARFIEN=+Y
End DoDot:1
+14 IF '$TEST
SET BARFIEN=$ORDER(^BARFRP(DUZ(2),BARIEN,2,"B",BAREOB,""))
+15 QUIT
+16 ; *********************************************************************
+17 ;
TOT(X) ; EP
+1 ; EP - Computed field ITEM BALANCE
+2 ; X = FRP Batch IEN
+3 SET (I,BARCNT)=0
+4 FOR
SET I=$ORDER(^BARFRP(DUZ(2),X,2,I))
IF '+I
QUIT
Begin DoDot:1
+5 SET J=0
+6 FOR
SET J=$ORDER(^BARFRP(DUZ(2),X,2,I,3,J))
IF '+J
QUIT
Begin DoDot:2
+7 ; Number of bills
SET BARCNT=BARCNT+1
End DoDot:2
End DoDot:1
+8 ; Payment amount
SET BARPAMNT=$PIECE($GET(^BARFRP(DUZ(2),X,0)),U,9)
+9 ; Total Payments
SET BARTOT=BARPAMNT*BARCNT
+10 QUIT BARTOT
+11 ; *********************************************************************
+12 ;
FACTOT(X,Y) ; EP
+1 ; EP - computed field TOTAL POSTED AMOUNT (by visit location)
+2 ; X = FRP batch IEN
+3 ; Y = FAC IEN
+4 SET BARCNT=0
+5 NEW I
+6 SET I=0
+7 FOR
SET I=$ORDER(^BARFRP(DUZ(2),X,2,Y,3,I))
IF '+I
QUIT
Begin DoDot:1
+8 ; Number of bills this FAC
SET BARCNT=BARCNT+1
End DoDot:1
+9 ; Payment amount
SET BARPAMNT=$PIECE($GET(^BARFRP(DUZ(2),X,0)),U,9)
+10 ; Total payments
SET BARFTOT=BARPAMNT*BARCNT
+11 QUIT BARFTOT
