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

ABMDESMD.m

Go to the documentation of this file. 
  1. ABMDESMD ; IHS/ASDST/DMJ - Summarized Claim Info - DENTAL ;    
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/ASDS/LSL - 09/21/00 - V2.4 Patch 3 - NOIS HQW-0900-100053
  1.  ;     Some payers require a prefix of S, D, or 0 to ADA code
  1.  ;
  1.  ; IHS/SD/SDR - 10/03/02 - V2.5 P2 - NHA-0302-180192
  1.  ;     Modified routine to get the units instead of hardset to 1 and
  1.  ;     to calculate charges based on units
  1.  ; IHS/SD/EFG - V2.5 P8 - IM16385
  1.  ;    Remove quit for ADA-90/ADA-94 formats
  1.  ; IHS/SD/SDR - v2.5 p13 - NO IM
  1.  ;   Change to print provider# on dental line items
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;
  1. DEN ;EP for setting DENTAL info in the ABMS array
  1.  I $G(ABMP("VTYP",998)),'$G(ABMPRINT) Q:ABMP("VTYP",998)'=ABMP("EXP")
  1.  S ABMCAT=33 D PCK^ABMDESM1 Q:$G(ABMQUIT)
  1.  S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"33,"_ABMX_")")) Q:'ABMX  S ABMX("X")=ABMX D DEN1
  1.  Q
  1.  ;
  1. DEN1 S ABMX(0)=@(ABMP("GL")_"33,"_ABMX("X")_",0)")
  1.  S ABMUNIT=$S($P(ABMX(0),U,9)'="":$P(ABMX(0),U,9),1:1)
  1.  S ABMX("SUB")=$P(ABMX(0),U,8)*ABMUNIT
  1.  S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
  1.  I $P(^ABMDEXP(ABMP("EXP"),0),U)'["UB" G DENH
  1. DENU 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.  ; ABMS(#)=Charge^date from^date to^CPT Code^Corr. ICD^units^typ serv^Description^ADA Code^tooth^surface
  1. DENH S ABMS(ABMS("I"))=ABMX("SUB")
  1.  S ABMCAT=33 D HDT^ABMDESM1
  1.  S $P(ABMS(ABMS("I")),U,6)=$S($P(ABMX(0),U,9)'="":$P(ABMX(0),U,9),1:1)
  1.  S $P(ABMS(ABMS("I")),U,7)=9
  1.  I $P(ABMX(0),U,3),ABMP("EXP")<4 S $P(ABMS(ABMS("I")),U,4)=$P($$CPT^ABMCVAPI($P(ABMX(0),U,3),ABMP("VDT")),U,2)  ;CSV-c
  1.  E  D
  1.  .S $P(ABMS(ABMS("I")),U,4)=$P($G(^AUTTADA(+ABMX(0),0)),U)
  1.  .S ABMDENP=$P($G(^ABMDREC(ABMP("INS"),0)),U,2)
  1.  .S:ABMDENP="" ABMDENP=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,11)
  1.  .S:ABMDENP="" ABMDENP=$P($G(^ABMDPARM(DUZ(2),1,3)),U,11)
  1.  .S:ABMDENP]"" $P(ABMS(ABMS("I")),U,4)=ABMDENP_$P(ABMS(ABMS("I")),U,4)
  1.  S $P(ABMS(ABMS("I")),U,5)=$P(ABMX(0),"^",4)
  1.  S $P(ABMS(ABMS("I")),U,8)=""
  1. OPS I +$P(ABMX(0),U,5),$D(^ADEOPS($P(ABMX(0),U,5),88)) S $P(ABMS(ABMS("I")),U,8)="#"_$P(^(88),U) S:$P(ABMX(0),U,6)]"" $P(ABMS(ABMS("I")),U,8)=$P(ABMS(ABMS("I")),U,8)_"-"_$P(ABMX(0),U,6) S $P(ABMS(ABMS("I")),U,8)=$P(ABMS(ABMS("I")),U,8)_" "
  1.  S $P(ABMS(ABMS("I")),U,8)=$P(ABMS(ABMS("I")),U,8)_$P(^AUTTADA(+ABMX(0),0),U,2)
  1.  S ABMX(0)=@(ABMP("GL")_"33,"_ABMX("X")_",0)")
  1.  S ABMDPRV=$O(@(ABMP("GL")_"33,"_ABMX_",""P"",""C"",""R"",0)"))
  1.  S:+ABMDPRV'=0 ABMDPRV=$P($G(@(ABMP("GL")_"33,"_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