- 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
