Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDEOK

ABMDEOK.m

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