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

ABMCUFE.m

Go to the documentation of this file. 
  1. ABMCUFE ; IHS/SD/SDR - 3P BILLING 2.6 P27 CUFE Option to cleanup fee tables ;  
  1.  ;;2.6;IHS Third Party Billing;**27**;NOV 12, 2009;Build 486
  1.  ;
  1.  S ABMFTOK=0
  1.  D FTCHK  ;if all fee tables are complete or skipped exit option
  1.  I ABMFTOK=0 D  Q
  1.  .W !!,"All fee tables are COMPLETE or SKIPPED (OLD) so no further action is necessary"
  1.  ;
  1.  W !!,"This menu option will have you select a fee table from a list of tables owned"
  1.  W !,"by the facility logged into.  It will go through every CPT entry in the selected"
  1.  W !,"fee table and will:"
  1.  W !?2,"- delete incomplete entries (where there is no effective date and no amount)"
  1.  W !?2,"- File the entries back so there is only one entry for each CPT code in",!?4,"each fee table"
  1.  W !!,"There *could* be instances where user intervention is needed to determine which"
  1.  W !,"charge amount should be used when two entries are present for the same CPT with"
  1.  W !,"the same effective date but different amounts.  The user will be prompted with"
  1.  W !,"all the information and be asked to select which entry is correct before"
  1.  W !,"continuing."
  1.  D PAZ^ABMDRUTL
  1. START ;EP
  1.  D FTSEL  ;list fee tables and select one
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT)
  1.  L +^ABMFTWC(ABMFT):3 I '$T W *7,!!,"Fee schedule is being updated by another user..." D PAZ^ABMDRUTL G START
  1.  F  D  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT)
  1.  .D MLTSEL  ;display categories that need fixing and have them select one
  1.  .Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT)
  1.  .D EDIT  ;this will go through the entries one at a time and have the user select the correct date/fee
  1.  L -(^ABMFTWC(ABMFT))
  1.  D FIXCHK  ;are there any other entries that need review; if not, mark fee table as complete
  1.  D FTCHK  ;check at end to see if all fee tables are complete
  1.  Q
  1.  ;
  1. FTCHK ;EP
  1.  D BMES^XPDUTL("Checking fee table status...")
  1.  S ABMFT=0
  1.  S ABMFTOK=0
  1.  F  S ABMFT=$O(^ABMDFEE(ABMFT)) Q:'ABMFT  D
  1.  .I $P($G(^ABMDFEE(ABMFT,0)),U,6)="" S ABMFTOK=1
  1.  I ABMFTOK=1 D MES^XPDUTL("There are fee tables that need review") Q  ;there's at least one to review
  1.  D MES^XPDUTL("All fee tables complete.")
  1.  D ^XBFMK
  1.  S DA=$O(^DIC(19,"B","ABMD TM CLEANUP FEE TABLE",0))
  1.  S DR="2////All fee tables reviewed - no action needed"
  1.  S DIE="^DIC(19,"
  1.  D ^DIE
  1.  D ^XBFMK
  1.  F ABMA="ABMD TM FEE MAINT","ABMD TM FEE DRUG","ABMD TM FEE FOREIGN","ABMD TM FEE PERCENT" D
  1.  .S DA=$O(^DIC(19,"B",ABMA,0))
  1.  .S DIE="^DIC(19,"
  1.  .S DR="2////@"
  1.  .D ^DIE
  1.  K ^ABMFTMP("ABM-FT")  ;back up of fee table not needed anymore; was creating at install of abm*2.6*27
  1.  Q
  1.  ;
  1. FIXCHK ;EP
  1.  I $D(^ABMFTWC(ABMFT)) Q  ;there's still data to be reviewed
  1.  D ^XBFMK
  1.  S DIE="^ABMDFEE("
  1.  S DA=ABMFT
  1.  S DR=".06////C"
  1.  D ^DIE
  1.  Q
  1.  ;
  1. FTSEL ;EP
  1.  W $$EN^ABMVDF("IOF")
  1.  D ^XBFMK
  1.  W !?1,"FT",?5,"Owner",?20,"Title",?67,"Status"
  1.  S ABMFT=0
  1.  S ABMLST=""
  1.  F  S ABMFT=$O(^ABMDFEE(ABMFT)) Q:'ABMFT  D
  1.  .W !,ABMFT
  1.  .S ABM("REC")=$G(^ABMDFEE(ABMFT,0))
  1.  .S ABMOWN=$S(+$P(ABM("REC"),U,4)'=0:$P($G(^AUTTLOC(+$P(ABM("REC"),U,4),0)),U,2),1:"<NO OWNER>")
  1.  .S ABMTITLE=$S(($P(ABM("REC"),U,2)'=""):$P(ABM("REC"),U,2),1:"<NO TITLE>")
  1.  .S ABMST=$P(ABM("REC"),U,6)
  1.  .S ABMST=$S(ABMST="C":"Complete",ABMST="S":"Skipped (Old)",1:"REVIEW")
  1.  .W ?5,ABMOWN,?20,ABMTITLE,?67,ABMST
  1.  .S ABMTITLE=$TR(ABMTITLE,":;")
  1.  .S ABMLST=$S(($G(ABMLST)=""):ABMFT_":"_ABMTITLE_" ("_ABMST_")",1:ABMLST_";"_ABMFT_":"_ABMTITLE_" ("_ABMST_")")
  1.  S DIR("A",1)="  "
  1.  S DIR(0)="SAO^"_ABMLST
  1.  S DIR("A")="Which fee table would you like to review? "
  1.  D ^DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT)
  1.  S ABMFT=+Y
  1.  I $P($G(^ABMDFEE(ABMFT,0)),U,6)="C" W !!!!,"This fee schedule is already complete.  Please select another." D PAZ^ABMDRUTL G FTSEL
  1.  I ($P($G(^ABMDFEE(ABMFT,0)),U,4)'=DUZ(2)) W !!!!,"This fee schedule is owned by another facility.  Please select another." D PAZ^ABMDRUTL G FTSEL
  1.  S ABMF("FTEDT")=$P($G(^ABMDFEE(ABMFT,0)),U,5)  ;fee table effective date
  1.  Q
  1. MLTSEL ;EP
  1.  I '$D(^ABMFTWC(ABMFT)) S DUOUT="" Q  ;no data in working global for fee table; this happens when it loops back after reviewing the last section
  1.  W $$EN^ABMVDF("IOF")
  1.  W !!,"Fee Table "_ABMFT_": "_$P($G(^ABMDFEE(ABMFT,0)),U,2)_":",!
  1.  D ^XBFMK
  1.  S ABMLST=""
  1.  S ABMMLT=0
  1.  F  S ABMMLT=$O(^ABMFTWC(ABMFT,"FIX",ABMMLT)) Q:'ABMMLT  D
  1.  .I ($G(^ABMFTWC(ABMFT,"FIX",ABMMLT))<1) K ^ABMFTWC(ABMFT,"FIX",ABMMLT) Q  ;if there ends up an erroneous entry, kill it and quit
  1.  .W !,"("_ABMMLT_") "
  1.  .S ABMMLTN=$S(ABMMLT=11:"Surgical",ABMMLT=13:"HCPCS",ABMMLT=15:"Radiology",ABMMLT=17:"Laboratory",ABMMLT=19:"Medical",ABMMLT=23:"Anesthesia",1:"")
  1.  .W ABMMLTN
  1.  .W ?17,$$FMT^ABMERUTL($G(^ABMFTWC(ABMFT,"FIX",ABMMLT)),"5R")_" "_$S($G(^ABMFTWC(ABMFT,"FIX",ABMMLT))=1:"entry",1:"entries")
  1.  .S ABMLST=$S(($G(ABMLST)=""):ABMMLT_":"_ABMMLTN,1:ABMLST_";"_ABMMLT_":"_ABMMLTN)
  1.  S DIR("A",1)="  "
  1.  S DIR(0)="SAO^"_ABMLST
  1.  S DIR("A")="Which category within Fee Table #"_ABMFT_" would you like to review/correct? "
  1.  D ^DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT)
  1.  S ABMMLT=Y
  1.  .S ABMMLTN=$S(ABMMLT=11:"Surgical",ABMMLT=13:"HCPCS",ABMMLT=15:"Radiology",ABMMLT=17:"Laboratory",ABMMLT=19:"Medical",ABMMLT=23:"Anesthesia",1:"")
  1.  Q
  1. EDIT ;EP
  1.  S ABMENTRY=0
  1.  K ABM
  1.  S ABM("DCPT")=0
  1.  S ABM("MLTTOT")=+$G(^ABMFTWC(ABMFT,"FIX",ABMMLT))
  1.  F  S ABM("DCPT")=$O(^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"))) Q:'ABM("DCPT")  D  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT)
  1.  .S ABMENTRY=+$G(ABMENTRY)+1
  1.  .S ABMHDR="Fee Table "_ABMFT_", "_ABMMLT_" "_ABMMLTN_" - entry "_ABMENTRY_" of "_ABM("MLTTOT")
  1.  .S ABMHDR1="#  CPT   (IEN)          Effective Date        Charge Amount"
  1.  .W !!,ABMHDR,!!,ABMHDR1
  1.  .S ABM("CPTCNT")=0
  1.  .S ABM("CNTSV")=0
  1.  .F  S ABM("CPTCNT")=$O(^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"),ABM("CPTCNT"))) Q:'ABM("CPTCNT")  D
  1.  ..S ABM("CNTSV")=+$G(ABM("CNTSV"))+1
  1.  ..S ABM("IEN")=$P($G(^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"),ABM("CPTCNT"),0)),U)
  1.  ..W !,ABM("CPTCNT"),?3,ABM("DCPT")_" ("_ABM("IEN")_")"
  1.  ..;
  1.  ..D WRTLINES
  1.  .D ^XBFMK
  1.  .S DIR(0)="NO^1:"_ABM("CNTSV")
  1.  .S DIR("A",1)=""
  1.  .S DIR("A")="Which entry is correct? "
  1.  .D ^DIR
  1.  .Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT)
  1.  .S ABM("CPTCNT")=+Y
  1.  .;
  1.  .W !!,"For CPT "_ABM("DCPT")_" you selected ...",!
  1.  .D WRTLINES
  1.  .D ^XBFMK
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="Are you sure"
  1.  .S DIR("B")="NO"
  1.  .D ^DIR K DIR
  1.  .Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT)
  1.  .Q:Y'=1
  1.  .;
  1.  .W !!,"Ok, filing CPT "_ABM("DCPT")
  1.  .D REMOVE  ;remove all other entries from ^ABMFTWC except the selected one
  1.  .D MERGE  ;merge the one entry into the fee table and remove from ^ABMFTWC; also updates FIX counter
  1.  Q
  1. WRTLINES ;EP
  1.  S ABM("WCIEN")=0
  1.  F  S ABM("WCIEN")=$O(^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"),ABM("CPTCNT"),1,ABM("WCIEN"))) Q:'ABM("WCIEN")  D
  1.  .W ?23,$$SDT^ABMDUTL($P($G(^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"),ABM("CPTCNT"),1,ABM("WCIEN"),0)),U))
  1.  .W ?45,"$"_$J($FN($P($G(^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"),ABM("CPTCNT"),1,ABM("WCIEN"),0)),U,2),",",2),10),!
  1.  Q
  1. REMOVE ;EP
  1.  S ABMT=0
  1.  F  S ABMT=$O(^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"),ABMT)) Q:'ABMT  D
  1.  .I ABM("CPTCNT")=ABMT Q  ;this is the entry we want
  1.  .K ^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"),ABMT)
  1.  Q
  1. MERGE ;EP
  1.  S ^ABMFTWC(ABMFT,"FIX",ABMMLT)=+$G(^ABMFTWC(ABMFT,"FIX",ABMMLT))-1  ;decrease counter
  1.  S ABMF("IEN")=ABM("CPTCNT")
  1.  S $P(^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"),ABM("CPTCNT"),0),U)=+$$ACTIVCPT^ABMP2627(ABM("DCPT"))
  1.  ;
  1.  M ^ABMDFEE(ABMFT,ABMMLT,ABM("DCPT"),0)=^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"),ABM("CPTCNT"),0)
  1.  S ABMMDT=0
  1.  F  S ABMMDT=$O(^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"),ABM("CPTCNT"),ABMMDT)) Q:'ABMMDT  D
  1.  .M ^ABMDFEE(ABMFT,ABMMLT,ABM("DCPT"),ABMMDT)=^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"),ABM("CPTCNT"),ABMMDT)
  1.  ;
  1.  K ^ABMFTWC(ABMFT,ABMMLT,ABM("DCPT"))
  1.  K ^ABMFTWC(ABMFT,"FIX",ABMMLT,ABM("DCPT"))
  1.  I $G(^ABMFTWC(ABMFT,"FIX",ABMMLT))=0 K ^ABMFTWC(ABMFT,"FIX",ABMMLT)
  1.  ;
  1.  ;re-index 3P Fee Table CPT entry
  1.  D ^XBFMK
  1.  S DA(1)=ABMFT
  1.  S DIK="^ABMDFEE("_DA(1)_","_ABMMLT_","
  1.  S DA=ABM("DCPT")
  1.  D IX^DIK
  1.  ;
  1.  ;populate date and who picked entry
  1.  D ^XBFMK
  1.  S DA(1)=ABMFT
  1.  S DA=ABM("DCPT")
  1.  S DIE="^ABMDFEE("_DA(1)_","_ABMMLT_","
  1.  S DR=".05///NOW;.06////"_DUZ
  1.  D ^DIE
  1.  Q