ABMDEOK ; IHS/ASDST/DMJ - Approve Claim for Billing ;
;;2.6;IHS 3P BILLING SYSTEM;**9,19**;NOV 12, 2009;Build 300
;
; IHS/ASDS/SDH - 03/12/01 - V2.4 Patch 9 - NOIS XJG-0500-160047
; Remove the post pre-payment on the fly functionality
; IHS/ASDS/SDH - 09/26/01 - V2.4 Patch 9 - NOIS NDA-1199-180065
; Modified to add prompts for Unbillable secondary stuff
;
; IHS/SD/SDR - v2.5 p9 - IM19585 - Added code to check status of active insurer; change to
; initiated if complete
;
;IHS/SD/SDR - 2.6*19 - HEAT193348 - Made change to stop duplicate bill from creating in A/R. If the 3P Bill entry
; thought it was incomplete for some reason, it would delete the 3P Bill without checking for the A/R Bill. The
; A/R Bill would have created when the 3P Claim was approved. Updated the statuses of the 3P Bill check to include
; approved.
;
; *********************************************************************
;
ERR ;
I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,5) D G XIT
. W !!,*7," =========================================================================== "
. W !," Fatal ERRORS Exist a Bill can not be Generated until they are Resolved! "
. W !," =========================================================================== ",!
. D HLP^ABMDERR
;
UNBIL ;
I $P($G(^AUTNINS($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8),1)),U,7)=4 D G XIT
. W !!,*7," =========================================================================== "
. W !," Primary Insurer is Designated as UNBILLABLE and thus can not be billed! "
. W !," =========================================================================== ",!
. D HLP^ABMDERR
;
D ^ABMDESM
K ABMLOC
;start new code abm*2.6*9 NOHEAT - ensure UFMS is setup
I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)="" D Q
.W !!,"* * UFMS SETUP MUST BE DONE BEFORE ANY BILLING FUNCTIONS CAN BE USED! * *",!
.S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
;end new code
I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=1 D Q:+$G(ABMUOPNS)=0
.S ABMUOPNS=$$FINDOPEN^ABMUCUTL(DUZ)
.I +$G(ABMUOPNS)=0 D Q
..W !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM BILLING FUNCTIONS! * *",!
..S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
Q:($G(ABMSFLG)=1)
I $G(ABMP("TOT"))'>0 D
. S ABMP("TOT")=ABMP("TOT")+$G(ABMP("WO"))+$G(ABMP("CO"))
;
BGEN ;
W !
S DIR(0)="Y"
S DIR("A")="Do You Wish to APPROVE this Claim for Billing"
S DIR("?")="If Claim is accurate and Transfer to Accounts Receivable File is Desired"
D ^DIR
K DIR
G:$D(DIRUT)!$D(DIROUT)!(Y'=1) XIT
I Y=1,+$G(ABM("W"))'=0 D ADJMNT
;
BIL ;
S DA=0
S DIK="^ABMDBILL(DUZ(2),"
F S DA=$O(^ABMDTMP(ABMP("CDFN"),DA)) Q:'DA D K ^ABMDTMP(ABMP("CDFN"),DA)
.Q:'$D(^ABMDBILL(DUZ(2),DA,0))
.Q:+$P(^ABMDBILL(DUZ(2),DA,0),U)'=ABMP("CDFN")
.;Q:"BTPC"[$P(^ABMDBILL(DUZ(2),DA,0),U,4) ;abm*2.6*19 IHS/SD/SDR HEAT193348
.Q:"ABTPC"[$P(^ABMDBILL(DUZ(2),DA,0),U,4) ;approved, billed, transferred, partial payment, or complete - skip ;abm*2.6*19 IHS/SD/SDR HEAT193348
.W !!,*7,"Bill Number ",$P(^ABMDBILL(DUZ(2),DA,0),U)
.W " was previously created from this claim"
.W !,"but was not completed. It is now being removed!..."
.D ^DIK
W !!,"Transferring Data...."
;if active insurer and status is complete, make it initiated
S I=0
F S I=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I)) Q:'I D
.I ($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0)),U)=ABMP("INS")!($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0)),U,11)=ABMP("INS"))),"CB"[($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0)),U,3)) D
..S DA(1)=ABMP("CDFN")
..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
..S DA=I
..S DR=".03////I"
..D ^DIE
..K DR
D ^ABMDEBIL
I '$D(ABMP("BDFN")) D G XIT
. K DIR
. S DIR(0)="EO"
. D ^DIR
;
S ABMP("OVER")=""
S DIE="^ABMDCLM(DUZ(2),"
S DA=ABMP("CDFN")
S DR=".04////U"
D ^DIE
K DR
N I
S I=0
F S I=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I)) Q:'I D
.Q:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),"^",3)'="I"
.S DA(1)=DA
.S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
.S DA=I
.S DR=".03////B"
.D ^DIE
.K DR
K ^ABMDTMP(ABMP("CDFN"))
I $E($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U),$L($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)))="A" D
. I $O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,0)) D
.. S DA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,0))
.. I $D(^AUPNVSIT(DA,0)) D
... S DIE="^AUPNVSIT("
... S DR="1101////"_ABMP("TOT")
... D ^ABMDDIE
;
XIT ;
Q
;
; *********************************************************************
EOP ;
W $$EN^ABMVDF("IOF")
Q
;
; *********************************************************************
ADJMNT ;
Q:$G(ABMSPLFG)=1 ;flag that transactions are split (see ^ABMPPFLR)
S EXP=""
S ABMCNT=0
F S EXP=$O(ABMP("EXP",EXP)) Q:EXP="" S ABMCNT=ABMCNT+1
Q:ABMCNT>1
F D Q:ABMFLAG=1
.S ABMFLAG=0
.W !!,"CURRENT ADJUSTMENTS:"
.I $G(ABMP("WO")) D
..W !," Write-off: ",$G(ABMP("WO"))
.I $G(ABMP("DED")) D
..W " Deductible: ",$G(ABMP("DED"))
.I $G(ABMP("NONC")) D
..W !," Non-covered: ",$G(ABMP("NONC"))
.I $G(ABMP("COI")) D
..W " Co-insurance: ",$G(ABMP("COI"))
.I $G(ABMP("GRP")) D
..W !,"Grouper allowance: ",$G(ABMP("GRP"))
.I $G(ABMP("PENS")) D
..W !," Penalties: ",$G(ABMP("PENS"))
.I $G(ABMP("REF")) D
..W !," Refund: ",$G(ABMP("REF"))
.S DIR(0)="Y"
.S DIR("A")="Include any adjustments in billed amount?"
.S DIR("B")="Y"
.K Y
.D ^DIR K DIR
.I $D(DTOUT)!$D(DIROUT)!$D(DIRUT)!$D(DUOUT) S ABMFLAG=1 Q
.I Y'=1 S ABMFLAG=1 Q
.I Y=1 D
..S DIR(0)="N^::2"
..S DIR("A")="Write-off Amount to bill"
..S DIR("B")=$G(ABMP("WO"))
..K Y
..D ^DIR K DIR
..I $D(DTOUT)!$D(DIROUT)!$D(DIRUT)!$D(DUOUT) S ABMFLAG=1 Q
..S ADJ=Y
..I ADJ>0 D
...S BILL=$G(ABMP("EXP",ABMP("EXP")))
...W !!,"Ok, I will add $",ADJ," to $",BILL," for a total billed amount of $",ADJ+BILL
...S DIR(0)="Y"
...S DIR("A")="OK?"
...S DIR("B")="Y"
...K Y
...D ^DIR K DIR
...I $D(DTOUT)!$D(DIROUT)!$D(DIRUT)!$D(DUOUT) S ABMFLAG=1 Q
...I Y=1 S ABMP("EXP",ABMP("EXP"))=$G(ABMP("EXP",ABMP("EXP")))+ADJ,ABMFLAG=1,ABMP("WO")=ABMP("WO")-ADJ
Q
ABMDEOK ; IHS/ASDST/DMJ - Approve Claim for Billing ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**9,19**;NOV 12, 2009;Build 300
+2 ;
+3 ; IHS/ASDS/SDH - 03/12/01 - V2.4 Patch 9 - NOIS XJG-0500-160047
+4 ; Remove the post pre-payment on the fly functionality
+5 ; IHS/ASDS/SDH - 09/26/01 - V2.4 Patch 9 - NOIS NDA-1199-180065
+6 ; Modified to add prompts for Unbillable secondary stuff
+7 ;
+8 ; IHS/SD/SDR - v2.5 p9 - IM19585 - Added code to check status of active insurer; change to
+9 ; initiated if complete
+10 ;
+11 ;IHS/SD/SDR - 2.6*19 - HEAT193348 - Made change to stop duplicate bill from creating in A/R. If the 3P Bill entry
+12 ; thought it was incomplete for some reason, it would delete the 3P Bill without checking for the A/R Bill. The
+13 ; A/R Bill would have created when the 3P Claim was approved. Updated the statuses of the 3P Bill check to include
+14 ; approved.
+15 ;
+16 ; *********************************************************************
+17 ;
ERR ;
+1 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,5)
Begin DoDot:1
+2 WRITE !!,*7," =========================================================================== "
+3 WRITE !," Fatal ERRORS Exist a Bill can not be Generated until they are Resolved! "
+4 WRITE !," =========================================================================== ",!
+5 DO HLP^ABMDERR
End DoDot:1
GOTO XIT
+6 ;
UNBIL ;
+1 IF $PIECE($GET(^AUTNINS($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8),1)),U,7)=4
Begin DoDot:1
+2 WRITE !!,*7," =========================================================================== "
+3 WRITE !," Primary Insurer is Designated as UNBILLABLE and thus can not be billed! "
+4 WRITE !," =========================================================================== ",!
+5 DO HLP^ABMDERR
End DoDot:1
GOTO XIT
+6 ;
+7 DO ^ABMDESM
+8 KILL ABMLOC
+9 ;start new code abm*2.6*9 NOHEAT - ensure UFMS is setup
+10 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=""
Begin DoDot:1
+11 WRITE !!,"* * UFMS SETUP MUST BE DONE BEFORE ANY BILLING FUNCTIONS CAN BE USED! * *",!
+12 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+13 ;end new code
+14 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=1
Begin DoDot:1
+15 SET ABMUOPNS=$$FINDOPEN^ABMUCUTL(DUZ)
+16 IF +$GET(ABMUOPNS)=0
Begin DoDot:2
+17 WRITE !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM BILLING FUNCTIONS! * *",!
+18 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:2
QUIT
End DoDot:1
IF +$GET(ABMUOPNS)=0
QUIT
+19 IF ($GET(ABMSFLG)=1)
QUIT
+20 IF $GET(ABMP("TOT"))'>0
Begin DoDot:1
+21 SET ABMP("TOT")=ABMP("TOT")+$GET(ABMP("WO"))+$GET(ABMP("CO"))
End DoDot:1
+22 ;
BGEN ;
+1 WRITE !
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Do You Wish to APPROVE this Claim for Billing"
+4 SET DIR("?")="If Claim is accurate and Transfer to Accounts Receivable File is Desired"
+5 DO ^DIR
+6 KILL DIR
+7 IF $DATA(DIRUT)!$DATA(DIROUT)!(Y'=1)
GOTO XIT
+8 IF Y=1
IF +$GET(ABM("W"))'=0
DO ADJMNT
+9 ;
BIL ;
+1 SET DA=0
+2 SET DIK="^ABMDBILL(DUZ(2),"
+3 FOR
SET DA=$ORDER(^ABMDTMP(ABMP("CDFN"),DA))
IF 'DA
QUIT
Begin DoDot:1
+4 IF '$DATA(^ABMDBILL(DUZ(2),DA,0))
QUIT
+5 IF +$PIECE(^ABMDBILL(DUZ(2),DA,0),U)'=ABMP("CDFN")
QUIT
+6 ;Q:"BTPC"[$P(^ABMDBILL(DUZ(2),DA,0),U,4) ;abm*2.6*19 IHS/SD/SDR HEAT193348
+7 ;approved, billed, transferred, partial payment, or complete - skip ;abm*2.6*19 IHS/SD/SDR HEAT193348
IF "ABTPC"[$PIECE(^ABMDBILL(DUZ(2),DA,0),U,4)
QUIT
+8 WRITE !!,*7,"Bill Number ",$PIECE(^ABMDBILL(DUZ(2),DA,0),U)
+9 WRITE " was previously created from this claim"
+10 WRITE !,"but was not completed. It is now being removed!..."
+11 DO ^DIK
End DoDot:1
KILL ^ABMDTMP(ABMP("CDFN"),DA)
+12 WRITE !!,"Transferring Data...."
+13 ;if active insurer and status is complete, make it initiated
+14 SET I=0
+15 FOR
SET I=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I))
IF 'I
QUIT
Begin DoDot:1
+16 IF ($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0)),U)=ABMP("INS")!($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0)),U,11)=ABMP("INS")))
IF "CB"[($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0)),U,3))
Begin DoDot:2
+17 SET DA(1)=ABMP("CDFN")
+18 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
+19 SET DA=I
+20 SET DR=".03////I"
+21 DO ^DIE
+22 KILL DR
End DoDot:2
End DoDot:1
+23 DO ^ABMDEBIL
+24 IF '$DATA(ABMP("BDFN"))
Begin DoDot:1
+25 KILL DIR
+26 SET DIR(0)="EO"
+27 DO ^DIR
End DoDot:1
GOTO XIT
+28 ;
+29 SET ABMP("OVER")=""
+30 SET DIE="^ABMDCLM(DUZ(2),"
+31 SET DA=ABMP("CDFN")
+32 SET DR=".04////U"
+33 DO ^DIE
+34 KILL DR
+35 NEW I
+36 SET I=0
+37 FOR
SET I=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I))
IF 'I
QUIT
Begin DoDot:1
+38 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),"^",3)'="I"
QUIT
+39 SET DA(1)=DA
+40 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
+41 SET DA=I
+42 SET DR=".03////B"
+43 DO ^DIE
+44 KILL DR
End DoDot:1
+45 KILL ^ABMDTMP(ABMP("CDFN"))
+46 IF $EXTRACT($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U),$LENGTH($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)))="A"
Begin DoDot:1
+47 IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,0))
Begin DoDot:2
+48 SET DA=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,0))
+49 IF $DATA(^AUPNVSIT(DA,0))
Begin DoDot:3
+50 SET DIE="^AUPNVSIT("
+51 SET DR="1101////"_ABMP("TOT")
+52 DO ^ABMDDIE
End DoDot:3
End DoDot:2
End DoDot:1
+53 ;
XIT ;
+1 QUIT
+2 ;
+3 ; *********************************************************************
EOP ;
+1 WRITE $$EN^ABMVDF("IOF")
+2 QUIT
+3 ;
+4 ; *********************************************************************
ADJMNT ;
+1 ;flag that transactions are split (see ^ABMPPFLR)
IF $GET(ABMSPLFG)=1
QUIT
+2 SET EXP=""
+3 SET ABMCNT=0
+4 FOR
SET EXP=$ORDER(ABMP("EXP",EXP))
IF EXP=""
QUIT
SET ABMCNT=ABMCNT+1
+5 IF ABMCNT>1
QUIT
+6 FOR
Begin DoDot:1
+7 SET ABMFLAG=0
+8 WRITE !!,"CURRENT ADJUSTMENTS:"
+9 IF $GET(ABMP("WO"))
Begin DoDot:2
+10 WRITE !," Write-off: ",$GET(ABMP("WO"))
End DoDot:2
+11 IF $GET(ABMP("DED"))
Begin DoDot:2
+12 WRITE " Deductible: ",$GET(ABMP("DED"))
End DoDot:2
+13 IF $GET(ABMP("NONC"))
Begin DoDot:2
+14 WRITE !," Non-covered: ",$GET(ABMP("NONC"))
End DoDot:2
+15 IF $GET(ABMP("COI"))
Begin DoDot:2
+16 WRITE " Co-insurance: ",$GET(ABMP("COI"))
End DoDot:2
+17 IF $GET(ABMP("GRP"))
Begin DoDot:2
+18 WRITE !,"Grouper allowance: ",$GET(ABMP("GRP"))
End DoDot:2
+19 IF $GET(ABMP("PENS"))
Begin DoDot:2
+20 WRITE !," Penalties: ",$GET(ABMP("PENS"))
End DoDot:2
+21 IF $GET(ABMP("REF"))
Begin DoDot:2
+22 WRITE !," Refund: ",$GET(ABMP("REF"))
End DoDot:2
+23 SET DIR(0)="Y"
+24 SET DIR("A")="Include any adjustments in billed amount?"
+25 SET DIR("B")="Y"
+26 KILL Y
+27 DO ^DIR
KILL DIR
+28 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)!$DATA(DUOUT)
SET ABMFLAG=1
QUIT
+29 IF Y'=1
SET ABMFLAG=1
QUIT
+30 IF Y=1
Begin DoDot:2
+31 SET DIR(0)="N^::2"
+32 SET DIR("A")="Write-off Amount to bill"
+33 SET DIR("B")=$GET(ABMP("WO"))
+34 KILL Y
+35 DO ^DIR
KILL DIR
+36 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)!$DATA(DUOUT)
SET ABMFLAG=1
QUIT
+37 SET ADJ=Y
+38 IF ADJ>0
Begin DoDot:3
+39 SET BILL=$GET(ABMP("EXP",ABMP("EXP")))
+40 WRITE !!,"Ok, I will add $",ADJ," to $",BILL," for a total billed amount of $",ADJ+BILL
+41 SET DIR(0)="Y"
+42 SET DIR("A")="OK?"
+43 SET DIR("B")="Y"
+44 KILL Y
+45 DO ^DIR
KILL DIR
+46 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)!$DATA(DUOUT)
SET ABMFLAG=1
QUIT
+47 IF Y=1
SET ABMP("EXP",ABMP("EXP"))=$GET(ABMP("EXP",ABMP("EXP")))+ADJ
SET ABMFLAG=1
SET ABMP("WO")=ABMP("WO")-ADJ
End DoDot:3
End DoDot:2
End DoDot:1
IF ABMFLAG=1
QUIT
+48 QUIT
