ABMAROLL ; IHS/ASDST/DMJ - A/R ROLL OVER ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;
;
; IHS/DSD/LSL 03/30/98 - Don't complete a cancelled
; bill. This will cause errors on productivity
; report and previous payments of bills.
;
; IHS/DSD/DMJ 07/23/99 - NOIS PEB-0799-90049 Patch 3 #8
; Changed from the DIC("DR") method to updating each field
; individually. Apparently if one field in the string fails,
; fileman doesn't file anything.
;
; IHS/ASDS/SDH - 08/14/01 - V2.4 Patch 9 - NOIS NDA-1199-180065
; Modified routine to subtract refund instead of add (two negatives
; makes a positive)
;
; IHS/SD/SDR - 5/28/02 - V2.5 P2 - NOIS HQW-1201-100023
; Modified so that the export date will not be deleted anymore.
; This was causing problems with some reports not showing correct
; data because of this date missing.
;
; IHS/SD/SDR - 6/6/05 V2.5 p8
; Made LKUP and FILE published entry points per A/R
;
; IHS/SD/SDR - v2.5 p9 - IM19622
; Fixed so replacement insurer is checked when updating status
;
; IHS/SD/SDR - v2.5 p 13 - NO IM
;
; *********************************************************************
;
START(X,ABM,Z,ZZ) ;EP - FROM A/R
;
; This routine is called from A/R ^BARROLL. The purpose is to
; file payment information into the Payment multiple of 3P BILL.
; After filing this data, the bill is marked as completed.
; Variables are then set in preparation of calling the Eligibility
; Checker. This is done to find other billable sources that have
; not yet been billed in relation to this claim. If other billable
; sources exist and the user holds the 3PB key, they are asked if
; the claim should be re-opened for future billing. Otherwise, the
; claim is automatically reopened.
; Rtn has been modified to work if called by either A/R 1.0 or 1.1
;
; Input: X = BILL INTERNAL ENTRY NUMBER^VISIT LOCATION
; ABM = PAYMENT ARRAY from 1.1
; TOTAL PAYMENT AMT FROM 1.0
; Z = BILL NAME from 1.1
; Not passed by 1.0
; ZZ = A/R MESSAGE
;
S ABMP("BDFN")=+X ; IEN to 3PB BILL
S ABMP("BILL")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",1) ; Bill #
I '$D(Z) D ; Z UNDEF IFF rtn called by A/R 1.0
.S ABMP("AR1.0")=""
.S Y=ABM
.K ABM
.S ABM("AMT")=Y
I $G(Z)]"",ABMP("BILL")'=Z D LKUP
I 'ABMP("BDFN") D Q
.W !,"Cannot locate bill ",Z," in 3P Bill file.",!
D FILE ; File A/R data in payment multiple of 3P BILL
D SET ; Set variables necessary for Eligibility Checker
D REST ; Look for unused billable sources
K ABM,ABMP,ABMA
Q
;
LKUP ; PEP - LOOK UP ABMP("BDFN")
S ABMP("BDFN")=$O(^ABMDBILL(DUZ(2),"B",Z,0))
Q:'ABMP("BDFN")
S ABMP("BILL")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",1)
Q
;
FILE ; PEP - FILE PAYMENT INFORMATION
; OK for both 1.0 and 1.1
; The payment multiple will contain cumulative data about that bill
;
; 3PB field = A/R field
;
; Payment Amount = Payments + 3P Previous Payments + Payment
; Adjustments - Refunds
; Deductible = Deductible
; Co-Insurance = Co-pay
; Write Offs = Write Offs
; Non-covered = Non payments
; Penalties = Penalties
;
I $D(ABMP("AR1.0")) D
.S:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),3)) ^(3,0)="^9002274.403D^^"
E D
.K ^ABMDBILL(DUZ(2),ABMP("BDFN"),3) ; Payment multiple
.S ^ABMDBILL(DUZ(2),ABMP("BDFN"),3,0)="^9002274.403D^^"
S DA(1)=ABMP("BDFN")
S X=DT
S DIC="^ABMDBILL(DUZ(2),DA(1),3,"
S DIC(0)="L"
K DD,DO D FILE^DICN
S DA=+Y
S DIE=DIC
I $D(ABMP("AR1.0")) D
.Q:Y<0
.S DR=".02///"_ABM("AMT") D ^DIE
I '$D(ABMP("AR1.0")) D
.Q:Y<0
.S ABM("NPAY")=+$G(ABM("PAY"))+$G(ABM("3P"))+$G(ABM("PCR"))+$G(ABM("RF"))
.S DR=".02///"_ABM("NPAY") D ^DIE ;Payment Amount
.I $G(ABM("DED")) S DR=".03///"_ABM("DED") D ^DIE ;Deductible
.I $G(ABM("COP")) S DR=".04///"_ABM("COP") D ^DIE ; Co-Insurance
.I $G(ABM("WO")) S DR=".06///"_ABM("WO") D ^DIE ; Write Offs
.I $G(ABM("NP")) S DR=".07///"_ABM("NP") D ^DIE ; Non-covered
.I $G(ABM("PEN")) S DR=".09///"_ABM("PEN") D ^DIE ; Penalties
.I $G(ABM("PAY")) S DR=".1///"_ABM("PAY") D ^DIE ; A/R Payments
.I $G(ABM("3P")) S DR=".11///"_ABM("3P") D ^DIE ; 3P Prev Payments
.I $G(ABM("GRP")) S DR=".12///"_ABM("GRP") D ^DIE ; Grouper Allowance
.I $G(ABM("RF")) S DR=".13///"_ABM("RF") D ^DIE ; A/R Refund
.I $G(ABM("PCR")) S DR=".14///"_ABM("PCR") D ^DIE ; A/R Pymt Adjust
D CBIL ; Close the bill
Q
CBIL ;
; EP for Closing Bill
; OK for both 1.0 and 1.1
Q:$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,4)="X" ; Q if cancelled bill
; Mark bill status "complete" (.04) and delete export number (.17)
S DIE="^ABMDBILL(DUZ(2),"
S DA=ABMP("BDFN")
S DR=".04////C"
D ^DIE
K DR
Q
;
SET ;
; set up needed variables for Eligibility Checker
S ABMP("PDFN")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",5) ; Patient
S ABMP("INS")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",8) ; Active Ins
S ABMP("VDT")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),"^",1) ; Srv dt frm
Q
;
REST ;
; Quit if billed manually. . . no other sources to find
I +ABMP("BILL")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U) Q
; Check to see if the claim has been cancelled.
S ABMP("CDFN")=+ABMP("BILL")
I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)) W !,"CLAIM #",ABMP("CDFN")," HAS BEEN CANCELLED.",! Q
N I
S I=0,DA=0
;
; Loop through the insurer multiple, if the insurer is active and is
; the same as the active insurer, mark that insurer as complete.
F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I)) Q:'I D
.I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),"^",3)="I",$P(^(0),"^",1)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",8) S DA=I
.I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),"^",3)="I",$P(^(0),"^",11)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",8) S DA=I
I DA D
.S DA(1)=ABMP("CDFN")
.Q:'$D(^ABMDCLM(DUZ(2),DA(1),13,DA))
.S DIE="^ABMDCLM("_DUZ(2)_","_DA(1)_",13,"
.S DR=".03////C"
.D ^DIE
.K DR
; Quit if claim is already in edit status
I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",4)="E" D Q
. W !,"Claim is already in edit status.",!
;
UNBILL ;
; Look for additional sources that have not yet been billed
W !!,"CHECKING FOR UNBILLED SOURCES.",!
S (ABM("HIT"),ABM("CNT"))=0
; Eligibility checker. . .add any other insurers and prioritize
D ELG^ABMDLCK("",.ABML,ABMP("PDFN"),ABMP("VDT"))
N I
S I=0
;
; Loop through insurers in order of priority and update the
; insurer multiple in 3P BILL w/ insurer and coverage data.
F S I=$O(ABML(I)) Q:'I D
.N J
.S J=0
.F S J=$O(ABML(I,J)) Q:'J D
..S ABM("PRI")=I
..S ABM("INS")=J
..D ADDCHK^ABMDE2E
;
; Determine if source (insurer) is billable
; Loop through insurer multiple in priority order (C x-ref), if the
; claim status is Pending, active, flagged or partial and patient is
; non-indian and insurer is billable. . .display as a billable
; source.
S ABM=""
F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM)) Q:'ABM D
.S ABM("X")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,0))
.I '$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("X"),0)) K ^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,ABM("X")) Q
.I "PIFL"[$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("X"),0),U,3) D
..S ABM("INSCO")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("X"),0),"^",1)
..Q:$P($G(^AUTNINS(ABM("INSCO"),2)),U)="I"
..Q:$P($G(^AUTNINS(ABM("INSCO"),1)),U,7)=4
..W:ABM("CNT") !
..S ABM("CNT")=ABM("CNT")+1
..W ?18,"[",ABM("CNT"),"] ",$P(^AUTNINS(ABM("INSCO"),0),U)
..S ABM(ABM("CNT"))=ABM("X")
;
; No other billable sources so mark claim as complete
I ABM("CNT")=0 D K ABM,ABMP Q
.D CCLM ; mark claim as complete
.W "NONE",!!,"Since there are no unbilled sources no further billing is possible."
S ABM("HIT")=ABM(1)
S Y=1 ; flag used for reopening a claim
; If user access to below option, ask to reopen claim
; Note that if this key name gets changed this code needs changing
I $D(^XUSEC("ABMDZ EDIT CLAIM AND EXPORT",DUZ)) D
.W !
.S DIR(0)="Y"
.S DIR("A")="Re-open claim for further billing? (Y/N)"
.D ^DIR
.K DIR
.Q:$D(DIRUT)
; If answer is no, complete the claim
I Y'=1 D CCLM K ABM,ABMP Q
; Else reopen the claim
S DIE="^ABMDBILL(DUZ(2),"
S DA=ABMP("BDFN")
S DR=".24////"_Y
D ^DIE
D OCLM ; Open claim for editing
S DA(1)=ABMP("CDFN")
S DIE="^ABMDCLM("_DUZ(2)_","_DA(1)_",13,"
S DA=ABM("HIT")
S DR=".03////I"
D ^DIE ; Make insurer status (multiple) active
K ABM,ABMP
Q
;
ADD ;
; Add bill not currently in 3P BILL
; MAYBE WILL DO LATER
Q
;
OCLM ;
; Open claim for editing
S DA=ABMP("CDFN")
S DIE="^ABMDCLM("_DUZ(2)_","
S DR=".04////O;.08////"_$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("HIT"),0),U)
D ^DIE
;put remark if billed insurer is tribal self-insured and Medicare insurer is next
I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,11)="Y"&($P($G(^AUTNINS(ABM(1),2)),U)="R") D
.K DIC,DIE,X,Y,DA
.S DA(1)=ABMP("CDFN")
.S DIC="^ABMDCLM("_DUZ(2)_","_DA(1)_",61,"
.S DIC(0)="L"
.S DIC("P")=$P(^DD(9002274.3,61,0),U,2)
.S X="PT HAS TRIBAL SELF-FUNDED INSURANCE"
.D ^DIC
W !!,"Claim Number: ",+ABMP("BILL")," is now Open for Editing!",!
Q
;
CCLM ;
; Complete a claim
S DA=ABMP("CDFN")
S DIE="^ABMDCLM("_DUZ(2)_","
S DR=".04////C"
D ^DIE
Q
ABMAROLL ; IHS/ASDST/DMJ - A/R ROLL OVER ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;
+3 ;
+4 ; IHS/DSD/LSL 03/30/98 - Don't complete a cancelled
+5 ; bill. This will cause errors on productivity
+6 ; report and previous payments of bills.
+7 ;
+8 ; IHS/DSD/DMJ 07/23/99 - NOIS PEB-0799-90049 Patch 3 #8
+9 ; Changed from the DIC("DR") method to updating each field
+10 ; individually. Apparently if one field in the string fails,
+11 ; fileman doesn't file anything.
+12 ;
+13 ; IHS/ASDS/SDH - 08/14/01 - V2.4 Patch 9 - NOIS NDA-1199-180065
+14 ; Modified routine to subtract refund instead of add (two negatives
+15 ; makes a positive)
+16 ;
+17 ; IHS/SD/SDR - 5/28/02 - V2.5 P2 - NOIS HQW-1201-100023
+18 ; Modified so that the export date will not be deleted anymore.
+19 ; This was causing problems with some reports not showing correct
+20 ; data because of this date missing.
+21 ;
+22 ; IHS/SD/SDR - 6/6/05 V2.5 p8
+23 ; Made LKUP and FILE published entry points per A/R
+24 ;
+25 ; IHS/SD/SDR - v2.5 p9 - IM19622
+26 ; Fixed so replacement insurer is checked when updating status
+27 ;
+28 ; IHS/SD/SDR - v2.5 p 13 - NO IM
+29 ;
+30 ; *********************************************************************
+31 ;
START(X,ABM,Z,ZZ) ;EP - FROM A/R
+1 ;
+2 ; This routine is called from A/R ^BARROLL. The purpose is to
+3 ; file payment information into the Payment multiple of 3P BILL.
+4 ; After filing this data, the bill is marked as completed.
+5 ; Variables are then set in preparation of calling the Eligibility
+6 ; Checker. This is done to find other billable sources that have
+7 ; not yet been billed in relation to this claim. If other billable
+8 ; sources exist and the user holds the 3PB key, they are asked if
+9 ; the claim should be re-opened for future billing. Otherwise, the
+10 ; claim is automatically reopened.
+11 ; Rtn has been modified to work if called by either A/R 1.0 or 1.1
+12 ;
+13 ; Input: X = BILL INTERNAL ENTRY NUMBER^VISIT LOCATION
+14 ; ABM = PAYMENT ARRAY from 1.1
+15 ; TOTAL PAYMENT AMT FROM 1.0
+16 ; Z = BILL NAME from 1.1
+17 ; Not passed by 1.0
+18 ; ZZ = A/R MESSAGE
+19 ;
+20 ; IEN to 3PB BILL
SET ABMP("BDFN")=+X
+21 ; Bill #
SET ABMP("BILL")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",1)
+22 ; Z UNDEF IFF rtn called by A/R 1.0
IF '$DATA(Z)
Begin DoDot:1
+23 SET ABMP("AR1.0")=""
+24 SET Y=ABM
+25 KILL ABM
+26 SET ABM("AMT")=Y
End DoDot:1
+27 IF $GET(Z)]""
IF ABMP("BILL")'=Z
DO LKUP
+28 IF 'ABMP("BDFN")
Begin DoDot:1
+29 WRITE !,"Cannot locate bill ",Z," in 3P Bill file.",!
End DoDot:1
QUIT
+30 ; File A/R data in payment multiple of 3P BILL
DO FILE
+31 ; Set variables necessary for Eligibility Checker
DO SET
+32 ; Look for unused billable sources
DO REST
+33 KILL ABM,ABMP,ABMA
+34 QUIT
+35 ;
LKUP ; PEP - LOOK UP ABMP("BDFN")
+1 SET ABMP("BDFN")=$ORDER(^ABMDBILL(DUZ(2),"B",Z,0))
+2 IF 'ABMP("BDFN")
QUIT
+3 SET ABMP("BILL")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",1)
+4 QUIT
+5 ;
FILE ; PEP - FILE PAYMENT INFORMATION
+1 ; OK for both 1.0 and 1.1
+2 ; The payment multiple will contain cumulative data about that bill
+3 ;
+4 ; 3PB field = A/R field
+5 ;
+6 ; Payment Amount = Payments + 3P Previous Payments + Payment
+7 ; Adjustments - Refunds
+8 ; Deductible = Deductible
+9 ; Co-Insurance = Co-pay
+10 ; Write Offs = Write Offs
+11 ; Non-covered = Non payments
+12 ; Penalties = Penalties
+13 ;
+14 IF $DATA(ABMP("AR1.0"))
Begin DoDot:1
+15 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),3))
SET ^(3,0)="^9002274.403D^^"
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 ; Payment multiple
KILL ^ABMDBILL(DUZ(2),ABMP("BDFN"),3)
+18 SET ^ABMDBILL(DUZ(2),ABMP("BDFN"),3,0)="^9002274.403D^^"
End DoDot:1
+19 SET DA(1)=ABMP("BDFN")
+20 SET X=DT
+21 SET DIC="^ABMDBILL(DUZ(2),DA(1),3,"
+22 SET DIC(0)="L"
+23 KILL DD,DO
DO FILE^DICN
+24 SET DA=+Y
+25 SET DIE=DIC
+26 IF $DATA(ABMP("AR1.0"))
Begin DoDot:1
+27 IF Y<0
QUIT
+28 SET DR=".02///"_ABM("AMT")
DO ^DIE
End DoDot:1
+29 IF '$DATA(ABMP("AR1.0"))
Begin DoDot:1
+30 IF Y<0
QUIT
+31 SET ABM("NPAY")=+$GET(ABM("PAY"))+$GET(ABM("3P"))+$GET(ABM("PCR"))+$GET(ABM("RF"))
+32 ;Payment Amount
SET DR=".02///"_ABM("NPAY")
DO ^DIE
+33 ;Deductible
IF $GET(ABM("DED"))
SET DR=".03///"_ABM("DED")
DO ^DIE
+34 ; Co-Insurance
IF $GET(ABM("COP"))
SET DR=".04///"_ABM("COP")
DO ^DIE
+35 ; Write Offs
IF $GET(ABM("WO"))
SET DR=".06///"_ABM("WO")
DO ^DIE
+36 ; Non-covered
IF $GET(ABM("NP"))
SET DR=".07///"_ABM("NP")
DO ^DIE
+37 ; Penalties
IF $GET(ABM("PEN"))
SET DR=".09///"_ABM("PEN")
DO ^DIE
+38 ; A/R Payments
IF $GET(ABM("PAY"))
SET DR=".1///"_ABM("PAY")
DO ^DIE
+39 ; 3P Prev Payments
IF $GET(ABM("3P"))
SET DR=".11///"_ABM("3P")
DO ^DIE
+40 ; Grouper Allowance
IF $GET(ABM("GRP"))
SET DR=".12///"_ABM("GRP")
DO ^DIE
+41 ; A/R Refund
IF $GET(ABM("RF"))
SET DR=".13///"_ABM("RF")
DO ^DIE
+42 ; A/R Pymt Adjust
IF $GET(ABM("PCR"))
SET DR=".14///"_ABM("PCR")
DO ^DIE
End DoDot:1
+43 ; Close the bill
DO CBIL
+44 QUIT
CBIL ;
+1 ; EP for Closing Bill
+2 ; OK for both 1.0 and 1.1
+3 ; Q if cancelled bill
IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,4)="X"
QUIT
+4 ; Mark bill status "complete" (.04) and delete export number (.17)
+5 SET DIE="^ABMDBILL(DUZ(2),"
+6 SET DA=ABMP("BDFN")
+7 SET DR=".04////C"
+8 DO ^DIE
+9 KILL DR
+10 QUIT
+11 ;
SET ;
+1 ; set up needed variables for Eligibility Checker
+2 ; Patient
SET ABMP("PDFN")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",5)
+3 ; Active Ins
SET ABMP("INS")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",8)
+4 ; Srv dt frm
SET ABMP("VDT")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),"^",1)
+5 QUIT
+6 ;
REST ;
+1 ; Quit if billed manually. . . no other sources to find
+2 IF +ABMP("BILL")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
QUIT
+3 ; Check to see if the claim has been cancelled.
+4 SET ABMP("CDFN")=+ABMP("BILL")
+5 IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),0))
WRITE !,"CLAIM #",ABMP("CDFN")," HAS BEEN CANCELLED.",!
QUIT
+6 NEW I
+7 SET I=0
SET DA=0
+8 ;
+9 ; Loop through the insurer multiple, if the insurer is active and is
+10 ; the same as the active insurer, mark that insurer as complete.
+11 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I))
IF 'I
QUIT
Begin DoDot:1
+12 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),"^",3)="I"
IF $PIECE(^(0),"^",1)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",8)
SET DA=I
+13 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),"^",3)="I"
IF $PIECE(^(0),"^",11)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",8)
SET DA=I
End DoDot:1
+14 IF DA
Begin DoDot:1
+15 SET DA(1)=ABMP("CDFN")
+16 IF '$DATA(^ABMDCLM(DUZ(2),DA(1),13,DA))
QUIT
+17 SET DIE="^ABMDCLM("_DUZ(2)_","_DA(1)_",13,"
+18 SET DR=".03////C"
+19 DO ^DIE
+20 KILL DR
End DoDot:1
+21 ; Quit if claim is already in edit status
+22 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",4)="E"
Begin DoDot:1
+23 WRITE !,"Claim is already in edit status.",!
End DoDot:1
QUIT
+24 ;
UNBILL ;
+1 ; Look for additional sources that have not yet been billed
+2 WRITE !!,"CHECKING FOR UNBILLED SOURCES.",!
+3 SET (ABM("HIT"),ABM("CNT"))=0
+4 ; Eligibility checker. . .add any other insurers and prioritize
+5 DO ELG^ABMDLCK("",.ABML,ABMP("PDFN"),ABMP("VDT"))
+6 NEW I
+7 SET I=0
+8 ;
+9 ; Loop through insurers in order of priority and update the
+10 ; insurer multiple in 3P BILL w/ insurer and coverage data.
+11 FOR
SET I=$ORDER(ABML(I))
IF 'I
QUIT
Begin DoDot:1
+12 NEW J
+13 SET J=0
+14 FOR
SET J=$ORDER(ABML(I,J))
IF 'J
QUIT
Begin DoDot:2
+15 SET ABM("PRI")=I
+16 SET ABM("INS")=J
+17 DO ADDCHK^ABMDE2E
End DoDot:2
End DoDot:1
+18 ;
+19 ; Determine if source (insurer) is billable
+20 ; Loop through insurer multiple in priority order (C x-ref), if the
+21 ; claim status is Pending, active, flagged or partial and patient is
+22 ; non-indian and insurer is billable. . .display as a billable
+23 ; source.
+24 SET ABM=""
+25 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM))
IF 'ABM
QUIT
Begin DoDot:1
+26 SET ABM("X")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,0))
+27 IF '$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("X"),0))
KILL ^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,ABM("X"))
QUIT
+28 IF "PIFL"[$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("X"),0),U,3)
Begin DoDot:2
+29 SET ABM("INSCO")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("X"),0),"^",1)
+30 IF $PIECE($GET(^AUTNINS(ABM("INSCO"),2)),U)="I"
QUIT
+31 IF $PIECE($GET(^AUTNINS(ABM("INSCO"),1)),U,7)=4
QUIT
+32 IF ABM("CNT")
WRITE !
+33 SET ABM("CNT")=ABM("CNT")+1
+34 WRITE ?18,"[",ABM("CNT"),"] ",$PIECE(^AUTNINS(ABM("INSCO"),0),U)
+35 SET ABM(ABM("CNT"))=ABM("X")
End DoDot:2
End DoDot:1
+36 ;
+37 ; No other billable sources so mark claim as complete
+38 IF ABM("CNT")=0
Begin DoDot:1
+39 ; mark claim as complete
DO CCLM
+40 WRITE "NONE",!!,"Since there are no unbilled sources no further billing is possible."
End DoDot:1
KILL ABM,ABMP
QUIT
+41 SET ABM("HIT")=ABM(1)
+42 ; flag used for reopening a claim
SET Y=1
+43 ; If user access to below option, ask to reopen claim
+44 ; Note that if this key name gets changed this code needs changing
+45 IF $DATA(^XUSEC("ABMDZ EDIT CLAIM AND EXPORT",DUZ))
Begin DoDot:1
+46 WRITE !
+47 SET DIR(0)="Y"
+48 SET DIR("A")="Re-open claim for further billing? (Y/N)"
+49 DO ^DIR
+50 KILL DIR
+51 IF $DATA(DIRUT)
QUIT
End DoDot:1
+52 ; If answer is no, complete the claim
+53 IF Y'=1
DO CCLM
KILL ABM,ABMP
QUIT
+54 ; Else reopen the claim
+55 SET DIE="^ABMDBILL(DUZ(2),"
+56 SET DA=ABMP("BDFN")
+57 SET DR=".24////"_Y
+58 DO ^DIE
+59 ; Open claim for editing
DO OCLM
+60 SET DA(1)=ABMP("CDFN")
+61 SET DIE="^ABMDCLM("_DUZ(2)_","_DA(1)_",13,"
+62 SET DA=ABM("HIT")
+63 SET DR=".03////I"
+64 ; Make insurer status (multiple) active
DO ^DIE
+65 KILL ABM,ABMP
+66 QUIT
+67 ;
ADD ;
+1 ; Add bill not currently in 3P BILL
+2 ; MAYBE WILL DO LATER
+3 QUIT
+4 ;
OCLM ;
+1 ; Open claim for editing
+2 SET DA=ABMP("CDFN")
+3 SET DIE="^ABMDCLM("_DUZ(2)_","
+4 SET DR=".04////O;.08////"_$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("HIT"),0),U)
+5 DO ^DIE
+6 ;put remark if billed insurer is tribal self-insured and Medicare insurer is next
+7 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,11)="Y"&($PIECE($GET(^AUTNINS(ABM(1),2)),U)="R")
Begin DoDot:1
+8 KILL DIC,DIE,X,Y,DA
+9 SET DA(1)=ABMP("CDFN")
+10 SET DIC="^ABMDCLM("_DUZ(2)_","_DA(1)_",61,"
+11 SET DIC(0)="L"
+12 SET DIC("P")=$PIECE(^DD(9002274.3,61,0),U,2)
+13 SET X="PT HAS TRIBAL SELF-FUNDED INSURANCE"
+14 DO ^DIC
End DoDot:1
+15 WRITE !!,"Claim Number: ",+ABMP("BILL")," is now Open for Editing!",!
+16 QUIT
+17 ;
CCLM ;
+1 ; Complete a claim
+2 SET DA=ABMP("CDFN")
+3 SET DIE="^ABMDCLM("_DUZ(2)_","
+4 SET DR=".04////C"
+5 DO ^DIE
+6 QUIT
