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