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

ABMDESMH.m

Go to the documentation of this file. 
  1. ABMDESMH ; IHS/SD/SDR - Profession Services for Seperate Bill ; 
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**10,14**;NOV 12, 2009;Build 238
  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 p13 - IM25574
  1.  ;   Correction to CPT Modifier in Medical multiple
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to use $$GET1^DIQ so output transform will execute for SNOMED/Provider Narrative
  1.  ;
  1.  K ABMS I $D(ABMP("FLAT")),$P(ABMP("FLAT"),U,3)]"" G FLAT
  1.  ;
  1.  S ABMS("TOT")=0
  1. MS S:'$D(ABMS("I")) ABMS("I")=1 S ABMX="""""",ABMX("ER")=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"21,""C"","_ABMX_")")) Q:'ABMX  S ABMX("X")=$O(^(ABMX,"")) D MS1
  1.  G PRO
  1.  ;
  1. MS1 S ABMX(0)=@(ABMP("GL")_"21,"_ABMX("X")_",0)"),ABMX(1)=$G(^(1))
  1.  S ABMX("R")=$P(ABMX(0),U,3)
  1.  I +$P(ABMX(0),U,7)=0!(ABMX("R")=""&($P(^ABMDEXP(ABMP("EXP"),0),U)["UB")) S ABMS("I")=ABMS("I")-1 Q
  1.  I (ABMX("R")<960!(ABMX("R")>963))&(ABMX("R")'=969) S ABMS("I")=ABMS("I")-1 Q
  1.  S ABMS("TOT")=ABMS("TOT")+$P(ABMX(0),U,7)
  1.  ; ABMS(#)=Charge^date from^date to^CPT Code^Corr. ICD^units^typ serv^Description
  1. MSH S ABMS(ABMS("I"))=$P(ABMX(0),U,7)
  1.  S $P(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL($P(ABMX(0),U,5)),$P(ABMS(ABMS("I")),U,3)=$$HDT^ABMDUTL($P(ABMX(0),U,5))
  1.  S ABMX("C")=$P(ABMX(0),U) D CPT S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,9)]"":"-"_$P(ABMX(0),U,9),1:"")_$S($P(ABMX(1),U)]"":"-"_$P(ABMX(1),U),1:"")_$S($P(ABMX(1),U,2)]"":"-"_$P(ABMX(1),U,2),1:"")
  1.  S ABMX("D")=$P(ABMX(0),U,4) D ICD S $P(ABMS(ABMS("I")),U,5)=ABMX("D")
  1.  S $P(ABMS(ABMS("I")),U,6)=1
  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)=$S($P(^DIC(81.1,$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,4),0),U,3)=2:2,1:1)  ;CSV-c
  1.  S $P(ABMS(ABMS("I")),U,10)=$P($G(ABMX(0)),"^",15)  ;POS
  1.  ;S $P(ABMS(ABMS("I")),U,8)=$P(^AUTNPOV($P(ABMX(0),U,6),0),U)  ;abm*2.6*14 HEAT161263
  1.  S $P(ABMS(ABMS("I")),U,8)=$$GET1^DIQ(9999999.27,$P(ABMX(0),U,6),"01","E")  ;abm*2.6*14 HEAT161263
  1.  Q
  1.  ;
  1. PRO S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"27,"_ABMX_")")) Q:'ABMX  S ABMX("X")=ABMX D PRO1
  1.  G ANS
  1.  ;
  1. PRO1 S ABMX(0)=@(ABMP("GL")_"27,"_ABMX("X")_",0)")
  1.  S ABMX("SUB")=($P(ABMX(0),U,3)*$P(ABMX(0),U,4))
  1.  S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
  1.  ;
  1. PROH S ABMS(ABMS("I"))=ABMX("SUB")
  1.  D HDT^ABMDESM1
  1.  ;
  1.  S ABMX("C")=$P(ABMX(0),U) D CPT
  1.  S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,5)]"":"-"_$P($$MOD^ABMCVAPI($P(ABMX(0),U,5),"",ABMP("VDT")),U,2),1:"")_$S($P(ABMX(0),U,8)]"":"-"_$P(ABMX(0),U,8),1:"")_$S($P(ABMX(0),U,9)]"":"-"_$P(ABMX(0),U,9),1:"")  ;CSV-c
  1.  ;
  1.  S ABMX("D")=$P(ABMX(0),U,6) D ICD S $P(ABMS(ABMS("I")),U,5)=ABMX("D")
  1.  S $P(ABMS(ABMS("I")),U,6)=$P(ABMX(0),U,3)
  1.  S $P(ABMS(ABMS("I")),U,7)=1
  1.  S $P(ABMS(ABMS("I")),U,8)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3)  ;CSV-c
  1.  Q
  1.  ;
  1. ANS S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"39,"_ABMX_")")) Q:'ABMX  S ABMX("X")=ABMX D ANS1
  1.  G XIT
  1.  ;
  1. ANS1 S ABMX(0)=@(ABMP("GL")_"39,"_ABMX("X")_",0)")
  1.  S ABMX("R")=$P(ABMX(0),U,2) I ABMX("R")'=963 S ABMS("I")=ABMS("I")-1 Q
  1.  S ABMX("C")=$P(ABMX(0),U,3)   ; D ANESTH^ABMDESMA
  1.  S ABMX("SUB")=ABMX("C")+$P(ABMX(0),U,4)
  1.  S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
  1. ANSH S ABMS(ABMS("I"))=ABMX("SUB") D HDT^ABMDESM1
  1.  S ABMX("C")=$P(ABMX(0),U) D CPT S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_"-47"
  1.  S $P(ABMS(ABMS("I")),U,6)=1,$P(ABMS(ABMS("I")),U,7)=7
  1.  S $P(ABMS(ABMS("I")),U,8)="ANESTHESIA IN ASSOC W/ CPT:"_$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2)  ;CSV-c
  1.  Q
  1.  ;
  1. CPT ;
  1.  S:ABMX("C")]"" ABMX("C")=$P($$CPT^ABMCVAPI(ABMX("C"),ABMP("VDT")),U,2)  ;CSV-c
  1.  Q
  1. ICD ;
  1.  S:ABMX("D")]"" ABMX("D")=$P($$DX^ABMCVAPI(ABMX("D"),ABMP("VDT")),U,2)  ;CSV-c
  1.  Q
  1.  ;
  1. XIT S ABMP("EXP",ABMP("VTYP",999))=ABMS("TOT")
  1.  K ABMX
  1.  Q
  1.  ;
  1. FLAT S $P(ABMS(1),U,2)=$$HDT^ABMDUTL($P($G(@(ABMP("GL")_"7)")),U))
  1.  S $P(ABMS(1),U,3)=$$HDT^ABMDUTL($P($G(@(ABMP("GL")_"7)")),U,2))
  1.  ;I $P($G(^AUTNINS(ABMP("INS"),2)),U)="R" S $P(ABMS(1),U,4)=90250  ;abm*2.6*10 HEAT73780
  1.  I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="R" S $P(ABMS(1),U,4)=90250  ;abm*2.6*10 HEAT73780
  1.  S ABMX("FDAYS")=$S($P(ABMS(1),U,2)=$P(ABMS(1),U,3):1,1:$P(ABMP("FLAT"),U,8))
  1.  S ABMX("NARR")=$S(ABMX("FDAYS")>0:ABMX("FDAYS"),1:1)
  1.  S ABMX("NARR2")=" "_$S(ABMX("NARR")>1:"DAYS",1:"DAY")_" @ $"_$J($P(ABMP("FLAT"),U,4),4,2)
  1.  S $P(ABMS(1),U,8)=ABMX("NARR")_ABMX("NARR2")
  1.  S ABMS("TOT")=$P(ABMP("FLAT"),U,4)*$S(ABMX("FDAYS")>0:ABMX("FDAYS"),1:1)
  1.  S $P(ABMS(1),U,1)=ABMS("TOT")
  1.  S $P(ABMS(1),U,6)=$S(ABMX("FDAYS")>0:ABMX("FDAYS"),1:1)
  1.  S $P(ABMS(1),U,7)=1
  1.  G XIT