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

ABMDF29A.m

Go to the documentation of this file.
  1. ABMDF29A ; IHS/ASDST/DMJ - ADA 2006 Dental Export -part 2 ;
  1. ;;2.6;IHS 3P BILLING SYSTEM;**3,6,8**;NOV 12, 2009
  1. ; IHS/SD/SDR-v2.5 p12 - IM25183/IM25226
  1. ; Fix for <UNDEFINED>INS+13^ABMDF29A when no 2ndary insurer
  1. ; IHS/SD/SDR-v2.5 p12 - NO IM
  1. ; check box for EPSDT when Medicaid & vtyp desc contains EPSDT
  1. ; IHS/SD/SDR-v2.5 p12 - IM25568 - Correction to FL 52a
  1. ; Also removed old code due to space issue
  1. ; IHS/SD/SDR,AML-v2.5 p13 - IM26018 - Programming error at Santa Fe
  1. ; IHS/SD/SDR-abm*2.6*1 HEAT2948 - secondary info not printing correctly
  1. ; IHS/SD/SDR-abm*2.6*1 HEAT5760 - use ROI/AOB dates, not today, for 36 & 37
  1. ; IHS/SD/SDR-abm*2.6*1 HEAT6673 - Fixed prior auth to use N5,P12
  1. ; IHS/SD/PMT-abm*2.6*3 HEAT8604 - moved whole form up one line
  1. ; IHS/SD/SDR - abm*2.6*6 - HEAT26023 - Added coding for San Felipe clinic
  1. ; IHS/SD/SDR - abm*2.6*6 - NOHEAT - AIDC local mods
  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 $P($G(^AUTNINS(ABMP("INS"),2)),U)="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(8)=$P(ABM("ADD"),U,1) ;Ins Name(3) ;HEAT8604
  1. S ABMF(7)=$P(ABM("ADD"),U,1) ;Ins Name(3) ;HEAT8604
  1. ;S ABMF(9)=$P(ABM("ADD"),U,2) ;Ins Addr(3) ;HEAT8604
  1. S ABMF(8)=$P(ABM("ADD"),U,2) ;Ins Addr(3) ;HEAT8604
  1. ;S ABMF(10)=$P(ABMCSZ,U) ;City(3) ;HEAT8604
  1. S ABMF(9)=$P(ABMCSZ,U) ;City(3) ;HEAT8604
  1. S ABMSTATE=$P(ABMCSZ,U,2) ;St(3)
  1. ;S ABMF(10)=ABMF(10)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2) ;HEAT8604
  1. S ABMF(9)=ABMF(9)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2) ;HEAT8604
  1. ;S ABMF(10)=ABMF(10)_" "_$P(ABMCSZ,U,3) ;Zip(3) ;HEAT8604
  1. S ABMF(9)=ABMF(9)_" "_$P(ABMCSZ,U,3) ;Zip(3) ;HEAT8604
  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" Q ;unbillable ;abm*2.6*8
  1. ..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,3)="U" K ABMSINS Q ;unbillable ;abm*2.6*8
  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 $P($G(^AUTNINS(ABMP("INS"),2)),U)="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(21),U)=$P(ABM("ADD"),U,1) ;2ndary Name(11) ;HEAT8604
  1. .S $P(ABMF(20),U)=$P(ABM("ADD"),U,1) ;2ndary Name(11) ;HEAT8604
  1. .;S $P(ABMF(22),U)=$P(ABM("ADD"),U,2) ;2ndary Addr(11) ;HEAT8604
  1. .S $P(ABMF(21),U)=$P(ABM("ADD"),U,2) ;2ndary Addr(11) ;HEAT8604
  1. .;S $P(ABMF(23),U)=$P(ABMCSZ,U) ;2ndary City(11) ;HEAT8604
  1. .S $P(ABMF(22),U)=$P(ABMCSZ,U) ;2ndary City(11) ;HEAT8604
  1. .S ABMSTATE=$P(ABMCSZ,U,2) ;2ndary ST(11)
  1. .;S $P(ABMF(23),U)=$P(ABMF(23),U)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2) ;2ndary ST(11) ;HEAT8604
  1. .S $P(ABMF(22),U)=$P(ABMF(22),U)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2) ;2ndary ST(11) ;HEAT8604
  1. .;S $P(ABMF(23),U)=$P(ABMF(23),U)_" "_$P(ABMCSZ,U,3) ;2ndary Zip(11) ;HEAT8604
  1. .S $P(ABMF(22),U)=$P(ABMF(22),U)_" "_$P(ABMCSZ,U,3) ;2ndary Zip(11) ;HEAT8604
  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(17),U,2)="X" ;sex(7) ;HEAT8604
  1. ..I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="M" S $P(ABMF(16),U,2)="X" ;sex(7) ;HEAT8604
  1. ..;I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="F" S $P(ABMF(17),U,3)="X" ;sex(7) ;HEAT8604
  1. ..I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="F" S $P(ABMF(16),U,3)="X" ;sex(7) ;HEAT8604
  1. ..;S $P(ABMF(17),U,4)=$P($G(^AUPN3PPH(+ABMX("PH"),0)),U,4) ;Pol#(8) ;HEAT8604
  1. ..S $P(ABMF(16),U,4)=$P($G(^AUPN3PPH(+ABMX("PH"),0)),U,4) ;Pol#(8) ;HEAT8604
  1. ..;start new code abm*2.6*1 HEAT2948
  1. ..;rel (10)
  1. ..I $P($G(^AUTNINS(ABMP("INS2"),2)),U)="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")=18 S $P(ABMF(19),U,2)="X" ;HEAT8604
  1. ...I ABMP("REL")=17 S $P(ABMF(18),U,2)="X" ;HEAT8604
  1. ...;I ABMP("REL")="01" S $P(ABMF(19),U,3)="X" ;HEAT8604
  1. ...I ABMP("REL")="01" S $P(ABMF(18),U,3)="X" ;HEAT8604
  1. ...;I ABMP("REL")=19 S $P(ABMF(19),U,4)="X" ;HEAT8604
  1. ...I ABMP("REL")=18 S $P(ABMF(18),U,4)="X" ;HEAT8604
  1. ...;I ABMP("REL")'=18&(ABMP("REL")'=19)&(ABMP("REL")'="01") S $P(ABMF(19),U,5)="X" ;HEAT8604
  1. ...I ABMP("REL")'=17&(ABMP("REL")'=18)&(ABMP("REL")'="01") S $P(ABMF(18),U,5)="X" ;HEAT8604
  1. ..;end new code HEAT2948
  1. .I $P($G(^AUTNINS(ABMP("INS2"),2)),U)="D" D
  1. ..;I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="M" S $P(ABMF(16),U,2)="X" ;sex(7) ;HEAT8604
  1. ..I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="M" S $P(ABMF(16),U,2)="X" ;sex(7) ;HEAT8604
  1. ..;I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="F" S $P(ABMF(17),U,3)="X" ;sex(7) ;HEAT8604
  1. ..I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="F" S $P(ABMF(16),U,3)="X" ;sex(7) ;HEAT8604
  1. ..;S:(+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,6)'=0) $P(ABMF(17),U,4)=$P($G(^AUPNMCD($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,6),0)),U,3) ;Policy#(8) ;HEAT8604
  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) ;HEAT8604
  1. ..;S $P(ABMF(19),U,2)="X" ;rel.(10) ;HEAT8604
  1. ..S $P(ABMF(18),U,2)="X" ;rel.(10) ;HEAT8604
  1. .I $G(ABMX("GRP"))'="" D
  1. ..I $D(^AUTNEGRP(ABMX("GRP"),0)) D
  1. ...;S $P(ABMF(19),U)=$S($D(^AUTNEGRP(ABMX("GRP"),11,ABMP("VTYP"),0)):$P(^(0),U,2),1:$P(^AUTNEGRP(ABMX("GRP"),0),U,2)) ;HEAT8604
  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)) ;HEAT8604
  1. PAT ;Pt Info
  1. D PAT^ABMDF29B
  1. LOC ;loc info
  1. ;S $P(ABMF(55),U)=$S($P(ABMV("X1"),U,2)]"":$P(ABMV("X1"),U,2),1:$P($P(ABMV("X1"),U),";",2)) ;billing entity name(48) ;HEAT8604
  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) ;HEAT8604
  1. ;S $P(ABMF(56),U)=$P(ABMV("X1"),U,3) ;addr(48) ;HEAT8604
  1. S $P(ABMF(55),U)=$P(ABMV("X1"),U,3) ;addr(48) ;HEAT8604
  1. I DUZ(2)=1581 S $P(ABMF(55),U)="PO BOX 4342" ;abm*2.6*6 HEAT26023
  1. S ABMCSZ=$P(ABMV("X1"),U,4)
  1. ;S $P(ABMF(57),U)=$P(ABMCSZ,",",1) ;City(48) ;HEAT8604
  1. S $P(ABMF(56),U)=$P(ABMCSZ,",",1) ;City(48) ;HEAT8604
  1. S ABMCSZ=$P(ABMCSZ,",",2)
  1. ;S $P(ABMF(57),U)=$P(ABMF(57),U)_", "_$P(ABMCSZ," ",2) ;ST(48) ;HEAT8604
  1. S $P(ABMF(56),U)=$P(ABMF(56),U)_", "_$P(ABMCSZ," ",2) ;ST(48) ;HEAT8604
  1. ;S $P(ABMF(57),U)=$P(ABMF(57),U)_" "_$P(ABMCSZ," ",4) ;zip(48) ;HEAT8604
  1. S $P(ABMF(56),U)=$P(ABMF(56),U)_" "_$P(ABMCSZ," ",4) ;zip(48) ;HEAT8604
  1. I DUZ(2)=1581 S $P(ABMF(56),U)="San Felipe Pueblo, NM 87001" ;abm*2.6*6 HEAT26023
  1. ;
  1. I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" D
  1. .;S $P(ABMF(56),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(48) ;HEAT8604
  1. .S $P(ABMF(55),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(48) ;HEAT8604
  1. .;S $P(ABMF(57),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(48) ;HEAT8604
  1. .S $P(ABMF(56),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(48) ;HEAT8604
  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(57),U)=$P(ABMF(57),U)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(48) ;HEAT8604
  1. ..S $P(ABMF(56),U)=$P(ABMF(56),U)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(48) ;HEAT8604
  1. .;start new code abm*2.6*6 NOHEAT
  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. .;end new code NOHEAT
  1. K ABMCSZ
  1. ;S $P(ABMF(60),U,3)=$P(ABMV("X1"),U,6) ;SSN/TIN(51) ;HEAT8604
  1. S $P(ABMF(59),U,3)=$P(ABMV("X1"),U,6) ;SSN/TIN(51) ;HEAT8604
  1. I DUZ(2)=1581 S $P(ABMF(59),U,3)="850210848" ;abm*2.6*6 HEAT26023
  1. ;S $P(ABMF(61),U,1)=$P(ABMV("X1"),U,5) ;Phone(52) ;HEAT8604
  1. S $P(ABMF(60),U,1)=$P(ABMV("X1"),U,5) ;Phone(52) ;HEAT8604
  1. ;S $P(ABMF(61),U,1)=$P(ABMV("X1"),U,5) ;Phone(52) ;HEAT8604
  1. S $P(ABMF(60),U,1)=$P(ABMV("X1"),U,5) ;Phone(52) ;HEAT8604
  1. S ABMLOC=$P(ABMP("B0"),U,3)
  1. S ABMV("X1")=$G(^AUTTLOC(ABMLOC,0))
  1. ;start new abm*2.6*3 HEAT13493
  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. ;end new HEAT13493
  1. ;S $P(ABMF(59),U)=$P(ABMV("X1"),U,12) ;addr(56) ;HEAT8604
  1. ;S $P(ABMF(60),U,4)=$P(ABMV("X1"),U,13) ;city(56) ;HEAT8604
  1. ;S $P(ABMF(60),U,4)=$P(ABMF(60),U,4)_", "_$P(^DIC(5,ABML,0),U,2) ;st(56) ;HEAT8604
  1. ;S $P(ABMF(60),U,4)=$P(ABMF(60),U,4)_" "_$P(ABMV("X1"),U,15) ;zip(56) ;HEAT8604
  1. I $P(ABMF(58),U)="" D ;default to mailing address if no physical address ;abm*2.6*3 HEAT13493
  1. .S $P(ABMF(58),U)=$P(ABMV("X1"),U,12) ;addr(56) ;HEAT8604 & HEAT13493
  1. .S $P(ABMF(59),U,4)=$P(ABMV("X1"),U,13) ;city(56) ;HEAT8604 * HEAT13493
  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) ;HEAT8604 & HEAT13493
  1. .S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_" "_$P(ABMV("X1"),U,15) ;zip(56) ;HEAT8604 & HEAT13493
  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(60),U)=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"") ;Location NPI (49) ;HEAT8604
  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) ;HEAT8604
  1. I DUZ(2)=1581 S $P(ABMF(59),U)="1265511299" ;abm*2.6*6 HEAT26023
  1. I ABMP("LDFN")=5440 D ;Klamath
  1. .;S $P(ABMF(59),U)="330 Chiloquin BLVD" ;addr(56) ;HEAT8604
  1. .S $P(ABMF(58),U)="330 Chiloquin BLVD" ;addr(56) ;HEAT8604
  1. .;S $P(ABMF(60),U,4)="Chiloquin" ;city(56) ;HEAT8604
  1. .S $P(ABMF(59),U,4)="Chiloquin" ;city(56) ;HEAT8604
  1. .S ABMX("STATE")="Oregon" ;st(56)
  1. .;S $P(ABMF(60),U,4)=$P(ABMF(60),U,4)_", "_ABMX("STATE")_" 97624" ;zip(56) ;HEAT8604
  1. .S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_", "_ABMX("STATE")_" 97624" ;zip(56) ;HEAT8604
  1. ;start old abm*2.6*3 HEAT13493
  1. ;I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" D
  1. ;.;S $P(ABMF(59),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(56) ;HEAT8604
  1. ;.S $P(ABMF(58),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(56) ;HEAT8604
  1. ;.;S $P(ABMF(60),U,4)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(56) ;HEAT8604
  1. ;.S $P(ABMF(59),U,4)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(56) ;HEAT8604
  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(60),U,4)=$P(ABMF(60),U,4)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(56) ;HEAT8604
  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) ;HEAT8604
  1. ;end old HEAT13493
  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(60),U,2)=ABM("INUM") ;Dent Lic(55) ;HEAT8604
  1. S $P(ABMF(59),U,2)=ABM("INUM") ;Dent Lic(55) ;HEAT8604
  1. S ABMP("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ;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^ABMDF29B
  1. POL ;Pol. Info
  1. D POL^ABMDF29B
  1. EMPL ;Emp. info
  1. ;I ABMP("ITYP")'="P" S $P(ABMF(13),U,4)=$P(ABMV("X3"),U) ;Employer name(17) ;HEAT8604
  1. I ABMP("ITYP")'="P" S $P(ABMF(12),U,4)=$P(ABMV("X3"),U) ;Employer name(17) ;HEAT8604
  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(13),U,4)=$P($G(^AUTNEMPL(ABMEMPL,0)),U) ;HEAT8604
  1. .S:+ABMEMPL $P(ABMF(12),U,4)=$P($G(^AUTNEMPL(ABMEMPL,0)),U) ;HEAT8604
  1. ;S $P(ABMF(13),U,3)=$P(ABMV("X3"),U,7) ;Grp#(16) ;HEAT8604
  1. S $P(ABMF(12),U,3)=$P(ABMV("X3"),U,7) ;Grp#(16) ;HEAT8604
  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(16),U,$S(ABM=1:1,ABM=3:3,1:4))="X" ;Rel to subscbr(18) ;HEAT8604
  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) ;HEAT8604
  1. ;E S $P(ABMF(16),U,$S(ABM=2:2,ABM=1:1,1:4))="X" ;HEAT8604
  1. E S $P(ABMF(15),U,$S(ABM=2:2,ABM=1:1,1:4))="X" ;HEAT8604
  1. INS ;
  1. D ^ABMDF29B ;abm*2.6*1-split rtn due to size
  1. XIT ;
  1. K ABM,ABMV
  1. Q