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

ABMDF34A.m

Go to the documentation of this file. 
  1. ABMDF34A ; IHS/SD/SDR - ADA 2012 Dental Export -part 2 ;    
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**11**;NOV 12, 2009;Build 133
  1.  ;********************************************
  1. ENT ; EP for getting data
  1.  S ABMP("B0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)  ;3P Bill 0 node
  1.  S ABMP("INS")=$P(ABMP("B0"),U,8)  ;Active ins
  1.  S ABMP("PDFN")=$P(ABMP("B0"),U,5)  ;Pt IEN
  1.  S ABMP("LDFN")=$P(ABMP("B0"),U,3)  ;Loc IEN
  1.  S ABMP("VTYP")=$P(ABMP("B0"),U,7)  ;VTyp
  1.  S ABMP("BTYP")=$P(ABMP("B0"),U,2)  ;BTyp
  1.  Q:'ABMP("PDFN")!'ABMP("LDFN")!'ABMP("INS")
  1.  S ABMP("VDT")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U)  ;Vst Dt
  1. BADDR ;
  1.  ; Billing Addr
  1.  S ABM("J")=ABMP("BDFN")
  1.  S ABM("I")=$P(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")
  1.  S ABM("INS",ABM("I"),ABM("J"))=""
  1.  I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="N" D
  1.  .S ABM("INS",ABM("I"),ABM("J"))=ABMP("PDFN")
  1.  S ABM("IDFN")=ABMP("INS")
  1.  D BADDR^ABMDLBL1
  1.  G PAT:'$D(ABM("ADD"))
  1.  S ABMF(7)=$P(ABM("ADD"),U,1)  ;Ins Name(3)
  1.  S ABMF(8)=$P(ABM("ADD"),U,2)  ;Ins Addr(3)
  1.  S ABMF(9)=$P(ABMCSZ,U)  ;City(3)
  1.  S ABMSTATE=$P(ABMCSZ,U,2)  ;St(3)
  1.  S ABMF(9)=ABMF(9)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2)
  1.  S ABMF(9)=ABMF(9)_"  "_$P(ABMCSZ,U,3)  ;Zip(3)
  1.  K ABMCSZ,ABMSTATE
  1.  ;2ndary info
  1.  S ABMPIIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"B",ABMP("INS"),0))
  1.  K ABMSCNT,ABMSINS,ABMP("INS2")
  1.  I +$G(ABMPIIEN)'=0 D
  1.  .S ABMPINS=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMPIIEN,0)),U,2)  ;get priority of active ins
  1.  .S ABMIFLG=0
  1.  .S ABMSCNT=ABMPINS
  1.  .F  S ABMSCNT=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABMSCNT)) Q:+ABMSCNT=0  D  Q:ABMIFLG=1
  1.  ..S ABMSINS=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABMSCNT,0))
  1.  ..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,3)="U" K ABMSINS Q  ;unbillable
  1.  ..S ABMIFLG=1
  1.  I $G(ABMSINS)'="" S ABMP("INS2")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U)
  1.  I $G(ABMP("INS2"))'="" D
  1.  .S ABMPISAV=ABMP("INS")
  1.  .S ABMP("INS")=ABMP("INS2")
  1.  .S ABM("J")=ABMP("BDFN")
  1.  .S ABM("I")=$P(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")
  1.  .S ABM("INS",ABM("I"),ABM("J"))=""
  1.  .I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="N" D
  1.  ..S ABM("INS",ABM("I"),ABM("J"))=ABMP("PDFN")
  1.  .S ABM("IDFN")=ABMP("INS")
  1.  .D BADDR^ABMDLBL1
  1.  .G PAT:'$D(ABM("ADD"))
  1.  .S $P(ABMF(20),U)=$P(ABM("ADD"),U,1)  ;2ndary Name(11)
  1.  .S $P(ABMF(21),U)=$P(ABM("ADD"),U,2)  ;2ndary Addr(11)
  1.  .S $P(ABMF(22),U)=$P(ABMCSZ,U)  ;2ndary City(11)
  1.  .S ABMSTATE=$P(ABMCSZ,U,2)  ;2ndary ST(11)
  1.  .S $P(ABMF(22),U)=$P(ABMF(22),U)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2)  ;2ndary ST(11)
  1.  .S $P(ABMF(22),U)=$P(ABMF(22),U)_"  "_$P(ABMCSZ,U,3)  ;2ndary Zip(11)
  1.  .K ABMCSZ,ABMSTATE
  1.  .S ABMP("INS")=ABMPISAV
  1.  .;2ndary grp#(9)
  1.  .I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,4) S ABMX("PH")=ABMP("PDFN")
  1.  .I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,5) S ABMX("PH")=ABMP("PDFN")
  1.  .I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,6) S ABMX("PH")=$P($G(^AUPNMCD($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,6),0)),U,9)
  1.  .I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,8),($P($G(^AUPNPRVT(ABMP("PDFN"),11,$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,8),0)),U,8)'="") D
  1.  ..S ABMX("PH")=$P(^AUPNPRVT(ABMP("PDFN"),11,$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,8),0),U,8)
  1.  .I +$G(ABMX("PH"))'=0 D
  1.  ..S ABMX("GRP")=$P($G(^AUPN3PPH(+ABMX("PH"),0)),U,6)
  1.  ..I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="M" S $P(ABMF(16),U,2)="X"  ;sex(7)
  1.  ..I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="F" S $P(ABMF(16),U,3)="X"  ;sex(7)
  1.  ..S $P(ABMF(16),U,4)=$P($G(^AUPN3PPH(+ABMX("PH"),0)),U,4)  ;Pol#(8)
  1.  ..;rel (10)
  1.  ..I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS2"),".211","I"),1,"I")="P" D
  1.  ...S ABMSINS=$O(^AUPNPRVT(ABMP("PDFN"),11,"B",ABMP("INS2"),0))
  1.  ...S ABMP("REL")=$P($G(^AUTTRLSH($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMSINS,0)),U,5),0)),U,5)
  1.  ...I ABMP("REL")=17 S $P(ABMF(18),U,2)="X"
  1.  ...I ABMP("REL")="01" S $P(ABMF(18),U,3)="X"
  1.  ...I ABMP("REL")=18 S $P(ABMF(18),U,4)="X"
  1.  ...I ABMP("REL")'=17&(ABMP("REL")'=18)&(ABMP("REL")'="01") S $P(ABMF(18),U,5)="X"
  1.  .I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS2"),".211","I"),1,"I")="D" D
  1.  ..I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="M" S $P(ABMF(16),U,2)="X"  ;sex(7)
  1.  ..I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="F" S $P(ABMF(16),U,3)="X"  ;sex(7)
  1.  ..S:(+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,6)'=0) $P(ABMF(16),U,4)=$P($G(^AUPNMCD($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,6),0)),U,3)  ;Policy#(8)
  1.  ..S $P(ABMF(18),U,2)="X"  ;rel.(10)
  1.  .I $G(ABMX("GRP"))'="" D
  1.  ..I $D(^AUTNEGRP(ABMX("GRP"),0)) D
  1.  ...S $P(ABMF(18),U)=$S($D(^AUTNEGRP(ABMX("GRP"),11,ABMP("VTYP"),0)):$P(^(0),U,2),1:$P(^AUTNEGRP(ABMX("GRP"),0),U,2))
  1. PAT ;Pt Info
  1.  D PAT^ABMDF34B
  1. LOC ;loc info
  1.  S $P(ABMF(54),U)=$S($P(ABMV("X1"),U,2)]"":$P(ABMV("X1"),U,2),1:$P($P(ABMV("X1"),U),";",2))  ;billing entity name(48)
  1.  S $P(ABMF(55),U)=$P(ABMV("X1"),U,3)  ;addr(48)
  1.  I DUZ(2)=1581 S $P(ABMF(55),U)="PO BOX 4342"
  1.  S ABMCSZ=$P(ABMV("X1"),U,4)
  1.  S $P(ABMF(56),U)=$P(ABMCSZ,",",1)  ;City(48)
  1.  S ABMCSZ=$P(ABMCSZ,",",2)
  1.  S $P(ABMF(56),U)=$P(ABMF(56),U)_", "_$P(ABMCSZ," ",2)  ;ST(48)
  1.  S $P(ABMF(56),U)=$P(ABMF(56),U)_"  "_$P(ABMCSZ," ",4)  ;zip(48)
  1.  I DUZ(2)=1581 S $P(ABMF(56),U)="San Felipe Pueblo, NM  87001"
  1.  ;
  1.  I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" D
  1.  .S $P(ABMF(55),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U)  ;addr(48)
  1.  .S $P(ABMF(56),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3)  ;city(48)
  1.  .S ABMX("STATE")=$P($G(^DIC(4,ABMP("LDFN"),0)),U,2)  ;st(48)
  1.  .S ABMX("STATE")=$P($G(^DIC(5,+ABMX("STATE"),0)),U,2)
  1.  .I ABMX("STATE")'="" D
  1.  ..S $P(ABMF(56),U)=$P(ABMF(56),U)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4)  ;zip(48)
  1.  .I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
  1.  ..S $P(ABMF(55),U)="P.O. Box 31001-0674"  ;addr(48)
  1.  ..S $P(ABMF(56),U)="Pasadena, CA  91110-0674"  ;city(48)
  1.  K ABMCSZ
  1.  S $P(ABMF(59),U,3)=$P(ABMV("X1"),U,6)  ;SSN/TIN(51)
  1.  I DUZ(2)=1581 S $P(ABMF(59),U,3)="850210848"
  1.  S $P(ABMF(60),U,1)=$P(ABMV("X1"),U,5)  ;Phone(52)
  1.  S $P(ABMF(60),U,1)=$P(ABMV("X1"),U,5)  ;Phone(52)
  1.  S ABMLOC=$P(ABMP("B0"),U,3)
  1.  S ABMV("X1")=$G(^AUTTLOC(ABMLOC,0))
  1.  S $P(ABMF(58),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U)  ;addr(56)
  1.  S $P(ABMF(59),U,4)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3)  ;city(56)
  1.  S ABMX("STATE")=$P($G(^DIC(4,ABMP("LDFN"),0)),U,2)  ;st(56)
  1.  S ABMX("STATE")=$P($G(^DIC(5,+ABMX("STATE"),0)),U,2)
  1.  I ABMX("STATE")'="" D
  1.  .S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4)  ;zip(56)
  1.  I $P(ABMF(58),U)="" D  ;default to mailing addr if no physical addr
  1.  .S $P(ABMF(58),U)=$P(ABMV("X1"),U,12)  ;addr(56)
  1.  .S $P(ABMF(59),U,4)=$P(ABMV("X1"),U,13)  ;city(56)
  1.  .S ABML=$P(ABMV("X1"),U,14)
  1.  .S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_", "_$P(^DIC(5,ABML,0),U,2)  ;st(56)
  1.  .S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_"  "_$P(ABMV("X1"),U,15)  ;zip(56)
  1.  S ABMLNPI=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$P(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
  1.  S $P(ABMF(59),U)=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")  ;Location NPI (49)
  1.  I DUZ(2)=1581 S $P(ABMF(59),U)="1265511299"
  1.  I ABMP("LDFN")=5440 D  ;Klamath
  1.  .S $P(ABMF(58),U)="330 Chiloquin BLVD"  ;addr(56)
  1.  .S $P(ABMF(59),U,4)="Chiloquin"  ;city(56)
  1.  .S ABMX("STATE")="Oregon"  ;st(56)
  1.  .S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_", "_ABMX("STATE")_" 97624"  ;zip(56)
  1. INSNUM ;Ins Info
  1.  S ABM("INUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$P(ABMP("B0"),U,7),0)),U,8)
  1.  S:ABM("INUM")="" ABM("INUM")=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),U,2)
  1.  I ABM("INUM")="" D
  1.  .S ABMPRV=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
  1.  .S:ABMPRV ABMPRV=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRV,0)),U)
  1.  .S:ABMPRV ABM("INUM")=$P($G(^VA(200,ABMPRV,9999999.18,ABMP("INS"),0)),U,2)
  1.  S $P(ABMF(59),U,2)=ABM("INUM")  ;Dent Lic(55)
  1.  S ABMP("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")  ;Ins.type
  1.  I ABMP("ITYP")="D" D
  1.  .S ABMMCD=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMP("INS"),0)),U,6)
  1. PRV ;Prov?
  1.  D PRV^ABMDF34B
  1. POL ;Pol. Info
  1.  D POL^ABMDF34B
  1. EMPL ;Emp. info
  1.  I ABMP("ITYP")'="P" S $P(ABMF(12),U,4)=$P(ABMV("X3"),U)  ;Employer name(17)
  1.  E  D
  1.  .S ABMP("PH")=$P(ABMV("X2"),U)
  1.  .S ABMEMPL=$P($G(^AUPN3PPH(+ABMP("PH"),0)),U,16)
  1.  .S:+ABMEMPL $P(ABMF(12),U,4)=$P($G(^AUTNEMPL(ABMEMPL,0)),U)
  1.  S $P(ABMF(12),U,3)=$P(ABMV("X3"),U,7)  ;Grp#(16)
  1. REL ;Rel
  1.  G INS:'$P(ABMV("X2"),U,2)
  1.  S ABM=+$P($G(^AUTTRLSH(+$P(ABMV("X2"),U,2),0)),U,2)
  1.  I ABM,ABM<8,ABM'=2 S $P(ABMF(15),U,$S(ABM=1:1,ABM=3:3,1:4))="X"  ;Rel to subscbr(18)
  1.  E  S $P(ABMF(15),U,$S(ABM=2:2,ABM=1:1,1:4))="X"
  1. INS ;
  1.  D ^ABMDF34B
  1. XIT ;
  1.  K ABM,ABMV
  1.  Q