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

ABMDF34B.m

Go to the documentation of this file. 
  1. ABMDF34B ; IHS/SD/SDR - ADA 2012 Dental Export -part 3 ;    
  1.  ;;2.6;IHS Third Party Billing;**11,13,21**;NOV 12, 2009;Build 379
  1.  ;IHS/SD/SDR - 2.6*13 - VMBP RQMT_95 - Updated to put VA STATION NUMBER in box 2.
  1.  ;
  1. INS ;Ins Info
  1.  S ABM("I")=0
  1.  F  S ABM("I")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I"))) Q:'ABM("I")  D
  1.  .S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I"),0))
  1.  .S ABM=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM,0),U)
  1.  .I ABM'=ABMP("INS") D  Q
  1.  ..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM,0)),U,3)="U" Q
  1.  ..S ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM,".211","I"),1,"I")
  1.  ..I ABMITYP="N"!(ABMITYP="I") Q  ;ben/non-ben don't count
  1.  ..S Y=ABM
  1.  ..S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
  1.  ..D SEL^ABMDE2X
  1.  ..Q:$G(ABMP("INS2"))=""
  1.  ..S $P(ABMF(14),U)=$P($P(ABMV("X2"),U),";",2)  ;(5)
  1.  ..S $P(ABMF(16),U)=$P(ABMV("X2"),U,7)  ;(6)
  1.  ..I ABMITYP="P" D
  1.  ...S ABMPIEN=$O(^AUPNPRVT(ABMP("PDFN"),11,"B",ABMP("INS2"),0))
  1.  ...Q:+ABMPIEN=0
  1.  ...S $P(ABMF(14),U)=$P($G(^AUPN3PPH($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMPIEN,0)),U,8),0)),U)  ;(5)
  1.  ...S $P(ABMF(16),U)=$P($G(^AUPN3PPH($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMPIEN,0)),U,8),0)),U,19)  ;(6)
  1.  ..I ABMITYP="D" D
  1.  ...S $P(ABMF(14),U)=$P($G(^DPT(ABMP("PDFN"),0)),U)  ;(5)
  1.  ...S $P(ABMF(16),U)=$P($G(^DPT(ABMP("PDFN"),0)),U,3)  ;(6)
  1.  ..I $$GET1^DIQ(9999999.18,ABMP("INS2"),".25","I")="" S $P(ABMF(12),U,2)="X"  ;Other Coverage (Medical) (4)
  1.  ..I $$GET1^DIQ(9999999.18,ABMP("INS2"),".25","I")="O" S $P(ABMF(12),U)="X"  ;Other Coverage (Dental) (4)
  1.  S $P(ABMF(1),U)="X"  ;stmt/actual svcs (1)
  1.  I $P($G(^AUTNINS(ABMP("INS"),2)),"^")="D"&($P($G(^ABMDVTYP(ABMP("VTYP"),0)),U)["EPSDT") S $P(ABMF(2),U)="X"  ;EPSDT/Title 19(1)
  1. BNODES ; Bill nodes
  1.  I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)) D
  1.  .S ABM("B4")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4))
  1.  .S ABM("B5")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),5))
  1.  .S ABM("B7")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7))
  1.  .S ABM("B8")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8))
  1.  .S ABM("B9")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9))
  1.  S $P(ABMF(4),U)=$P(ABM("B5"),U,12)  ;Prior Auth(2)
  1.  ;start new code abm*2.6*13 VMBP RQMT_95
  1.  I ((ABMP("ITYP")="V")!($P($G(^AUTNINS(ABMP("INS"),0)),U)["VMBP"))&($P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)'="") D
  1.  .S $P(ABMF(4),U)=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)  ;VA station# (2)
  1.  .S ABMF(41)=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)  ;VA contract# (35)
  1.  ;end new code VMBP RQMT_95
  1.  I $P(ABM("B9"),U)]"" S $P(ABMF(49),U,3)="X"  ;Occup. illness(45)
  1. ACCD ;Accident?
  1.  I $P(ABM("B8"),U,3)'="" D
  1.  .I "12"[$P(ABM("B8"),U,3) D  Q
  1.  ..S $P(ABMF(49),U,4)="X"  ;auto accident(45)
  1.  ..S $P(ABMF(50),U)=$P(ABM("B8"),U,2)  ;acc. dt(46)
  1.  ..S $P(ABMF(50),U,2)=$P($G(^DIC(5,$P(ABM("B8"),U,16),0)),"^",2)  ;acc. st(47)
  1.  .I "5"[$P(ABM("B8"),U,3) D  Q
  1.  ..S $P(ABMF(49),U,5)="X"  ;other accident(45)
  1.  .S $P(ABMF(50),U)=$P(ABM("B8"),U,2)   ;acc. dt(46)
  1.  .S $P(ABMF(50),U,2)=$P($G(^DIC(5,$P(ABM("B8"),U,16),0)),"^",2)  ;acc. st(47)
  1. FSYM I $P(ABM("B7"),U,4)="Y" D  ;ROI
  1.  .S $P(ABMF(45),U)="SIGNATURE ON FILE"  ;(36)
  1.  .S $P(ABMF(45),U,2)=$P(ABM("B7"),U,11)  ;(36)
  1.  I $P(ABM("B7"),U,5)="Y" D  ;AOB
  1.  .S $P(ABMF(49),U)="SIGNATURE ON FILE"  ;(37)
  1.  .S $P(ABMF(49),U,2)=$S($G(ABMP("PRINTDT"))="O":$P($G(^ABMDTXST(DUZ(2),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7),0)),U),$G(ABMP("PRINTDT"))="A":$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,5),1:DT)  ;(37)
  1.  I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" S $P(ABMF(49),U,2)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,12)
  1.  S $P(ABMF(42),U)=$$POS^ABMERUTL  ;Place of Treatment (38)
  1.  I (+$P($G(ABM("B4")),U,3)+$P($G(ABM("B9")),U,18)+$P($G(ABM("B9")),U,19))'=0 S $P(ABMF(43),U)="Y"  ;Enclosures (39)
  1.  I (+$P($G(ABM("B4")),U,3)+$P($G(ABM("B9")),U,18)+$P($G(ABM("B9")),U,19))=0 S $P(ABMF(43),U)="N"  ;Enclosures (39)
  1. XRAY ;#/X-rays included
  1. ORTHO ;Ortho. Related?
  1.  S $P(ABMF(45),U,$S($P(ABM("B4"),U,4):4,1:3))="X"  ;(40)
  1.  ; Ortho. Placement Dt
  1.  I $P(ABM("B4"),U,4) S $P(ABMF(45),U,5)=$P(ABM("B4"),U,5)  ;(41)
  1.  I $P(ABM("B4"),U,13) S $P(ABMF(47),U)=$P(ABM("B4"),U,13)  ;(42)
  1. PROTH ;Proth. Included?
  1.  S $P(ABMF(47),U,$S($P(ABM("B4"),U,6):3,1:2))="X"  ;(43)
  1.  ; Prior Placement Dt
  1.  I $P(ABM("B4"),U,6) S $P(ABMF(47),U,4)=$P(ABM("B4"),U,7)  ;(44)
  1.  ;
  1.  S ABMBIL=$P(ABMP("B0"),U)  ;Bill#
  1.  S ABMSFX=$P($G(^ABMDPARM(DUZ(2),1,2)),U,4)  ;Bill# suffix
  1.  S ABMAHRN=$P($G(^ABMDPARM(DUZ(2),1,1,3)),U,3)  ;Append HRN?
  1.  S ABMHRN=$P($G(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2)  ;HRN
  1.  S $P(ABMF(22),U,5)=ABMBIL_"-"_ABMSFX_" "_ABMHRN  ;Pt ID(23)
  1.  I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,0)) D
  1.  .S ABMIEN=0
  1.  .S ABMLINE=39
  1.  .F  S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,ABMIEN)) Q:+ABMIEN=0!(ABMLINE>41)  D
  1.  ..S ABMF(ABMLINE)=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,ABMIEN,0))
  1.  ..S ABMLINE=ABMLINE+1
  1.  Q
  1. PAT ;
  1.  S ABM("P0")=^DPT(ABMP("PDFN"),0)  ;0 node pt file
  1.  S ABMF(17)=$P(ABM("P0"),U)  ;Name(20)
  1.  S ABM("P11")=$G(^DPT(ABMP("PDFN"),.11))
  1.  S $P(ABMF(18),U,6)=$P(ABM("P11"),U)  ;Mailing addr(20)
  1.  S $P(ABMF(19),U)=$P(ABM("P11"),U,4)  ;Mailing-city(20)
  1.  S $P(ABMF(19),U)=$P(ABMF(19),U)_", "_$P(^DIC(5,$P(ABM("P11"),U,5),0),U,2)  ;Mailing-St(20)
  1.  S $P(ABMF(19),U)=$P(ABMF(19),U)_"  "_$P(ABM("P11"),U,6)  ;Mailing-Zip(20)
  1.  S $P(ABMF(22),U,2)=$P(ABM("P0"),U,3)  ;dob(21)
  1.  I $P(ABM("P0"),U,2)="M" S $P(ABMF(22),U,3)="X"  ;sex-male(22)
  1.  E  S $P(ABMF(22),U,4)="X"  ;sex-female(22)
  1.  K ABM("P0"),ABM("P11")
  1.  S (ABMV("X1"),ABMV("X2"),ABMV("X3"))=""
  1.  D PAT^ABMDE1X
  1.  D REMPL^ABMDE1X1
  1.  D LOC^ABMDE1X1
  1.  K ABME
  1.  Q
  1. PRV ;
  1.  S ABM("X")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
  1.  I ABM("X") D
  1.  .D SELBILL^ABMDE4X
  1.  .D PAYED^ABMERUTL
  1.  .S $P(ABMF(54),U,2)=$P(ABM("A"),U)  ;(53)
  1.  .I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC",($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL") S $P(ABMF(54),U,2)=""
  1.  .S $P(ABMF(54),U,3)=$S($G(ABMP("PRINTDT"))="O":$P($G(^ABMDTXST(DUZ(2),$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,7),0)),U),1:DT)  ;(53)
  1.  .S $P(ABMF(56),U,2)=$S($P($$NPI^XUSNPI("Individual_ID",$P(ABM("A"),U,2)),U)>0:$P($$NPI^XUSNPI("Individual_ID",$P(ABM("A"),U,2)),U),1:"")  ;Dent NPI (54)
  1.  .I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC",((ABMP("INS")=1722)!($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL")) S $P(ABMF(56),U,2)=""
  1.  .I $P($G(^AUTNINS(ABMP("INS"),0)),U)["MEDICAID UTAH" S $P(ABMF(56),U,2)=$S($P($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U),1:"")  ;Fac NPI for UTAH MEDICAID (54)
  1.  .S $P(ABMF(59),U,2)=$$SLN^ABMEEPRV($P(ABM("A"),U,2))  ;Dent Lic(55)
  1.  .I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
  1.  ..I ((ABMP("INS")=1722)!($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL")) S $P(ABMF(57),U,2)=""
  1.  ..S $P(ABMF(59),U,2)=""
  1.  ..I ABMP("INS")=5 S $P(ABMF(59),U,2)="NM008A76"
  1.  ..I $P($G(^AUTNINS(ABMP("INS"),0)),U)["UNITED CONCORDIA" S $P(ABMF(59),U,2)=601046
  1.  ..I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" S $P(ABMF(59),U,2)=8886
  1.  .S $P(ABMF(56),U,3)=$$SLN^ABMEEPRV($P(ABM("A"),U,2))  ;(55)
  1.  .I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
  1.  ..I (ABMP("INS")=1722)!($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL") S $P(ABMF(56),U,3)=$S(ABMP("INS")=5:"NM008A76",ABMP("INS")["UNITED CONCORDIA":601046,($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"):8886,1:"")
  1.  .S $P(ABMF(60),U,4)=ABM("PNUM")  ;Prov#(58)
  1.  .I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
  1.  ..S $P(ABMF(60),U,4)=$S(ABMP("INS")=5:"NM008A76",ABMP("INS")["UNITED CONCORDIA":601046,($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"):8886,1:"")
  1.  .S $P(ABMF(60),U,2)=ABM("INUM")  ;loc id(52a)
  1.  .I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
  1.  ..S $P(ABMF(60),U,2)=$S(ABMP("INS")=5:"NM008A76",ABMP("INS")["UNITED CONCORDIA":601046,($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"):8886,1:"")
  1.  .S $P(ABMF(60),U,3)=$P($G(^VA(200,$P(ABM("A"),U,2),.13)),U,2)  ;off. phone(57)
  1.  .I $P(ABMF(60),U,3)="" S $P(ABMF(60),U,3)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),U,11)  ;loc phone(57)
  1.  .S $P(ABMF(57),U)=$$PTAX^ABMEEPRV($P(ABM("A"),U,2))  ;specialty(tax. code)(56a)
  1.  .I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
  1.  ..I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" S $P(ABMF(57),U)=""
  1.  Q
  1. POL ;
  1.  N I
  1.  S I=0
  1.  F  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I)) Q:'I  D
  1.  .I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),U,3)="I" S ABM("XIEN")=I
  1.  S Y=ABMP("INS")
  1.  S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
  1.  D SEL^ABMDE2X  ;ABMV("X2")  ;Pol. holder info
  1.  I ABM("ADD")["NON-BEN" D
  1.  .S ABM("ADD")=ABMV("X2")
  1.  S $P(ABMF(5),U)=$P($P(ABMV("X2"),U),";",2)  ;Sub. name(12)
  1.  S $P(ABMF(6),U)=$P(ABMV("X2"),U,3)  ;Addr(12)
  1.  S ABMCSZ=$P(ABMV("X2"),"^",4)
  1.  S $P(ABMF(7),U,2)=$P(ABMCSZ,",",1)  ;City(12)
  1.  S ABMCSZ=$P(ABMCSZ,",",2)
  1.  S $P(ABMF(7),U,2)=$P(ABMF(7),U,2)_", "_$P(ABMCSZ," ",2)  ;St(12)
  1.  S $P(ABMF(7),U,2)=$P(ABMF(7),U,2)_"  "_$P(ABMCSZ," ",4)  ;Zip(12)
  1.  K ABMCSZ
  1.  S $P(ABMF(10),U,$S($P(ABMV("X2"),U,6)="M":2,1:3))="X"  ;Sex(14)
  1.  S $P(ABMF(10),U,4)=$P(ABMV("X1"),U,4)  ;Emp. id(15)
  1.  S $P(ABMF(10),U)=$P(ABMV("X2"),U,7)  ;dob(13)
  1.  S ABMSTAT=$P($P(ABMV("X3"),U,5),";")
  1.  Q