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

ABMDESMX.m

Go to the documentation of this file. 
  1. ABMDESMX ; IHS/ASDST/DMJ - Summarized Claim RADIOLOGY charges ;
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**13**;NOV 12, 2009;Build 213
  1.  ;
  1.  ; IHS/DSD/LSL - 09/02/98 - Patch 2 - NOIS NDA-0898-180038
  1.  ;             0.00 charges on HCFA because version 2.0 does not assume
  1.  ;             1 for units.  Modify code to set units to 1 if not
  1.  ;             already defined.
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
  1.  ; IHS/SD/SDR - V2.5 P8 - IM10618/IM11164 - Prompt/display provider
  1.  ; IHS/SD/SDR - v2.5 p9 - task 1 - Use new service line provider multiple
  1.  ; IHS/SD/SDR - v2.5 p11 - NPI
  1.  ; IHS/SD/SDR - v2.5 p12 - IM25331 - Add provider taxonomy to CMS-1500 block 24K
  1.  ; IHS/SD/SDR - v2.5 p13 - IM25899 - Alignment changes
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35
  1.  ;
  1. RAD ;EP for adding Radiology
  1.  I $G(ABMP("VTYP",995)),'$G(ABMPRINT) Q:ABMP("VTYP",995)'=ABMP("EXP")
  1.  S ABMCAT=35 D PCK^ABMDESM1 Q:$G(ABMQUIT)
  1.  S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"35,"_ABMX_")")) Q:'ABMX  S ABMX("X")=ABMX D RAD1
  1.  Q
  1.  ;
  1. RAD1 S ABMX(0)=@(ABMP("GL")_"35,"_ABMX("X")_",0)")
  1.  S ABMZ("UNIT")=$P(ABMX(0),U,3)
  1.  S:'+ABMZ("UNIT") ABMZ("UNIT")=1
  1.  S ABMX("SUB")=(ABMZ("UNIT")*$P(ABMX(0),U,4))
  1.  I ABMX("SUB")=0 S ABMS("I")=ABMS("I")-1 Q
  1.  S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
  1.  I $P(^ABMDEXP(ABMP("EXP"),0),U)'["UB" G RADH
  1. RADU S ABMX("R")=$P(ABMX(0),U,2) Q:ABMX("R")=""
  1.  I $D(ABMS(ABMX("R"))) S $P(ABMS(ABMX("R")),U)=$P(ABMS(ABMX("R")),U)+ABMX("SUB")
  1.  E  S ABMS(ABMX("R"))=ABMX("SUB")
  1.  Q
  1.  ;
  1. RADH S ABMS(ABMS("I"))=ABMX("SUB")
  1.  S ABMCAT=35 D HDT^ABMDESM1
  1.  S $P(ABMS(ABMS("I")),U,4)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2)_$S($P(ABMX(0),U,5)]"":"-"_$P(ABMX(0),U,5),1:"")_$S($P(ABMX(0),U,6)]"":"-"_$P(ABMX(0),U,6),1:"")_$S($P(ABMX(0),U,7)]"":"-"_$P(ABMX(0),U,7),1:"")  ;CSV-c
  1.  ;I ABMP("EXP")=27 S $P(ABMS(ABMS("I")),U,4)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2)_$S($P(ABMX(0),U,5)]"":" "_$P(ABMX(0),U,5),1:"")_$S($P(ABMX(0),U,6)]"":" "_$P(ABMX(0),U,6),1:"")_$S($P(ABMX(0),U,7)]"":" "_$P(ABMX(0),U,7),1:"")  ;CSV-c  ;abm*2.6*13 export mode 35
  1.  I "^27^35^"[("^"_ABMP("EXP")_"^") D    ;CSV-c  ;abm*2.6*13 export mode 35
  1.  .S $P(ABMS(ABMS("I")),U,4)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2)_$S($P(ABMX(0),U,5)]"":" "_$P(ABMX(0),U,5),1:"")_$S($P(ABMX(0),U,6)]"":" "_$P(ABMX(0),U,6),1:"")_$S($P(ABMX(0),U,7)]"":" "_$P(ABMX(0),U,7),1:"")  ;abm*2.6*13 exp mode 35
  1.  S $P(ABMS(ABMS("I")),"^",5)=$P(ABMX(0),"^",8)
  1.  S $P(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")
  1.  I $P(ABMX(0),"^",16) D
  1.  . S $P(ABMS(ABMS("I")),U,7)=$P($G(^ABMDCODE($P(ABMX(0),"^",16),0)),"^")
  1.  E  S $P(ABMS(ABMS("I")),U,7)=4
  1.  S $P(ABMS(ABMS("I")),U,10)=$P($G(ABMX(0)),"^",15)  ;POS
  1.  S $P(ABMS(ABMS("I")),U,8)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3)  ;CSV-c
  1.  S ABMX(0)=@(ABMP("GL")_"35,"_ABMX("X")_",0)")
  1.  S ABMDPRV=$O(@(ABMP("GL")_"35,"_ABMX_",""P"",""C"",""R"",0)"))
  1.  S:+ABMDPRV'=0 ABMDPRV=$P($G(@(ABMP("GL")_"35,"_ABMX_",""P"","_ABMDPRV_",0)")),U)
  1.  I $G(ABMDPRV)="" S ABMDPRV=$$GETPRV^ABMDFUTL
  1.  I +$G(ABMDPRV)'=0 D
  1.  .Q:'$$K24^ABMDFUTL
  1.  .S $P(ABMS(ABMS("I")),U,9)=$$K24N^ABMDFUTL(ABMDPRV)
  1.  .S $P(ABMS(ABMS("I")),U,11)=$P($$NPI^XUSNPI("Individual_ID",ABMDPRV),U)
  1.  .I $G(ABMP("NPIS"))="N" S $P(ABMS(ABMS("I")),U,9)=$$PTAX^ABMEEPRV(ABMDPRV)
  1.  Q