ABMFECNV ; IHS/SD/SDR - 3P Fee Table Conversion
;;2.6;IHS THIRD PARTY BILLING SYSTEM;**2**;NOV 12, 2009
;
Q
CONVERT ;
S X=$$PATCH^XPDUTL("ABM*2.6*2")
I $P(X,U)=1 Q ;patch 2 already installed
;11=SURGICAL
;13=HCPCS
;15=RADIOLOGY
;17=LABORATORY
;19=MEDICAL
;23=ANESTHESIA
S ABMTBL=0
F S ABMTBL=$O(^ABMDFEE(ABMTBL)) Q:(+$G(ABMTBL)=0) D
.D BMES^XPDUTL("Fee Schedule "_ABMTBL_" ...")
.D MES^XPDUTL(" Schd Cat Code EffDt Fee")
.S ABMEFFDT=$P($G(^ABMDFEE(ABMTBL,0)),U,5)
.F ABMM=11,13,15,17,19,23 D
..S ABMMI=0
..F S ABMMI=$O(^ABMDFEE(ABMTBL,ABMM,ABMMI)) Q:(+$G(ABMMI)=0) D
...S ABMCODE=$P($G(^ABMDFEE(ABMTBL,ABMM,ABMMI,0)),U)
...S ABMCHRG=$P($G(^ABMDFEE(ABMTBL,ABMM,ABMMI,0)),U,2)
...D ^XBFMK
...S DA(2)=ABMTBL
...S DA(1)=ABMCODE
...S DIC="^ABMDFEE("_DA(2)_","_ABMM_","_DA(1)_",1,"
...S DIC(0)="L"
...S DIC("P")=$P(^DD(9002274.01_ABMM,1,0),U,2)
...S X=ABMEFFDT
...S DIC("DR")=".02////"_ABMCHRG
...D ^DIC
...D MES^XPDUTL(" "_ABMTBL_" "_ABMM_" "_$S($G(^ICPT(ABMCODE,0))'="":$P($G(^ICPT(ABMCODE,0)),U),1:ABMCODE)_" "_$$SDT^ABMDUTL(ABMEFFDT)_" "_$J($FN(ABMCHRG,",",2),"10R"))
.;21=DENTAL
.S ABMMI=0
.F S ABMMI=$O(^ABMDFEE(ABMTBL,21,ABMMI)) Q:(+$G(ABMMI)=0) D
..S ABMCODE=$P($G(^AUTTADA($P($G(^ABMDFEE(ABMTBL,21,ABMMI,0)),U),0)),U)
..S ABMCHRG=+$P($G(^ABMDFEE(ABMTBL,21,ABMMI,0)),U,2)
..D ^XBFMK
..S DA(2)=ABMTBL
..S DA(1)=ABMMI
..S DIC="^ABMDFEE("_DA(2)_",21,"_DA(1)_",1,"
..S DIC(0)="L"
..S DIC("P")=$P(^DD(9002274.0121,1,0),U,2)
..S X=ABMEFFDT
..S DIC("DR")=".02////"_ABMCHRG
..D ^DIC
..D MES^XPDUTL(" "_ABMTBL_" 21 "_ABMCODE_" "_$$SDT^ABMDUTL(ABMEFFDT)_" "_$J($FN(ABMCHRG,",",2),"10R"))
.;25=DRUG
.S ABMMI=0
.F S ABMMI=$O(^ABMDFEE(ABMTBL,25,ABMMI)) Q:(+$G(ABMMI)=0) D
..S ABMCODE=$P($G(^PSDRUG($P($G(^ABMDFEE(ABMTBL,25,ABMMI,0)),U),0)),U)
..S ABMCHRG=+$P($G(^ABMDFEE(ABMTBL,25,ABMMI,0)),U,2)
..D ^XBFMK
..S DA(2)=ABMTBL
..S DA(1)=ABMMI
..S DIC="^ABMDFEE("_DA(2)_",25,"_DA(1)_",1,"
..S DIC(0)="L"
..S DIC("P")=$P(^DD(9002274.0125,1,0),U,2)
..S X=ABMEFFDT
..S DIC("DR")=".02////"_ABMCHRG
..D ^DIC
..D MES^XPDUTL(" "_ABMTBL_" 25 "_$$FMT^ABMERUTL(ABMCODE,"30L")_" "_$$SDT^ABMDUTL(ABMEFFDT)_" "_$J($FN(ABMCHRG,",",2),"10R"))
.;31=REVENUE CODES
.S ABMMI=0
.F S ABMMI=$O(^ABMDFEE(ABMTBL,31,ABMMI)) Q:(+$G(ABMMI)=0) D
..S ABMCODE=$P($G(^AUTTREVN($P($G(^ABMDFEE(ABMTBL,31,ABMMI,0)),U),0)),U)
..S ABMCHRG=+$P($G(^ABMDFEE(ABMTBL,31,ABMMI,0)),U,2)
..D ^XBFMK
..S DA(2)=ABMTBL
..S DA(1)=ABMMI
..S DIC="^ABMDFEE("_DA(2)_",31,"_DA(1)_",1,"
..S DIC(0)="L"
..S DIC("P")=$P(^DD(9002274.0131,1,0),U,2)
..S X=ABMEFFDT
..S DIC("DR")=".02////"_ABMCHRG
..D ^DIC
..D MES^XPDUTL(" "_ABMTBL_" 31 "_ABMCODE_"-"_$$FMT^ABMERUTL($P($G(^AUTTREVN($P($G(^ABMDFEE(ABMTBL,31,ABMMI,0)),U),0)),U,2),"25L")_" "_$$SDT^ABMDUTL(ABMEFFDT)_" "_$J($FN(ABMCHRG,",",2),"10R"))
.;32=CHARGE MASTER
.S ABMMI=0
.F S ABMMI=$O(^ABMDFEE(ABMTBL,32,ABMMI)) Q:(+$G(ABMMI)=0) D
..S ABMCODE=$P($G(^ABMCM($P($G(^ABMDFEE(ABMTBL,32,ABMMI,0)),U),0)),U)
..S ABMCHRG=+$P($G(^ABMDFEE(ABMTBL,32,ABMMI,0)),U,2)
..D ^XBFMK
..S DA(2)=ABMTBL
..S DA(1)=ABMMI
..S DIC="^ABMDFEE("_DA(2)_",32,"_DA(1)_",1,"
..S DIC(0)="L"
..S DIC("P")=$P(^DD(9002274.0132,1,0),U,2)
..S X=ABMEFFDT
..S DIC("DR")=".02////"_ABMCHRG
..D ^DIC
..D MES^XPDUTL(" "_ABMTBL_" 32 "_ABMCODE_" "_$$SDT^ABMDUTL(ABMEFFDT)_" "_$J($FN(ABMCHRG,",",2),"10R"))
Q
ABMFECNV ; IHS/SD/SDR - 3P Fee Table Conversion
+1 ;;2.6;IHS THIRD PARTY BILLING SYSTEM;**2**;NOV 12, 2009
+2 ;
+3 QUIT
CONVERT ;
+1 SET X=$$PATCH^XPDUTL("ABM*2.6*2")
+2 ;patch 2 already installed
IF $PIECE(X,U)=1
QUIT
+3 ;11=SURGICAL
+4 ;13=HCPCS
+5 ;15=RADIOLOGY
+6 ;17=LABORATORY
+7 ;19=MEDICAL
+8 ;23=ANESTHESIA
+9 SET ABMTBL=0
+10 FOR
SET ABMTBL=$ORDER(^ABMDFEE(ABMTBL))
IF (+$GET(ABMTBL)=0)
QUIT
Begin DoDot:1
+11 DO BMES^XPDUTL("Fee Schedule "_ABMTBL_" ...")
+12 DO MES^XPDUTL(" Schd Cat Code EffDt Fee")
+13 SET ABMEFFDT=$PIECE($GET(^ABMDFEE(ABMTBL,0)),U,5)
+14 FOR ABMM=11,13,15,17,19,23
Begin DoDot:2
+15 SET ABMMI=0
+16 FOR
SET ABMMI=$ORDER(^ABMDFEE(ABMTBL,ABMM,ABMMI))
IF (+$GET(ABMMI)=0)
QUIT
Begin DoDot:3
+17 SET ABMCODE=$PIECE($GET(^ABMDFEE(ABMTBL,ABMM,ABMMI,0)),U)
+18 SET ABMCHRG=$PIECE($GET(^ABMDFEE(ABMTBL,ABMM,ABMMI,0)),U,2)
+19 DO ^XBFMK
+20 SET DA(2)=ABMTBL
+21 SET DA(1)=ABMCODE
+22 SET DIC="^ABMDFEE("_DA(2)_","_ABMM_","_DA(1)_",1,"
+23 SET DIC(0)="L"
+24 SET DIC("P")=$PIECE(^DD(9002274.01_ABMM,1,0),U,2)
+25 SET X=ABMEFFDT
+26 SET DIC("DR")=".02////"_ABMCHRG
+27 DO ^DIC
+28 DO MES^XPDUTL(" "_ABMTBL_" "_ABMM_" "_$SELECT($GET(^ICPT(ABMCODE,0))'="":$PIECE($GET(^ICPT(ABMCODE,0)),U),1:ABMCODE)_" "_$$SDT^ABMDUTL(ABMEFFDT)_" "_$JUSTIFY($FNUMBER(ABMCHRG,",",2),"10R"))
End DoDot:3
End DoDot:2
+29 ;21=DENTAL
+30 SET ABMMI=0
+31 FOR
SET ABMMI=$ORDER(^ABMDFEE(ABMTBL,21,ABMMI))
IF (+$GET(ABMMI)=0)
QUIT
Begin DoDot:2
+32 SET ABMCODE=$PIECE($GET(^AUTTADA($PIECE($GET(^ABMDFEE(ABMTBL,21,ABMMI,0)),U),0)),U)
+33 SET ABMCHRG=+$PIECE($GET(^ABMDFEE(ABMTBL,21,ABMMI,0)),U,2)
+34 DO ^XBFMK
+35 SET DA(2)=ABMTBL
+36 SET DA(1)=ABMMI
+37 SET DIC="^ABMDFEE("_DA(2)_",21,"_DA(1)_",1,"
+38 SET DIC(0)="L"
+39 SET DIC("P")=$PIECE(^DD(9002274.0121,1,0),U,2)
+40 SET X=ABMEFFDT
+41 SET DIC("DR")=".02////"_ABMCHRG
+42 DO ^DIC
+43 DO MES^XPDUTL(" "_ABMTBL_" 21 "_ABMCODE_" "_$$SDT^ABMDUTL(ABMEFFDT)_" "_$JUSTIFY($FNUMBER(ABMCHRG,",",2),"10R"))
End DoDot:2
+44 ;25=DRUG
+45 SET ABMMI=0
+46 FOR
SET ABMMI=$ORDER(^ABMDFEE(ABMTBL,25,ABMMI))
IF (+$GET(ABMMI)=0)
QUIT
Begin DoDot:2
+47 SET ABMCODE=$PIECE($GET(^PSDRUG($PIECE($GET(^ABMDFEE(ABMTBL,25,ABMMI,0)),U),0)),U)
+48 SET ABMCHRG=+$PIECE($GET(^ABMDFEE(ABMTBL,25,ABMMI,0)),U,2)
+49 DO ^XBFMK
+50 SET DA(2)=ABMTBL
+51 SET DA(1)=ABMMI
+52 SET DIC="^ABMDFEE("_DA(2)_",25,"_DA(1)_",1,"
+53 SET DIC(0)="L"
+54 SET DIC("P")=$PIECE(^DD(9002274.0125,1,0),U,2)
+55 SET X=ABMEFFDT
+56 SET DIC("DR")=".02////"_ABMCHRG
+57 DO ^DIC
+58 DO MES^XPDUTL(" "_ABMTBL_" 25 "_$$FMT^ABMERUTL(ABMCODE,"30L")_" "_$$SDT^ABMDUTL(ABMEFFDT)_" "_$JUSTIFY($FNUMBER(ABMCHRG,",",2),"10R"))
End DoDot:2
+59 ;31=REVENUE CODES
+60 SET ABMMI=0
+61 FOR
SET ABMMI=$ORDER(^ABMDFEE(ABMTBL,31,ABMMI))
IF (+$GET(ABMMI)=0)
QUIT
Begin DoDot:2
+62 SET ABMCODE=$PIECE($GET(^AUTTREVN($PIECE($GET(^ABMDFEE(ABMTBL,31,ABMMI,0)),U),0)),U)
+63 SET ABMCHRG=+$PIECE($GET(^ABMDFEE(ABMTBL,31,ABMMI,0)),U,2)
+64 DO ^XBFMK
+65 SET DA(2)=ABMTBL
+66 SET DA(1)=ABMMI
+67 SET DIC="^ABMDFEE("_DA(2)_",31,"_DA(1)_",1,"
+68 SET DIC(0)="L"
+69 SET DIC("P")=$PIECE(^DD(9002274.0131,1,0),U,2)
+70 SET X=ABMEFFDT
+71 SET DIC("DR")=".02////"_ABMCHRG
+72 DO ^DIC
+73 DO MES^XPDUTL(" "_ABMTBL_" 31 "_ABMCODE_"-"_$$FMT^ABMERUTL($PIECE($GET(^AUTTREVN($PIECE($GET(^ABMDFEE(ABMTBL,31,ABMMI,0)),U),0)),U,2),"25L")_" "_$$SDT^ABMDUTL(ABMEFFDT)_" "_$JUSTIFY($FNUMBER(ABMCHRG,",",2),"10R"))
End DoDot:2
+74 ;32=CHARGE MASTER
+75 SET ABMMI=0
+76 FOR
SET ABMMI=$ORDER(^ABMDFEE(ABMTBL,32,ABMMI))
IF (+$GET(ABMMI)=0)
QUIT
Begin DoDot:2
+77 SET ABMCODE=$PIECE($GET(^ABMCM($PIECE($GET(^ABMDFEE(ABMTBL,32,ABMMI,0)),U),0)),U)
+78 SET ABMCHRG=+$PIECE($GET(^ABMDFEE(ABMTBL,32,ABMMI,0)),U,2)
+79 DO ^XBFMK
+80 SET DA(2)=ABMTBL
+81 SET DA(1)=ABMMI
+82 SET DIC="^ABMDFEE("_DA(2)_",32,"_DA(1)_",1,"
+83 SET DIC(0)="L"
+84 SET DIC("P")=$PIECE(^DD(9002274.0132,1,0),U,2)
+85 SET X=ABMEFFDT
+86 SET DIC("DR")=".02////"_ABMCHRG
+87 DO ^DIC
+88 DO MES^XPDUTL(" "_ABMTBL_" 32 "_ABMCODE_" "_$$SDT^ABMDUTL(ABMEFFDT)_" "_$JUSTIFY($FNUMBER(ABMCHRG,",",2),"10R"))
End DoDot:2
End DoDot:1
+89 QUIT
