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

ABMDESMB.m

Go to the documentation of this file. 
  1. ABMDESMB ; IHS/ASDST/DMJ - Summarized Claim AMBULANCE. Info ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - task 6
  1.  ;   New routine
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;
  1. AMB ;EP for AMB charges
  1.  I $G(ABMP("VTYP",993)),'$G(ABMPRINT) Q:ABMP("VTYP",993)'=ABMP("EXP")
  1.  S ABMCAT=47 D PCK^ABMDESM1 Q:$G(ABMQUIT)
  1.  S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"47,"_ABMX_")")) Q:'ABMX  S ABMX("X")=ABMX D AMB1
  1.  Q
  1.  ;
  1. AMB1 S ABMX(0)=@(ABMP("GL")_"47,"_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.  S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
  1.  I $P(^ABMDEXP(ABMP("EXP"),0),U)'["UB" G AMBH
  1.  ; ABMS(revn)=Totl Charge^units^Unit Charge^CPT Code
  1. AMBU 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. AMBH ;ABMS ARRAY FOR HCFA 1500
  1.  ; ABMS(#)=Charge^date from^date to^CPT Code^Corr. ICD^units^typ serv^Description
  1.  S ABMS(ABMS("I"))=ABMX("SUB")
  1.  S ABMCAT=47 D HDT^ABMDESM1
  1.  S $P(ABMS(ABMS("I")),U,5)=$P(ABMX(0),U,6)
  1.  S $P(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")
  1.  I $P(ABMX(0),U,16) D
  1.  .S $P(ABMS(ABMS("I")),U,7)=$P($G(^ABMDCODE($P(ABMX(0),U,16),0)),U)
  1.  E  S $P(ABMS(ABMS("I")),U,7)=1
  1.  S $P(ABMS(ABMS("I")),U,10)=$P($G(ABMX(0)),U,15)  ;POS
  1.  S ABMX("C")=$P(ABMX(0),U) D CPT
  1.  S ABMX("C")=$P(ABMX(0),U) D CPT S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,5)]"":"-"_$P(ABMX(0),U,5),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:"")
  1.  S $P(ABMS(ABMS("I")),U,8)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3)  ;CSV-c
  1.  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.  Q
  1.  ;
  1. REVN ;EP for REVENUE charges
  1.  S ABMX("ER")=+$P($G(@(ABMP("GL")_"9)")),U,8) I 'ABMX("ER") Q
  1.  S ABMX("REV")=+$P($G(@(ABMP("GL")_"9)")),U,7) I 'ABMX("REV") Q
  1.  I $P(^ABMDEXP(ABMP("EXP"),0),U)["UB" S $P(ABMS(ABMX("REV")),U)=$S($D(ABMS(ABMX("REV"))):$P(ABMS(ABMX("REV")),U)+ABMX("ER"),1:ABMX("ER")) G TREVN
  1.  S ABMS(ABMS("I"))=ABMX("ER")
  1.  S X=$S($P($G(@(ABMP("GL")_"6)")),U)]"":$P(@(ABMP("GL")_"6)"),U),1:$P($G(@(ABMP("GL")_"7)")),U))
  1.  S $P(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL(X)
  1.  S $P(ABMS(ABMS("I")),U,8)=$P(^AUTTREVN(ABMX("REV"),0),U,2)
  1.  S ABMS("I")=ABMS("I")+1
  1. TREVN S ABMS("TOT")=ABMS("TOT")+ABMX("ER")
  1.  Q
  1.  ;
  1. ROO ;EP for R&B Charges
  1.  I $G(ABMP("VTYP",991)),'$G(ABMPRINT) Q:ABMP("VTYP",991)'=ABMP("EXP")
  1.  S ABMCAT=25 D PCK^ABMDESM1 Q:$G(ABMQUIT)
  1.  S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"25,"_ABMX_")")) Q:'ABMX  S ABMX("X")=ABMX D ROO1
  1.  Q
  1.  ;
  1. ROO1 S ABMX(0)=@(ABMP("GL")_"25,"_ABMX("X")_",0)")
  1.  S ABMZ("UNIT")=$P(ABMX(0),U,2)
  1.  S:'+ABMZ("UNIT") ABMZ("UNIT")=1
  1.  S ABMX("SUB")=(ABMZ("UNIT")*$P(ABMX(0),U,3))
  1.  S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
  1.  I $P(^ABMDEXP(ABMP("EXP"),0),U)'["UB" G ROOH
  1. ROOU S ABMX("R")=$P(ABMX(0),U,1)
  1.  I $D(ABMS(ABMX("R"))) S $P(ABMS(ABMX("R")),U)=$P(ABMS(ABMX("R")),U)+ABMX("SUB"),$P(ABMS(ABMX("R")),U,2)=$P(ABMS(ABMX("R")),U,2)+ABMZ("UNIT")
  1.  E  S ABMS(ABMX("R"))=ABMX("SUB")_U_ABMZ("UNIT")_U_$P(ABMX(0),U,3)
  1.  Q
  1.  ;
  1. ROOH S ABMS(ABMS("I"))=ABMX("SUB")
  1.  S ABMCAT=25 D HDT^ABMDESM1
  1.  S $P(ABMS(ABMS("I")),U,4)="R&B"
  1.  S $P(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")
  1.  S $P(ABMS(ABMS("I")),U,8)=$P(^AUTTREVN(+ABMX(0),0),U,2)
  1.  Q
  1.  ;
  1. CPT I ABMX("C")]"" S ABMX("C")=$P($$CPT^ABMCVAPI(ABMX("C"),ABMP("VDT")),U,2)  ;CSV-c
  1.  Q
  1. SUP ;EP - for SUPPLY charges
  1.  S ABMCAT=45 D PCK^ABMDESM1 Q:$G(ABMQUIT)
  1.  N K S K=+$O(ABMS(99999),-1)
  1.  I $G(ABMP("CDFN")) D  Q
  1.  .N I S I=0 F  S I=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,I)) Q:'I  D
  1.  ..N J F J=1:1:7 S ABMX(J)=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,I,0),"^",J)
  1.  ..D SSET
  1.  I $G(ABMP("BDFN")) D
  1.  .N I S I=0 F  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,I)) Q:'I  D
  1.  ..N J F J=1:1:7 S ABMX(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,I,0),"^",J)
  1.  ..D SSET
  1.  Q
  1. SSET ;SET ABMS ARRAY
  1.  Q:'$D(^ABMCM(ABMX(1)))    ; Item deleted from supply file
  1.  S:'+ABMX(3) ABMX(3)=1
  1.  S K=K+1
  1.  S:'ABMX(5) ABMX(5)=270
  1.  S ABMX("SUB")=ABMX(3)*ABMX(4)
  1.  S ABMS("TOT")=+$G(ABMS("TOT"))+ABMX("SUB")
  1.  I $P(^ABMDEXP(ABMP("EXP"),0),U)["UB" D SUB Q
  1.  S ABMS(K)=ABMX("SUB")
  1.  S $P(ABMS(K),U,2)=$$HDT^ABMDUTL(ABMX(2))
  1.  S $P(ABMS(K),U,3)=$P(ABMS(K),U,2)
  1.  S $P(ABMS(K),U,4)=$P($$CPT^ABMCVAPI(+ABMX(7),ABMP("VDT")),U,2)  ;CSV-c
  1.  S $P(ABMS(K),U,5)=ABMX(6)
  1.  S $P(ABMS(K),U,6)=ABMX(3)
  1.  S $P(ABMS(K),U,7)=9
  1.  S $P(ABMS(K),U,8)=$P(^ABMCM(ABMX(1),0),U)
  1.  Q
  1. SUB ;SET ABMS ARRAY FOR UB-92 TYPE FORM
  1.  S $P(ABMS(ABMX(5)),"^",1)=+$P($G(ABMS(ABMX(5))),U)+ABMX("SUB")
  1.  Q