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

ABME8L16.m

Go to the documentation of this file. 
  1. ABME8L16 ; IHS/ASDST/DMJ - Header 
  1.  ;;2.6;IHS Third Party Billing System;**2,3**;NOV 12, 2009
  1.  ;Header Segments
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - IM13487/IM14092 - Modified to print payment
  1.  ; IHS/SD/SDR - v2.5 p8 - task 6 - Don't do referring if ambulance
  1.  ; IHS/SD/SDR - v2.5 p9 - IM19622 - Check if active is replacement
  1.  ; IHS/SD/SDR - v2.5 p13 - IM25471 - Changes for CAS if SAR=A2
  1.  ; IHS/SD/SDR - abm*2.6*2 - HEAT10900 - Ck multiple places for pymnt dt
  1.  ; IHS/SD/SDR - abm*2.6*3 - HEAT7574 - tribal self-insured
  1.  ;
  1. START ;START HERE
  1.  ;loop 2320
  1.  D PAYED^ABMUTLP
  1.  N ABMI
  1.  S ABMI=0
  1.  F  S ABMI=$O(ABMP("INS",ABMI)) Q:'ABMI  D
  1.  .S ABMLINE=ABMP("INS",ABMI)
  1.  .I $P(ABMLINE,U)=ABMP("INS")!($P(ABMLINE,"^",11)=ABMP("INS")),$P(ABMLINE,"^",3)="I" Q
  1.  .S ABMLOOP=2320
  1.  .D EP^ABME8SBR(ABMI)
  1.  .D WR^ABMUTL8("SBR")
  1.  .F ABML="OA","PR","CO" D
  1.  ..Q:'$D(ABMP(+ABMLINE,ABML))  ;quit if no data for insurer in ABMP adj array
  1.  ..D EP^ABME8CAS
  1.  ..D WR^ABMUTL8("CAS")
  1.  .;I $G(ABMP("PAYED",+ABMLINE)) D  ;abm*2.6*3 HEAT7574
  1.  .I ($G(ABMP("PAYED",+ABMLINE))!($P($G(^ABMNINS(ABMP("LDFN"),+ABMLINE,0)),U,11)="Y")) D  ;abm*2.6*3 HEAT7574
  1.  ..D EP^ABME8AMT("D")
  1.  ..D WR^ABMUTL8("AMT")
  1.  .;start new code abm*2.6*3 HEAT7574
  1.  .I ($P($G(^ABMNINS(ABMP("LDFN"),+ABMLINE,0)),U,11)="Y") D
  1.  ..S ABMB6AMT=0
  1.  ..D EP^ABME8AMT("B6")
  1.  ..D WR^ABMUTL8("AMT")
  1.  .;end new code HEAT7574
  1.  .I +$G(ABMF2AMT)'=0 D
  1.  ..D EP^ABME8AMT("F2")
  1.  ..D WR^ABMUTL8("AMT")
  1.  ..K ABMF2AMT
  1.  .I $G(ABMSBR(ABMI)) D
  1.  ..S ABMSFILE=$P(ABMSBR(ABMI),"-",1)
  1.  ..S ABMSIEN=$P(ABMSBR(ABMI),"-",2)
  1.  ..D EP^ABME8DMG(ABMSFILE,ABMSIEN)
  1.  ..D WR^ABMUTL8("DMG")
  1.  .D ^ABME8OI
  1.  .D WR^ABMUTL8("OI")
  1.  .K ABMLOOP
  1.  .;loop 2330A
  1.  .D EP^ABME8NM1("IL")
  1.  .D WR^ABMUTL8("NM1")
  1.  .D EP^ABME8N3(ABMSFILE,ABMSIEN)
  1.  .D WR^ABMUTL8("N3")
  1.  .D EP^ABME8N4(ABMSFILE,ABMSIEN)
  1.  .D WR^ABMUTL8("N4")
  1.  .;loop 2330B
  1.  .D EP^ABME8NM1("PR",+ABMLINE)
  1.  .D WR^ABMUTL8("NM1")
  1.  .I $G(ABMP("PAYED",+ABMLINE))'="" D
  1.  ..;S ABMPDT=$P($G(ABMP("PAYED",+ABMLINE)),U,2)  ;abm*2.6*2 HEAT10900
  1.  ..S ABMPDT=$S($P($G(ABMP("PAYED",+ABMLINE)),U,2)'="":$P(ABMP("PAYED",+ABMLINE),U,2),$G(ABMP("PDT",+ABMLINE))'="":ABMP("PDT",+ABMLINE),1:"")  ;abm*2.6*2 HEAT10900
  1.  ..D EP^ABME8DTP(573,"D8",ABMPDT)
  1.  ..D WR^ABMUTL8("DTP")
  1.  ..K ABMPDT
  1.  .;loop 2330C
  1.  .I $G(ABMP("PNUM",ABMI))'="" D
  1.  ..D EP^ABME8NM2("QC",ABMI)
  1.  ..D WR^ABMUTL8("NM1")
  1.  .D OTHR
  1.  Q
  1. OTHR ;other payer info
  1.  ;loops 2330D through 2330H
  1.  N J
  1.  F J=1:1:4 D
  1.  .S ABMPTYP=$E("FRPS",J)
  1.  .Q:($G(ABMP("CLIN"))="A3")&(J="R")
  1.  .S ABMPROV=$O(ABMP("PRV",ABMPTYP,0))
  1.  .I ABMPROV D
  1.  ..S ABMPNBR=$$NPI^ABMEEPRV(ABMPROV,ABMP("LDFN"),+ABMLINE)
  1.  ..Q:ABMPNBR=""
  1.  ..D EP^ABME8NM2($P("DN^82^QB^DQ","^",J))
  1.  ..D WR^ABMUTL8("NM1")
  1.  ..S ABMITYP=$P(ABMLINE,"^",2)
  1.  ..S ABMP("RTYPE")=$S(ABMITYP="R":"1G",ABMITYP="D":"1D",$P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$P($G(^ABMREFID($P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B")
  1.  ..I ABMP("EXP")=22,ABMP("RTYPE")="1G" S ABMP("RTYPE")="1C"
  1.  ..D EP^ABME8RF2(ABMP("RTYPE"))
  1.  ..I ABMNPIU="B"!(ABMNPIU="N") D
  1.  ...D EP^ABME8REF("EI",9999999.06,DUZ(2))
  1.  ..D WR^ABMUTL8("REF")
  1.  Q