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

ABMDE4X.m

Go to the documentation of this file. 
  1. ABMDE4X ; IHS/SD/SDR - Edit Page 4 - Providers DATA CK ; 11 Sep 2012  9:33 AM
  1.  ;;2.6;IHS Third Party Billing;**1,3,8,9,10,11**;NOV 12, 2009;Build 133
  1.  ;
  1.  ; IHS/DSD/LSL - 05/20/98 - NOIS HQW-0598-100109
  1.  ;               Modified to check file 200, payer assigned provider
  1.  ;               number, first on dental form
  1.  ; IHS/ASDS/LSL - 10/21/01 - V2.4 Patch 9
  1.  ;     Display Medicare part B pin number on page 4 if professional
  1.  ;     component, medicare insurer type and mode of export contain
  1.  ;     HCFA-1500.  If the above are true and no pin number, set errror
  1.  ;     189.
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p5 - 5/17/2004 - IM12881 - Made change to display
  1.  ;     provider number correctly
  1.  ; IHS/SD/SDR - v2.5 p8 - IM14693/IM16105
  1.  ;    Added code to check error 190 for export mode 25
  1.  ; IHS/SD/SDR - v2.5 p9 - IM19302
  1.  ;   Correction to error 170
  1.  ; IHS/SD/SDR - v2.5 p9 - IM16942
  1.  ;   For OK Medicaid - if VT 999 - print payer assigned provider#
  1.  ;                     if not VT 999-PIN# from Insurer file
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20310
  1.  ;   Update 170 error check to check Payer Assigned Provider Number
  1.  ;   for Medicare
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20776
  1.  ;   Made change to 190 error to check for Rendering provider
  1.  ; IHS/SD/SDR - v2.5 p11 - NPI
  1.  ; IHS/SD/SDR - abm*2.6*1 - NO HEAT - remove error 189 if NPI ONLY
  1.  ; IHS/SD/SDR - abm*2.6*3 - HEAT12442 - made error 92 display for all 837s
  1.  ; 
  1.  ; *********************************************************************
  1.  ;
  1. PROV ; Provider Info
  1. ERR S ABME("TITL")="PAGE 4 - PROVIDER INFORMATION"
  1.  K ABM("A"),ABM("O")
  1.  I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"B",0))=0 S ABME(244)=""  ;abm*2.6*11 HEAT81017
  1.  S ABM=""
  1.  F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM)) Q:ABM=""  D
  1.  .S ABM("X")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM,0))
  1.  .S ABM("NUM")=ABM("I")
  1.  .D SEL
  1.  I '$D(ABM("A")) D
  1.  .;Q:ABMP("EXP")=22  ;abm*2.6*3 HEAT12442  ;abm*2.6*9 HEAT57734
  1.  .Q:ABMP("EXP")=22!(ABMP("EXP")=32)  ;abm*2.6*3 HEAT12442  ;abm*2.6*9 HEAT57734
  1.  .S ABME(92)=""
  1. OP I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O")),$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0)),ABMP("PAGE")'[8 S ABME(2)=""
  1.  I ABMP("EXP")=2!(ABMP("EXP")=3)!(ABMP("EXP")=14),$P(^ABMDPARM(DUZ(2),1,0),U,17)=2 K ABME
  1.  K ABM
  1.  Q
  1.  ;
  1. SEL ;EP - Entry Point for select provider, Claim File Error Check
  1.  S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABM("X"),0) G GET
  1. SELBILL ;EP - Entry Point for Bill file provider error check
  1.  ;
  1.  ;  input var: ABM(X) = the IEN of the Provider for the Bill
  1.  ;
  1.  ;  output var: ABM("A") - attending name ^ Prv IEN ^ Claim IEN
  1.  ;              ABM("O") - operating name ^ Prv IEN ^ Claim IEN
  1.  ;              ABM("PNUM") - provider number
  1.  ;              ABM("DISC") - provider discipline
  1.  ;
  1.  S ABM("X0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABM("X"),0),ABMP("C0")=ABMP("B0")
  1.  ;
  1. GET S (ABM("DISC"),ABM("PNUM"))=""
  1.  Q:$P(ABM("X0"),U,2)=""
  1.  I '$D(^VA(200,$P(ABM("X0"),U),0)) S ABME(119)="DFN:"_$P(ABM("X0"),U) Q
  1.  S ABM($P(ABM("X0"),U,2))=$P(^VA(200,$P(ABM("X0"),U),0),U)_U_$P(ABM("X0"),U)_U_ABM("X")
  1.  S ABM("DISC")=$P($G(^VA(200,$P(ABM("X0"),U),"PS")),U,5)
  1.  I ABM("DISC")]"",$D(^DIC(7,ABM("DISC"),0)) S ABM("DISC")=$E($P(^(0),U),1,30)
  1.  E  S ABME(118)=""
  1. DR ;PHYSICIAN'S PROVIDER NUMBER
  1.  S ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
  1.  I ABMNPIUS="N",($P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)<0)&($P($$NPI^XUSNPI("Organization_ID",+ABMP("LDFN")),U)<0) S ABME(220)=""
  1.  I ABMNPIUS="B",($P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)<0)&($P($$NPI^XUSNPI("Organization_ID",+ABMP("LDFN")),U)<0) S ABME(221)=""
  1.  I (ABMNPIUS="N"!(ABMNPIUS="B")),($P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)<0)&($P($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)>0) S ABME(232)=""
  1.  I '$D(ABMP("CDFN")),$D(ABMP("BDFN")) S ABMP("CDFN")=+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U)
  1.  I +ABMP("CDFN") D  Q:$D(ABME(189))
  1.  .S:ABMP("VTYP")="" ABMP("VTYP")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,7)
  1.  .S:ABMP("INS")="" ABMP("INS")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,8)
  1.  .;S:ABMP("INS")'="" ABMP("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U)  ;abm*2.6*10 HEAT73780
  1.  .S:ABMP("INS")'="" ABMP("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")  ;abm*2.6*10 HEAT73780
  1.  .S:ABMP("EXP")="" ABMP("EXP")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,14)
  1.  .S:ABMP("LDFN")="" ABMP("LDFN")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,3)
  1.  .;start old code abm*2.6*9 NOHEAT
  1.  .;I ABMP("VTYP")=999 D
  1.  .;.I $G(ABMP("ITYP"))="R" D  ;abm*2.6*1 NOHEAT
  1.  .;.;I $G(ABMP("ITYP"))="R",(ABMNPIUS'="N") D  ;abm*2.6*1 NOHEAT
  1.  .;..I +ABMP("EXP"),(($P($G(^ABMDEXP(+ABMP("EXP"),0)),U)["HCFA")!($P($G(^ABMDEXP(+ABMP("EXP"),0)),U)["CMS")) D
  1.  .;...S ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
  1.  .;...S:ABM("PNUM")="" ABME(189)=""
  1.  .;.I $P(^AUTNINS(ABMP("INS"),0),U)["OKLAHOMA MEDICAID" D
  1.  .;..S ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
  1.  .;end old start new abm*2.6*9
  1.  .I $G(ABMP("ITYP"))="R",ABMP("VTYP")=999 D
  1.  ..I +ABMP("EXP"),(($P($G(^ABMDEXP(+ABMP("EXP"),0)),U)["HCFA")!($P($G(^ABMDEXP(+ABMP("EXP"),0)),U)["CMS")) D
  1.  ...S ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
  1.  ...S:ABM("PNUM")="" ABME(189)=""
  1.  .I $P(^AUTNINS(ABMP("INS"),0),U)["OKLAHOMA MEDICAID" D
  1.  ..S ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
  1.  ;end new ABM*2.6*9
  1.  I $G(ABM("PNUM"))="" D
  1.  .S ABM("PNUM")=$P($G(^VA(200,+ABM("X0"),9999999.18,+ABMP("INS"),0)),"^",2)
  1.  I ABM("PNUM")="" D
  1.  .;I $P($G(^AUTNINS(+ABMP("INS"),2)),U)="R" D  ;abm*2.6*10 HEAT73780
  1.  .I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="R" D  ;abm*2.6*10 HEAT73780
  1.  ..S ABM("PNUM")=$P($G(^VA(200,+ABM("X0"),9999999)),U,6)
  1.  ..S:ABM("PNUM")="" ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
  1.  ..I ABM("PNUM")="" S ABME(170)=""
  1.  ..S:ABM("PNUM")="" ABM("PNUM")=$P($G(^VA(200,+ABM("X0"),9999999)),"^",8)
  1.  ..S:ABM("PNUM")="" ABM("PNUM")="PHS000"
  1.  .;I $P($G(^AUTNINS(+ABMP("INS"),2)),U)="D" D  ;IHS/SD/SDR 9/25/09
  1.  .;I $P($G(^AUTNINS(+ABMP("INS"),2)),U)="D",(ABMNPIUS'="N") D  ;IHS/SD/SDR 9/25/09  ;abm*2.6*10 HEAT73780
  1.  .I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")="D",(ABMNPIUS'="N") D  ;IHS/SD/SDR 9/25/09  ;abm*2.6*10 HEAT73780
  1.  ..S ABM("PNUM")=$P($G(^VA(200,+ABM("X0"),9999999)),U,7)
  1.  ..S:ABM("PNUM")="" ABME(170)=""
  1.  I ABM("PNUM")="",(ABMNPIUS'="N") D
  1.  .S ABM("ST")=$P(ABMP("C0"),U,3)
  1.  .S ABM("ST")=$P($G(^AUTTLOC(+ABM("ST"),0)),U,23)
  1.  .S:ABM("ST")="" ABM("ST")=$P($G(^AUTTLOC(+ABM("ST"),0)),U,14)
  1.  .I ABM("ST")="" S ABME(120)=""
  1.  .S ABM("PNUM")=$$SLN^ABMERUTL(+ABM("X0"),ABM("ST"))
  1.  S:ABM("PNUM")="" ABM("PNUM")=$P($G(^VA(200,+ABM("X0"),9999999)),U,8)
  1.  I ABM("PNUM")="",(ABMNPIUS'="N") S ABME(115)=""
  1.  ;
  1. COV ;
  1.  I $P(^ABMDEXP(ABMP("EXP"),0),U)[837!($G(ABMP("EXP"))=25) D
  1.  .Q:'("OAR"[$P(ABM("X0"),U,2))
  1.  .Q:$$PTAX^ABMEEPRV(+ABM("X0"))'=""
  1.  .S ABME(190)=""
  1.  Q:$G(ABMP("COV"))=""
  1.  Q:$G(ABM("DISC"))=""
  1.  F ABMX("C")=1:1 S ABM("COVD")=$P(ABMP("COV"),";",ABMX("C")) Q:'ABM("COVD")  D
  1.  .S ABM("COVD")=$P($G(^VA(200,$P(ABM("X0"),U),"PS")),U,5)
  1.  .Q:$P($G(^AUTTPIC(ABMP("COV"),15,ABM("COVD"),0)),"^",2)'="U"
  1.  .S ABME(160)=""
  1.  Q
  1.  ;
  1. CONTR ;EP - Entry Point to determine if Contract Provider
  1.  S:'$D(ABMP("CDFN")) ABMP("CDFN")=ABMP("BDFN")
  1.  S ABM("CONTRACT")=0
  1.  S ABMX("D")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","A","")) I ABMX("D")]"",$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABMX("D"),0)),$P($G(^VA(200,$P(^(0),U),9999999)),U)=2 S ABM("CONTRACT")=1 Q
  1.  S ABMX("D")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O","")) I ABMX("D")]"",$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABMX("D"),0)),$P($G(^VA(200,$P(^(0),U),9999999)),U)=2 S ABM("CONTRACT")=1
  1.  Q
  1.  ;
  1. AFFL ;EP - Entry Point to determine Provider's Affiliation
  1.  Q:ABM("MD")  Q:$P($G(^VA(200,+ABM("X0"),"PS")),U,5)=""  Q:$P($G(^DIC(7,$P(^("PS"),U,5),9999999)),U)=""  S ABM("MD")=$P(^(9999999),U)
  1.  S ABM("MD")=$S(ABM("MD")="00"!(ABM("MD")>69&(ABM("MD")<87))!(ABM("MD")=49)!(ABM("MD")=18)!(ABM("MD")=25)!(ABM("MD")=33)!(ABM("MD")=41)!(ABM("MD")=44)!(ABM("MD")=45):1,1:0)
  1.  Q