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

ABME5L12.m

Go to the documentation of this file. 
  1. ABME5L12 ; IHS/ASDST/DMJ - Header 
  1.  ;;2.6;IHS Third Party Billing System;**6,8,9,10,11,22,23,25**;NOV 12, 2009;Build 444
  1.  ;Header Segments
  1.  ;IHS/SD/SDR 2.6*22 HEAT335246 check new parameter for itemized but with the flat rate on first line, zeros for the rest
  1.  ;IHS/SD/AML 2.6*23 HEAT247169 if the subfile is 43 and there's a NDC print segments LIN and CTP for medication
  1.  ;IHS/SD/SDR 2.6*25 CR10008 commented out code that writes purchased service provider loop; piece 19 of array is used for something else, and we don't
  1.  ;   capture the purchased service provider at this time anyway.
  1.  ;
  1. EP ;START HERE
  1.  S ABMLXCNT=0
  1.  K ABM
  1.  D ^ABMEHGRV
  1.  S ABMITMZ=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",12)  ;abm*2.6*22 IHS/SD/SDR HEAT335246
  1.  I +ABMITMZ&($P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y")&(+$G(ABMP("FLAT"))'=0) D START^ABMEHGR4  ;abm*2.6*22 IHS/SD/SDR HEAT335246
  1.  S ABMI=0
  1.  F  S ABMI=$O(ABMRV(ABMI)) Q:'+ABMI  D
  1.  .S ABMJ=-1
  1.  .F  S ABMJ=$O(ABMRV(ABMI,ABMJ)) Q:'+ABMJ  D
  1.  ..S ABMK=0
  1.  ..F  S ABMK=$O(ABMRV(ABMI,ABMJ,ABMK)) Q:'+ABMK  D
  1.  ...D LOOP
  1.  K ABMI,ABMJ,ABMK
  1.  Q
  1.  ;
  1. LOOP ;
  1.  S ABMLXCNT=ABMLXCNT+1
  1.  S ABMLOOP=2400
  1.  D EP^ABME5LX
  1.  D WR^ABMUTL8("LX")
  1.  D EP^ABME5SV1
  1.  D WR^ABMUTL8("SV1")
  1.  I +$P(ABMRV(ABMI,ABMJ,ABMK),U,33) D
  1.  .D EP^ABME5SV5
  1.  .D WR^ABMUTL8("SV5")
  1.  ;PWK segment goes here
  1.  I $P(ABMRV(ABMI,ABMJ,ABMK),U,10) D
  1.  .I $P(ABMRV(ABMI,ABMJ,ABMK),U,27)'="",($P($P(ABMRV(ABMI,ABMJ,ABMK),U,10),".")'=$P($P(ABMRV(ABMI,ABMJ,ABMK),U,27),".")) D EP^ABME5DTP(472,"RD8",$P(ABMRV(ABMI,ABMJ,ABMK),U,10),$P(ABMRV(ABMI,ABMJ,ABMK),U,27))
  1.  .E  D EP^ABME5DTP(472,"D8",$P(ABMRV(ABMI,ABMJ,ABMK),U,10))
  1.  I '$P(ABMRV(ABMI,ABMJ,ABMK),U,10) D
  1.  .D EP^ABME5DTP(472,"D8",$P(ABMB7,U))
  1.  D WR^ABMUTL8("DTP")
  1.  I $P(ABMRV(ABMI,ABMJ,ABMK),U,32)'="" D
  1.  .D EP^ABME5DTP(471,"D8",$P(ABMRV(ABMI,ABMJ,ABMK),U,32))
  1.  .D WR^ABMUTL8("DTP")
  1.  I ABMI=37,$P(ABMRV(ABMI,ABMJ,ABMK),U,34)'="" D
  1.  .D EP^ABME5DTP(738,"D8",$P(ABMRV(ABMI,ABMJ,ABMK),U,34))
  1.  .D WR^ABMUTL8("DTP")
  1.  I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,18)>1 D
  1.  .D EP^ABME5QTY("PT")
  1.  .D WR^ABMUTL8("QTY")
  1.  I ABMI=37 D  ;lab multiple
  1.  .Q:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,ABMJ,0)),U,21)=""  ;no lab result
  1.  .D ^ABME5MEA
  1.  .D WR^ABMUTL8("MEA")
  1.  ;D EP^ABME5REF("6R","")   ;line item control number  ;abm*2.6*11 HEAT92070
  1.  ;D WR^ABMUTL8("REF")  ;abm*2.6*11 HEAT92070
  1.  ;start new code abm*2.6*11 HEAT92070
  1.  I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,38)'="" D
  1.  .D EP^ABME5REF("6R","")
  1.  .D WR^ABMUTL8("REF")   ;line item control number
  1.  ;end new code HEAT92070
  1.  ;start new code abm*2.6*8 HEAT31238
  1.  ;mammography cert number
  1.  ;I (($P(ABMRV(ABMI,ABMJ,ABMK),U,2)>77050)&($P(ABMRV(ABMI,ABMJ,ABMK),U,2)<77060)) D  ;abm*2.6*10 HEAT65066
  1.  ;I (($P(ABMRV(ABMI,ABMJ,ABMK),U,2)>77050)&($P(ABMRV(ABMI,ABMJ,ABMK),U,2)<77060))!$P(ABMRV(ABMI,ABMJ,ABMK),U,2)=76083!($P(ABMRV(ABMI,ABMJ,ABMK),U,2)=76092)!($P(ABMRV(ABMI,ABMJ,ABMK),U,2)="G0202") D  ;abm*2.6*10 HEAT65066  ;abm*2.6*11 IHS/SD/AML HEAT95824
  1.  I (($P(ABMRV(ABMI,ABMJ,ABMK),U,2)>77050)&($P(ABMRV(ABMI,ABMJ,ABMK),U,2)<77060))!($P(ABMRV(ABMI,ABMJ,ABMK),U,2)=76083)!($P(ABMRV(ABMI,ABMJ,ABMK),U,2)=76092)!($P(ABMRV(ABMI,ABMJ,ABMK),U,2)="G0202") D  ;abm*2.6*11 IHS/SD/AML HEAT95824
  1.  .Q:ABMP("CLIN")=72  ;don't write if clinic is mammography; cert# already written for claim
  1.  .Q:$P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)=""  ;no cert#
  1.  .D EP^ABME8REF("EW")
  1.  .D WR^ABMUTL8("REF")
  1.  ;end new code HEAT31238
  1.  ;I (($P(ABMRV(ABMI,ABMJ,ABMK),U,2)>79999)&($P(ABMRV(ABMI,ABMJ,ABMK),U,2)<90000))!($E($P(ABMRV(ABMI,ABMJ,ABMK),U,2))="G0107") D  ;abm*2.6*8 HEAT40295
  1.  I (($P(ABMRV(ABMI,ABMJ,ABMK),U,2)>79999)&($P(ABMRV(ABMI,ABMJ,ABMK),U,2)<90000))!($E($P(ABMRV(ABMI,ABMJ,ABMK),U,2))="G") D  ;abm*2.6*8 HEAT40295
  1.  .Q:ABMI'=37  ;abm*2.6*10 HEAT73027
  1.  .;Q:($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)="")  ;abm*2.6*10 HEAT72789  ;abm*2.6*11 HEAT85498
  1.  .S ABMCLIA="SV"
  1.  .I $G(ABMOUTLB)'=1 D
  1.  ..;I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'="",($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)=($P($G(ABMB9),U,22))) Q  ;abm*2.6*8  ;abm*2.6*11 HEAT85498
  1.  ..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)="" Q  ;abm*2.6*11 HEAT85498
  1.  ..I ($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)=($P($G(ABMB9),U,22))) Q  ;abm*2.6*11 HEAT85498
  1.  ..D EP^ABME5REF("X4","1SV","1SV")
  1.  ..Q:$G(ABMR("REF",30))=""  ;abm*2.6*9 HEAT64640
  1.  ..D WR^ABMUTL8("REF")
  1.  .I $G(ABMOUTLB)=1 D  ;if reference lab
  1.  ..;I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,14)'="",($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,14)=($P($G(ABMB9),U,23))) Q  ;abm*2.6*10 HEAT72789
  1.  ..D EP^ABME5REF("F4",1,1)
  1.  ..D WR^ABMUTL8("REF")
  1.  ;D EP^ABME5REF("BT")  ;immunization batch number
  1.  ;D WR^ABMUTL8("REF")
  1.  ;Loop 2410 - Drug Identification
  1.  S ABMLOOP=2410
  1.  I ABMI=23 D
  1.  .I $P($P(ABMRV(ABMI,ABMJ,ABMK),U,9)," ")'="" D
  1.  ..D EP^ABME5LIN
  1.  ..D WR^ABMUTL8("LIN")
  1.  .I +$P(ABMRV(ABMI,ABMJ,ABMK),U,5)!($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,14)="Y") D  ;abm*2.6*22 IHS/SD/SDR HEAT335246
  1.  ..D EP^ABME5CTP
  1.  ..D WR^ABMUTL8("CTP")
  1.  .;I $P(ABMRV(ABMI,ABMJ,ABMK),U,13)'="" D  ;abm*2.6*10 HEAT78446
  1.  .I $P(ABMRV(ABMI,ABMJ,ABMK),U,28)'="" D  ;abm*2.6*10 HEAT78446
  1.  ..;D EP^ABME5REF("XZ",$P(ABMRV(ABMI,ABMJ,ABMK),U,13))  ;abm*2.6*10 HEAT78446
  1.  ..D EP^ABME5REF("XZ",$P(ABMRV(ABMI,ABMJ,ABMK),U,28))  ;abm*2.6*10 HEAT78446
  1.  ..D WR^ABMUTL8("REF")
  1.  ;start new abm*2.6*23 IHS/SD/AML HEAT247169
  1.  ;add NDC for page 8H
  1.  I ABMI=43 D
  1.  .I $P(ABMRV(ABMI,ABMJ,ABMK),U,19)'="" D
  1.  ..D EP^ABME5LIN
  1.  ..D WR^ABMUTL8("LIN")
  1.  ..D EP^ABME5CTP
  1.  ..D WR^ABMUTL8("CTP")
  1.  ;end new abm*2.6*23 IHS/SD/AML HEAT247169
  1.  ;
  1.  ; Loop 2420A - Rendering Physician
  1.  S ABMLOOP="2420A"
  1.  ;I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,13) D  ;abm*2.6*9 NOHEAT
  1.  I ((ABMI'=23&$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,13))!(ABMI=23&$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,22))) D  ;abm*2.6*9 NOHEAT
  1.  .Q:$G(ABMP("VTYP"))=831&($G(ABMP("ITYPE"))="R")  ;don't write provider info for ASC
  1.  .Q:$G(ABMP("CLIN"))="A3"
  1.  .;S ABM("PRV")=$P(ABMRV(ABMI,ABMJ,ABMK),U,13)  ;abm*2.6*9 NOHEAT
  1.  .S ABM("PRV")=$S(ABMI'=23:$P(ABMRV(ABMI,ABMJ,ABMK),U,13),1:$P(ABMRV(ABMI,ABMJ,ABMK),U,22))  ;abm*2.6*9 NOHEAT
  1.  .Q:ABM("PRV")=$O(ABMP("PRV","D",0))
  1.  .Q:$D(ABMP("PRV","A",ABM("PRV")))!($D(ABMP("PRV","R",ABM("PRV"))))
  1.  .D EP^ABME5NM1(82,ABM("PRV"))
  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))
  1.  .;Q:((ABMRCID="99999")!(ABMRCID="AHCCCS866004791"))  ;AZ Medicaid
  1.  .;D WR^ABMUTL8("REF")
  1.  ;
  1.  ; Loop 2420B - Purchased Service Physician Name
  1.  S ABMLOOP="2420B"
  1.  ;abm*2.6*25 IHS/SD/SDR 12/18/17 - note about below code.  Should be changed from p19 since that is being used for something else.
  1.  ;  that is what is causing the error to occur, but we don't capture a purchased service provider at this time.
  1.  ;I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,19) D  ;abm*2.6*25 IHS/SD/SDR CR10008
  1.  ;.S ABM("PRV")=$P(ABMRV(ABMI,ABMJ,ABMK),U,19)
  1.  ;.Q:ABM("PRV")=$O(ABMP("PRV","P",0))
  1.  ;.D EP^ABME5NM1("QB",ABM("PRV"))
  1.  ;.D WR^ABMUTL8("NM1")
  1.  ;.;D EP^ABME5REF("EI",9999999.06,DUZ(2))
  1.  ;.;D WR^ABMUTL8("REF")
  1.  ;
  1.  ; Loop 2420C - Service Facility Location
  1.  S ABMLOOP="2420C"
  1.  I $G(ABMOUTLB)=1 D  ;reference lab
  1.  .S ABMOTLBN=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0),"^",14)
  1.  .I $G(ABMOTLBN)'="" D
  1.  ..D EP^ABME5NM1(77,ABMOTLBN)
  1.  ..D WR^ABMUTL8("NM1")
  1.  ..D EP^ABME5N3(9002274.35,ABMOTLBN)
  1.  ..D WR^ABMUTL8("N3")
  1.  ..D EP^ABME5N4(9002274.35,ABMOTLBN)
  1.  ..D WR^ABMUTL8("N4")
  1.  ;
  1.  ; Loop 2420D - Supervising Physician Name
  1.  S ABMLOOP="2420D"
  1.  I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,20) D
  1.  .S ABM("PRV")=$P(ABMRV(ABMI,ABMJ,ABMK),U,20)
  1.  .Q:ABM("PRV")=$O(ABMP("PRV","S",0))
  1.  .D EP^ABME5NM1("DQ",ABM("PRV"))
  1.  .D WR^ABMUTL8("NM1")
  1.  .;D EP^ABME5REF("EI",9999999.06,DUZ(2))
  1.  .;D WR^ABMUTL8("REF")
  1.  ;
  1.  ; Loop 2420E - Ordering Physician Name
  1.  S ABMLOOP="2420E"
  1.  I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,21) D
  1.  .S ABM("PRV")=$P(ABMRV(ABMI,ABMJ,ABMK),U,21)
  1.  .;NOTE:below line was added for patch 10 but removed during testing because site was
  1.  .;reporting payer was requiring it
  1.  .S ABMLOOP="2420E"
  1.  .D EP^ABME5NM1("DK",ABM("PRV"))
  1.  .D WR^ABMUTL8("NM1")
  1.  .D EP^ABME5N3(200,ABM("PRV"))
  1.  .D WR^ABMUTL8("N3")
  1.  .D EP^ABME5N4(200,ABM("PRV"))
  1.  .D WR^ABMUTL8("N4")
  1.  .;D EP^ABME5REF("EI",9999999.06,DUZ(2))
  1.  .;D WR^ABMUTL8("REF")
  1.  .K ABMLOOP
  1.  ;
  1.  ; Loop 2420F Referring Provider Name
  1.  S ABMLOOP="2420F"
  1.  I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,18) D
  1.  .S ABM("PRV")=$P(ABMRV(ABMI,ABMJ,ABMK),U,18)
  1.  .Q:ABM("PRV")=$O(ABMP("PVR","F",0))
  1.  .D EP^ABME5NM1("DN",ABM("PRV"))
  1.  .D WR^ABMUTL8("NM1")
  1.  .;D EP^ABME5REF("EI",9999999.06,DUZ(2))
  1.  .;D WR^ABMUTL8("REF")
  1.  Q