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

ABME5L9.m

Go to the documentation of this file. 
  1. ABME5L9 ; IHS/ASDST/DMJ - Header 
  1.  ;;2.6;IHS Third Party Billing System;**6,8,9,10,21**;NOV 12, 2009;Build 379
  1.  ;Header Segments
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT70826 - Modified to remove 2310B loop based on SGTM entry
  1. EP ;START HERE
  1.  N ABM
  1.  K ABMP("PRV")  ;reset provider array
  1.  D GETPRV^ABMEEPRV             ; Build Claim Level Provider array
  1.  S ABMPAYER=ABMP("INS")
  1.  ;
  1.  ; Loop 2310A - Referring Physician Name
  1.  S ABMLOOP="2310A"
  1.  I $D(ABMP("PRV","F")) D
  1.  .S ABM("PRV")=$O(ABMP("PRV","F",0))
  1.  .D EP^ABME5NM1("DN")
  1.  .D WR^ABMUTL8("NM1")
  1.  .I $P($G(ABMB8),U,18)'="" D
  1.  ..D EP^ABME5REF($S($P($G(ABMB8),U,18)'="":$P(ABMB8,U,18),1:ABMP("RTYPE")),200,ABM("PRV"))
  1.  ..D WR^ABMUTL8("REF")
  1.  ;
  1.  ; Loop 2310B - Rendering Physician Name
  1.  S ABMLOOP="2310B"
  1.  I $D(ABMP("PRV","R"))!($D(ABMP("PRV","A"))) D
  1.  .Q:$G(ABMP("VTYP"))=831  ;don't write provider info for ASC
  1.  .Q:$G(ABMP("CLIN"))="A3"
  1.  .;start new abm*2.6*21 IHS/SD/SDR HEAT70826
  1.  .S ABMOFLG=0
  1.  .I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","00","0","N"))>0 D
  1.  ..S ABMO=0
  1.  ..F  S ABMO=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","00","0","N",ABMO)) Q:'ABMO  D
  1.  ...I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,ABMO,0)),U,6)=""!($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,ABMO,0)),U,6)=ABMP("VTYP")) S ABMOFLG=1
  1.  .Q:ABMOFLG=1
  1.  .;end new abm*2.6*21 IHS/SD/SDR HEAT70826
  1.  .S ABM("PRV")=$S($D(ABMP("PRV","R")):$O(ABMP("PRV","R",0)),1:$O(ABMP("PRV","A",0)))
  1.  .D EP^ABME5NM1("82")
  1.  .D WR^ABMUTL8("NM1")
  1.  .D EP^ABME5PRV("PE",ABM("PRV"))
  1.  .D WR^ABMUTL8("PRV")
  1.  .Q:$P($G(^AUTNINS(ABMP("INS"),0)),U)["OKLAHOMA MEDICAID"
  1.  .;D EP^ABME5REF("EI",9999999.06,DUZ(2)) ;5010 837P
  1.  .K ABMLOOP
  1.  ;
  1.  ; Loop 2310C - Service Facility Name
  1.  S ABMLOOP="2310C"
  1.  ;start old code abm*2.6*9 HEAT57746
  1.  ;S ABMTRUE=(ABMP("LDFN")'=DUZ(2))
  1.  ;I 'ABMTRUE D
  1.  ;.Q:$$POS^ABMERUTL<12
  1.  ;.Q:$$POS^ABMERUTL=12
  1.  ;.S ABMTRUE=1
  1.  ;I ABMTRUE D
  1.  ;end old code start new code HEAT57746
  1.  S ABMSLOC=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,17)  ;abm*2.6*9 HEAT57746
  1.  I ((ABMSLOC="S")!((ABMSLOC="D")!(ABMSLOC="")&($P($G(^DIC(4,DUZ(2),0)),U)'=$P($G(^DIC(4,ABMP("LDFN"),0)),U)))) D  ;abm*2.6*8  ;abm*2.6*9 HEAT57746
  1.  .;end new code HEAT57746
  1.  .D EP^ABME5NM1(77)
  1.  .D OVER^ABMUTLP(51)
  1.  .D WR^ABMUTL8("NM1")
  1.  .S ABMFILE=4,ABMIEN=ABMP("LDFN")
  1.  .D EP^ABME5N3(ABMFILE,ABMIEN)
  1.  .D OVER^ABMUTLP(52)
  1.  .D WR^ABMUTL8("N3")
  1.  .S ABMFILE=4,ABMIEN=ABMP("LDFN")
  1.  .D EP^ABME5N4(ABMFILE,ABMIEN)
  1.  .D OVER^ABMUTLP(53)
  1.  .D WR^ABMUTL8("N4")
  1.  .;start old code abm*2.6*10 NOHEAT
  1.  .;D EP^ABME8REF("LU",9999999.06,ABMP("LDFN"))
  1.  .;D WR^ABMUTL8("REF")
  1.  .;end old code abm*2.6*10 NO HEAT
  1.  ;
  1.  ; Loop 2310D - Supervising Physician Name
  1.  S ABMLOOP="2310D"
  1.  I $D(ABMP("PRV","S")) D
  1.  .S ABM("PRV")=$O(ABMP("PRV","S",0))
  1.  .D EP^ABME5NM1("DQ")
  1.  .D WR^ABMUTL8("NM1")
  1.  ;.I ABMNPIU="N" D ;5010 837P
  1.  ;..;D EP^ABME5REF("EI",9999999.06,DUZ(2)) ;5010 837P
  1.  ;..D EP^ABME5REF("EI",9999999.06,DUZ(2)) ;5010 837P
  1.  ;..D WR^ABMUTL8("REF") ;5010 837P
  1.  ;.I ABMNPIU'="N" D ;5010 837P
  1.  ;..;D EP^ABME5REF("1G",200,ABM("PRV")) ;5010 837P
  1.  ;..D EP^ABME5REF("1G",200,ABM("PRV")) ;5010 837P
  1.  ;..D WR^ABMUTL8("REF") ;5010 837P
  1.  ;
  1.  ; LOOP 2310E - Ambulance Pick-Up Location
  1.  S ABMLOOP="2310E"
  1.  ;I $G(ABMP("CLIN"))="A3"&($P($G(^ABMDBILL(DUZ(2),+ABMP("PCN"),12)),U,2)'="") D  ;abm*2.6* HEAT45242
  1.  I $G(ABMP("CLIN"))="A3"&($P($G(^ABMDBILL(DUZ(2),+ABMP("BDFN"),12)),U,2)'="") D  ;abm*2.6* HEAT45242
  1.  .D EP^ABME5NM1("PW")
  1.  .D WR^ABMUTL8("NM1")
  1.  .D EP^ABME5N3("AMB","PU")
  1.  .D WR^ABMUTL8("N3")
  1.  .D EP^ABME5N4("AMB","PU")
  1.  .D WR^ABMUTL8("N4")
  1.  ;
  1.  ; LOOP 2310F - Ambulance Drop-Off Location
  1.  S ABMLOOP="2310F"
  1.  ;I $G(ABMP("CLIN"))="A3"&($P($G(^ABMDBILL(DUZ(2),+ABMP("PCN"),12)),U,7)'="") D  ;abm*2.6*8 HEAT45242
  1.  I $G(ABMP("CLIN"))="A3"&($P($G(^ABMDBILL(DUZ(2),+ABMP("BDFN"),12)),U,7)'="") D  ;abm*2.6*8 HEAT45242
  1.  .D EP^ABME5NM1(45)
  1.  .D WR^ABMUTL8("NM1")
  1.  .D EP^ABME5N3("AMB","DO")
  1.  .D WR^ABMUTL8("N3")
  1.  .D EP^ABME5N4("AMB","DO")
  1.  .D WR^ABMUTL8("N4")
  1.  Q