ABMERINS ; IHS/ASDST/DMJ - UB92 EMC Set up Insurer Information ;
;;2.6;IHS Third Party Billing System;**3,10,26,27**;NOV 12, 2009;Build 486
;Original;DMJ;06/25/96 12:43 PM
;IHS/SD/SDR V2.5 P3 1/24/03 - NEA-0301-180044 Modified to display patient info when workers comp
;IHS/SD/SDR v2.5 p8 IM14799 Modified BCBS line tag to kill possible pre-existing calue of ABME("LOC")
;IHS/SD/SDR v2.5 p9 IM18990 Correction for <UNDEFINED>PH+9^ABMERINS
;IHS/SD/SDR v2.5 p10 IM19963 Changed relationship code to use X12 code
;IHS/SD/SDR v2.5 p10 IM20000 Added code to look at CARD NAME in Policy Holder file
;IHS/SD/SDR v2.5 p10 IM21619 Made change to print worker's comp claim number
;IHS/SD/SDR v2.5 p11 IM24315 Added check for new parameter for UB Relationship code
;
;IHS/SD/SDR 2.6*3 HEAT8996 - get group name/# for Medicaid
;IHS/SD/SDR 2.6*26 CR9265 and CR9863 Changed to use AUPN API for MBI or default to HIC number
;IHS/SD/SDR 2.6*27 CR10170 Check if there's a replacement insurer; use that insurer type to drive what linetag it goes to;
; policy# wasn't printing because it was in wrong linetag for elig entry (like replacement PI when elig is in MCD file).
; *********************************************************************
;
START ;START HERE
;
ISET ;SET UP DEPENDING ON INSURER
K ABME("BCBS")
;S ABME("ITYPE")=$P(^AUTNINS(ABME("INS"),2),U) ; Type of insurer ;abm*2.6*10 HEAT73780
S ABME("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABME("INS"),".211","I"),1,"I") ; Type of insurer ;abm*2.6*10 HEAT73780
Q:"I"[ABME("ITYPE")
S ABME("INM")=$P(^AUTNINS(ABME("INS"),0),U) ; Ins name
K ABME("PH"),ABME("PHNM"),ABME("PPP")
S:'$G(ABME("INSIEN")) ABME("INSIEN")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"B",ABME("INS"),0))
;start new abm*2.6*27 IHS/SD/SDR CR10170
I '$G(ABME("INSIEN")) D
.S ABME("INSIEN")=0
.S ABMIF=0
.F S ABME("INSIEN")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"))) Q:'ABME("INSIEN") D Q:ABMIF
..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0)),U)=ABME("INS") S ABMIF=1 Q
..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0)),U,11)=ABME("INS") S ABMIF=1 Q
I '$G(ABME("INSIEN")) S ABME("INSIEN")=ABME("INS")
;type of insurer
I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0)),U)'=ABME("INS") S ABME("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0)),U),".211","I"),1,"I")
E S ABME("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABME("INS"),".211","I"),1,"I")
;end new abm*2.6*27 IHS/SD/SDR CR10170
D @$S(ABME("INS")=1:"RR",ABME("ITYPE")="R":"MCR",ABME("ITYPE")="D"!(ABME("ITYPE")="K"):"MCD",ABME("ITYPE")="N":"NON",1:"PRVT")
S ABME("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABME("INS"),".211","I"),1,"I") ;type of insurer - reset to active insurer, just in case ;abm*2.6*27 IHS/SD/SDR CR10170
S ABME("ID#")=$G(ABMR(30,70))
Q
;
RR ;RAILROAD RETIREMENT
S DIQ="ABM("
S DIQ(0)="E"
S DIC="^AUPNRRE("
S DA=ABMP("PDFN")
S DR=".01;.03;.04;2101"
D EN^DIQ1
K DIQ
S ABME("PHNM")=$G(ABM(9000005,DA,2101,"E")) ; Railroad patient name
S:ABME("PHNM")="" ABME("PHNM")=$G(ABM(9000005,DA,.01,"E")) ; Pat IEN
S ABME("PPP")=ABMP("PDFN") ; Patient IEN
;S ABMR(30,70)=$G(ABM(9000005,DA,.03,"E"))_$G(ABM(9000005,DA,.04,"E")) ; Prefix IEN_rr# ;abm*2.6*26 IHS/SD/SDR CR9265
;start new abm*2.6*26 IHS/SD/SDR CR9265
K ABMMBI
S ABMMBI=""
S ABMMBI=$$HISTMBI^AUPNMBI(ABME("PPP"),.ABMMBI)
S ABMMBI=+$O(ABMMBI(999999999),-1)
S:(ABMMBI'=0) ABMR(30,70)=$P(ABMMBI(ABMMBI),U)
I $G(ABMR(30,70))="" S ABMR(30,70)=$G(ABM(9000005,DA,.03,"E"))_$G(ABM(9000005,DA,.04,"E"))
;end new abm*2.6*26 IHS/SD/SDR CR9265
Q
;
MCR ;MEDICARE INSURER
S DIQ="ABM("
S DIQ(0)="E"
S DIC="^AUPNMCR("
S DA=ABMP("PDFN")
S DR=".01;.03;.04;2101"
D EN^DIQ1
K DIQ
S ABME("PHNM")=$G(ABM(9000003,DA,2101,"E"))
S:ABME("PHNM")="" ABME("PHNM")=$G(ABM(9000003,DA,.01,"E"))
S ABME("PPP")=ABMP("PDFN")
;S ABMR(30,70)=$G(ABM(9000003,DA,.03,"E"))_$G(ABM(9000003,DA,.04,"E")) ;abm*2.6*26 IHS/SD/SDR CR9265
;start new abm*2.6*26 IHS/SD/SDR CR9265
K ABMMBI
S ABMMBI=""
S ABMMBI=$$HISTMBI^AUPNMBI(ABME("PPP"),.ABMMBI)
S ABMMBI=+$O(ABMMBI(999999999),-1)
S:(ABMMBI'=0) ABMR(30,70)=$P(ABMMBI(ABMMBI),U)
I $G(ABMR(30,70))="" S ABMR(30,70)=$G(ABM(9000003,DA,.03,"E"))_$G(ABM(9000003,DA,.04,"E"))
;end new abm*2.6*26 IHS/SD/SDR CR9265
Q
;
MCD ;MEDICAID INSURER
S DIQ="ABM("
S DIQ(0)="EI"
S DIC="^AUPNMCD("
S DA=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,+ABME("INSIEN"),0)),"^",6)
;S DR=".03;.05;.06;.09;.11;2101;2102" ;abm*2.6*3 HEAT8996
S DR=".03;.05;.06;.09;.11;.17;2101;2102" ;abm*2.6*3 HEAT8996
I ABME("INSIEN"),$P($G(^AUPNMCD(+DA,0)),U)'=ABMP("PDFN") D
.D DBFX^ABMDEFIP(ABMP("BDFN"),ABME("INSIEN"))
.S DA=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0)),U,6)
D:DA EN^DIQ1
S ABME("GRP")=$G(ABM(9000004,+DA,.17,"I")) ;abm*2.6*2 HEAT8996
S ABME("REL")=$G(ABM(9000004,+DA,.06,"I"))
S ABME("REL")=$P($G(^AUTTRLSH(+ABME("REL"),0)),U,5)
S:$G(ABMP("VTYP"))'="" ABMRELC=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,18)
S ABME("REL")=$S($G(ABMRELC)="U":$P($G(^AUTTRLSH(+ABME("REL"),0)),U,3),1:$P($G(^AUTTRLSH(+ABME("REL"),0)),U,5))
I ABME("REL")="" S ABME("REL")=$S($G(ABMRELC)="U":"01",1:18)
I +ABME("REL")=18!($G(ABMRELC)="U"&(ABME("REL")=1)) D
.S ABME("PHNM")=$G(ABM(9000004,+DA,2101,"E"))
.S:ABME("PHNM")="" ABME("PHNM")=$P(^DPT(ABMP("PDFN"),0),U)
.S ABME("PPP")=ABMP("PDFN")
.S ABME("DOB")=$G(ABM(9000004,+DA,2102,"I"))
.Q
I +ABME("REL")'=18 D
.S ABME("PH")=$G(ABM(9000004,+DA,.09,"I"))
.I ABME("PH") D PH Q
.S ABME("PHNM")=$G(ABM(9000004,+DA,2101,"E"))
.Q
S ABMR(30,70)=$G(ABM(9000004,+DA,.03,"E"))
S ABME("MCD#")=ABMR(30,70)
Q
;
PRVT ; EP
; Private Insurer
S:'$G(ABME("INSIEN")) ABME("INSIEN")=ABMP("INS")
S DIQ="ABM("
S DIQ(0)="IE"
S DIC="^AUPNPRVT(" ; Private Insurance Eligible (9000006.11)
S DA=ABMP("PDFN")
S DR=1101
S ABME("DA")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,+ABME("INSIEN"),0)),"^",8)
S DA(9000006.11)=ABME("DA")
S DR(9000006.11)=".05;.08"
D:ABME("DA") EN^DIQ1
S ABME("PH")=$G(ABM(9000006.11,+ABME("DA"),.08,"I")) ; Policy Holder
S ABME("REL")=$G(ABM(9000006.11,+ABME("DA"),.05,"I")) ; Relationship
S:$G(ABMP("VTYP"))'="" ABMRELC=$P($G(^ABMNINS($S($G(ABMP("LDFN")):ABMP("LDFN"),1:DUZ(2)),ABME("INS"),1,$S($G(ABMP("VTYP")):ABMP("VTYP"),1:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,7)),0)),U,18)
S ABME("REL")=$S($G(ABMRELC)="U":$P($G(^AUTTRLSH(+ABME("REL"),0)),U,3),1:$P($G(^AUTTRLSH(+ABME("REL"),0)),U,5))
D PH,BCBS
Q
;
NON ;NON-BEN PATIENT
S ABME("PHNM")=$P(^DPT(ABMP("PDFN"),0),U)
Q
;
PH ;POLICY HOLDER INFORMATION
S DIC="^AUPN3PPH(" ; Policy holder (9000003.1)
S DA=ABME("PH")
S DR=".01:.19;2"
D:DA EN^DIQ1
S ABME("GRP")=$G(ABM(9000003.1,+DA,.06,"I")) ; group name
S ABME("PHNM")=$G(ABM(9000003.1,+DA,2,"E")) ;CARD NAME of policy holder
S:ABME("PHNM")="" ABME("PHNM")=$G(ABM(9000003.1,+DA,.01,"E")) ; Name of policy holder
S ABME("PPP")=$G(ABM(9000003.1,+DA,.02,"I")) ; Patient pointer
I $G(ABME("PHNM"))="",$G(ABME("ITYPE"))="W" D
.S ABME("PHNM")=$TR($G(ABMP("PNAME"))," ")
.S ABME("PPP")=ABMP("PDFN")
S ABME("PHSEX")=$G(ABM(9000003.1,+DA,.08,"I")) ; Policy holder sex
S ABME("DOB")=$G(ABM(9000003.1,+DA,.19,"I")) ; Policy holder DOB
I $G(ABMR(30,70))="" S ABMR(30,70)=$G(ABM(9000003.1,+DA,.04,"E")) ; Policy Number
I $G(ABME("ITYPE"))="W" S ABMR(30,70)=$S($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,8)'="":$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),4),U,8),1:$P($G(^DPT(ABMP("PDFN"),0)),U,9)) ;claim number or patient SSN
Q
;
BCBS ;Check if Blue Cross and Blue Shield
K ABME("LOC")
K ABME("BCBS")
S ABME("INM")=$P(^AUTNINS(ABME("INS"),0),U) ; Insurer name
N I
F I="B","C","B","S" D Q:'ABME("LOC")
.S ABME("LOC")=$F(ABME("INM"),I,$G(ABME("LOC")))
Q:'ABME("LOC")
S ABME("BCBS")=1
S ABMR(30,60)=$S($E($G(ABMR(30,70)))="R":"",1:$P($G(^AUTNEGRP(+ABME("GRP"),0)),"^",2))
Q
;
DIQ1 ;PULL BILL DATA VIA DIQ1
Q:$D(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
N I
S DIQ="ABM("
S DIQ(0)="EI"
S DIC="^ABMDBILL(DUZ(2),"
S DA=ABMP("BDFN")
S DR=".66;.67;.68;.73;.74;.75;.99"
D EN^DIQ1
K DIQ
Q
;
DIQ2 ;POLICY HOLDER INFORMATION
Q:$D(ABM(9000003.1,ABME("PH"),ABME("FLD")))
N I
S DIQ="ABM("
S DIQ(0)="EI"
S DIC="^AUPN3PPH("
S DA=ABME("PH")
S DR=".02;.15"
D EN^DIQ1
K DIQ
Q
;
DIQ3 ;PATIENT IS INSURED
Q:$D(ABM(2,ABMP("PDFN"),ABME("FLD")))
N I
S DIQ="ABM("
S DIQ(0)="EI"
S DIC="^DPT("
S DA=ABMP("PDFN")
S DR=".31115"
D EN^DIQ1
K DIQ
Q
ABMERINS ; IHS/ASDST/DMJ - UB92 EMC Set up Insurer Information ;
+1 ;;2.6;IHS Third Party Billing System;**3,10,26,27**;NOV 12, 2009;Build 486
+2 ;Original;DMJ;06/25/96 12:43 PM
+3 ;IHS/SD/SDR V2.5 P3 1/24/03 - NEA-0301-180044 Modified to display patient info when workers comp
+4 ;IHS/SD/SDR v2.5 p8 IM14799 Modified BCBS line tag to kill possible pre-existing calue of ABME("LOC")
+5 ;IHS/SD/SDR v2.5 p9 IM18990 Correction for <UNDEFINED>PH+9^ABMERINS
+6 ;IHS/SD/SDR v2.5 p10 IM19963 Changed relationship code to use X12 code
+7 ;IHS/SD/SDR v2.5 p10 IM20000 Added code to look at CARD NAME in Policy Holder file
+8 ;IHS/SD/SDR v2.5 p10 IM21619 Made change to print worker's comp claim number
+9 ;IHS/SD/SDR v2.5 p11 IM24315 Added check for new parameter for UB Relationship code
+10 ;
+11 ;IHS/SD/SDR 2.6*3 HEAT8996 - get group name/# for Medicaid
+12 ;IHS/SD/SDR 2.6*26 CR9265 and CR9863 Changed to use AUPN API for MBI or default to HIC number
+13 ;IHS/SD/SDR 2.6*27 CR10170 Check if there's a replacement insurer; use that insurer type to drive what linetag it goes to;
+14 ; policy# wasn't printing because it was in wrong linetag for elig entry (like replacement PI when elig is in MCD file).
+15 ; *********************************************************************
+16 ;
START ;START HERE
+1 ;
ISET ;SET UP DEPENDING ON INSURER
+1 KILL ABME("BCBS")
+2 ;S ABME("ITYPE")=$P(^AUTNINS(ABME("INS"),2),U) ; Type of insurer ;abm*2.6*10 HEAT73780
+3 ; Type of insurer ;abm*2.6*10 HEAT73780
SET ABME("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABME("INS"),".211","I"),1,"I")
+4 IF "I"[ABME("ITYPE")
QUIT
+5 ; Ins name
SET ABME("INM")=$PIECE(^AUTNINS(ABME("INS"),0),U)
+6 KILL ABME("PH"),ABME("PHNM"),ABME("PPP")
+7 IF '$GET(ABME("INSIEN"))
SET ABME("INSIEN")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"B",ABME("INS"),0))
+8 ;start new abm*2.6*27 IHS/SD/SDR CR10170
+9 IF '$GET(ABME("INSIEN"))
Begin DoDot:1
+10 SET ABME("INSIEN")=0
+11 SET ABMIF=0
+12 FOR
SET ABME("INSIEN")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN")))
IF 'ABME("INSIEN")
QUIT
Begin DoDot:2
+13 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0)),U)=ABME("INS")
SET ABMIF=1
QUIT
+14 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0)),U,11)=ABME("INS")
SET ABMIF=1
QUIT
End DoDot:2
IF ABMIF
QUIT
End DoDot:1
+15 IF '$GET(ABME("INSIEN"))
SET ABME("INSIEN")=ABME("INS")
+16 ;type of insurer
+17 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0)),U)'=ABME("INS")
SET ABME("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0)),U),".211","I"),1,"I")
+18 IF '$TEST
SET ABME("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABME("INS"),".211","I"),1,"I")
+19 ;end new abm*2.6*27 IHS/SD/SDR CR10170
+20 DO @$SELECT(ABME("INS")=1:"RR",ABME("ITYPE")="R":"MCR",ABME("ITYPE")="D"!(ABME("ITYPE")="K"):"MCD",ABME("ITYPE")="N":"NON",1:"PRVT")
+21 ;type of insurer - reset to active insurer, just in case ;abm*2.6*27 IHS/SD/SDR CR10170
SET ABME("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABME("INS"),".211","I"),1,"I")
+22 SET ABME("ID#")=$GET(ABMR(30,70))
+23 QUIT
+24 ;
RR ;RAILROAD RETIREMENT
+1 SET DIQ="ABM("
+2 SET DIQ(0)="E"
+3 SET DIC="^AUPNRRE("
+4 SET DA=ABMP("PDFN")
+5 SET DR=".01;.03;.04;2101"
+6 DO EN^DIQ1
+7 KILL DIQ
+8 ; Railroad patient name
SET ABME("PHNM")=$GET(ABM(9000005,DA,2101,"E"))
+9 ; Pat IEN
IF ABME("PHNM")=""
SET ABME("PHNM")=$GET(ABM(9000005,DA,.01,"E"))
+10 ; Patient IEN
SET ABME("PPP")=ABMP("PDFN")
+11 ;S ABMR(30,70)=$G(ABM(9000005,DA,.03,"E"))_$G(ABM(9000005,DA,.04,"E")) ; Prefix IEN_rr# ;abm*2.6*26 IHS/SD/SDR CR9265
+12 ;start new abm*2.6*26 IHS/SD/SDR CR9265
+13 KILL ABMMBI
+14 SET ABMMBI=""
+15 SET ABMMBI=$$HISTMBI^AUPNMBI(ABME("PPP"),.ABMMBI)
+16 SET ABMMBI=+$ORDER(ABMMBI(999999999),-1)
+17 IF (ABMMBI'=0)
SET ABMR(30,70)=$PIECE(ABMMBI(ABMMBI),U)
+18 IF $GET(ABMR(30,70))=""
SET ABMR(30,70)=$GET(ABM(9000005,DA,.03,"E"))_$GET(ABM(9000005,DA,.04,"E"))
+19 ;end new abm*2.6*26 IHS/SD/SDR CR9265
+20 QUIT
+21 ;
MCR ;MEDICARE INSURER
+1 SET DIQ="ABM("
+2 SET DIQ(0)="E"
+3 SET DIC="^AUPNMCR("
+4 SET DA=ABMP("PDFN")
+5 SET DR=".01;.03;.04;2101"
+6 DO EN^DIQ1
+7 KILL DIQ
+8 SET ABME("PHNM")=$GET(ABM(9000003,DA,2101,"E"))
+9 IF ABME("PHNM")=""
SET ABME("PHNM")=$GET(ABM(9000003,DA,.01,"E"))
+10 SET ABME("PPP")=ABMP("PDFN")
+11 ;S ABMR(30,70)=$G(ABM(9000003,DA,.03,"E"))_$G(ABM(9000003,DA,.04,"E")) ;abm*2.6*26 IHS/SD/SDR CR9265
+12 ;start new abm*2.6*26 IHS/SD/SDR CR9265
+13 KILL ABMMBI
+14 SET ABMMBI=""
+15 SET ABMMBI=$$HISTMBI^AUPNMBI(ABME("PPP"),.ABMMBI)
+16 SET ABMMBI=+$ORDER(ABMMBI(999999999),-1)
+17 IF (ABMMBI'=0)
SET ABMR(30,70)=$PIECE(ABMMBI(ABMMBI),U)
+18 IF $GET(ABMR(30,70))=""
SET ABMR(30,70)=$GET(ABM(9000003,DA,.03,"E"))_$GET(ABM(9000003,DA,.04,"E"))
+19 ;end new abm*2.6*26 IHS/SD/SDR CR9265
+20 QUIT
+21 ;
MCD ;MEDICAID INSURER
+1 SET DIQ="ABM("
+2 SET DIQ(0)="EI"
+3 SET DIC="^AUPNMCD("
+4 SET DA=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,+ABME("INSIEN"),0)),"^",6)
+5 ;S DR=".03;.05;.06;.09;.11;2101;2102" ;abm*2.6*3 HEAT8996
+6 ;abm*2.6*3 HEAT8996
SET DR=".03;.05;.06;.09;.11;.17;2101;2102"
+7 IF ABME("INSIEN")
IF $PIECE($GET(^AUPNMCD(+DA,0)),U)'=ABMP("PDFN")
Begin DoDot:1
+8 DO DBFX^ABMDEFIP(ABMP("BDFN"),ABME("INSIEN"))
+9 SET DA=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABME("INSIEN"),0)),U,6)
End DoDot:1
+10 IF DA
DO EN^DIQ1
+11 ;abm*2.6*2 HEAT8996
SET ABME("GRP")=$GET(ABM(9000004,+DA,.17,"I"))
+12 SET ABME("REL")=$GET(ABM(9000004,+DA,.06,"I"))
+13 SET ABME("REL")=$PIECE($GET(^AUTTRLSH(+ABME("REL"),0)),U,5)
+14 IF $GET(ABMP("VTYP"))'=""
SET ABMRELC=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,18)
+15 SET ABME("REL")=$SELECT($GET(ABMRELC)="U":$PIECE($GET(^AUTTRLSH(+ABME("REL"),0)),U,3),1:$PIECE($GET(^AUTTRLSH(+ABME("REL"),0)),U,5))
+16 IF ABME("REL")=""
SET ABME("REL")=$SELECT($GET(ABMRELC)="U":"01",1:18)
+17 IF +ABME("REL")=18!($GET(ABMRELC)="U"&(ABME("REL")=1))
Begin DoDot:1
+18 SET ABME("PHNM")=$GET(ABM(9000004,+DA,2101,"E"))
+19 IF ABME("PHNM")=""
SET ABME("PHNM")=$PIECE(^DPT(ABMP("PDFN"),0),U)
+20 SET ABME("PPP")=ABMP("PDFN")
+21 SET ABME("DOB")=$GET(ABM(9000004,+DA,2102,"I"))
+22 QUIT
End DoDot:1
+23 IF +ABME("REL")'=18
Begin DoDot:1
+24 SET ABME("PH")=$GET(ABM(9000004,+DA,.09,"I"))
+25 IF ABME("PH")
DO PH
QUIT
+26 SET ABME("PHNM")=$GET(ABM(9000004,+DA,2101,"E"))
+27 QUIT
End DoDot:1
+28 SET ABMR(30,70)=$GET(ABM(9000004,+DA,.03,"E"))
+29 SET ABME("MCD#")=ABMR(30,70)
+30 QUIT
+31 ;
PRVT ; EP
+1 ; Private Insurer
+2 IF '$GET(ABME("INSIEN"))
SET ABME("INSIEN")=ABMP("INS")
+3 SET DIQ="ABM("
+4 SET DIQ(0)="IE"
+5 ; Private Insurance Eligible (9000006.11)
SET DIC="^AUPNPRVT("
+6 SET DA=ABMP("PDFN")
+7 SET DR=1101
+8 SET ABME("DA")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,+ABME("INSIEN"),0)),"^",8)
+9 SET DA(9000006.11)=ABME("DA")
+10 SET DR(9000006.11)=".05;.08"
+11 IF ABME("DA")
DO EN^DIQ1
+12 ; Policy Holder
SET ABME("PH")=$GET(ABM(9000006.11,+ABME("DA"),.08,"I"))
+13 ; Relationship
SET ABME("REL")=$GET(ABM(9000006.11,+ABME("DA"),.05,"I"))
+14 IF $GET(ABMP("VTYP"))'=""
SET ABMRELC=$PIECE($GET(^ABMNINS($SELECT($GET(ABMP("LDFN")):ABMP("LDFN"),1:DUZ(2)),ABME("INS"),1,$SELECT($GET(ABMP("VTYP")):ABMP("VTYP"),1:$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,7)),0)),U,18)
+15 SET ABME("REL")=$SELECT($GET(ABMRELC)="U":$PIECE($GET(^AUTTRLSH(+ABME("REL"),0)),U,3),1:$PIECE($GET(^AUTTRLSH(+ABME("REL"),0)),U,5))
+16 DO PH
DO BCBS
+17 QUIT
+18 ;
NON ;NON-BEN PATIENT
+1 SET ABME("PHNM")=$PIECE(^DPT(ABMP("PDFN"),0),U)
+2 QUIT
+3 ;
PH ;POLICY HOLDER INFORMATION
+1 ; Policy holder (9000003.1)
SET DIC="^AUPN3PPH("
+2 SET DA=ABME("PH")
+3 SET DR=".01:.19;2"
+4 IF DA
DO EN^DIQ1
+5 ; group name
SET ABME("GRP")=$GET(ABM(9000003.1,+DA,.06,"I"))
+6 ;CARD NAME of policy holder
SET ABME("PHNM")=$GET(ABM(9000003.1,+DA,2,"E"))
+7 ; Name of policy holder
IF ABME("PHNM")=""
SET ABME("PHNM")=$GET(ABM(9000003.1,+DA,.01,"E"))
+8 ; Patient pointer
SET ABME("PPP")=$GET(ABM(9000003.1,+DA,.02,"I"))
+9 IF $GET(ABME("PHNM"))=""
IF $GET(ABME("ITYPE"))="W"
Begin DoDot:1
+10 SET ABME("PHNM")=$TRANSLATE($GET(ABMP("PNAME"))," ")
+11 SET ABME("PPP")=ABMP("PDFN")
End DoDot:1
+12 ; Policy holder sex
SET ABME("PHSEX")=$GET(ABM(9000003.1,+DA,.08,"I"))
+13 ; Policy holder DOB
SET ABME("DOB")=$GET(ABM(9000003.1,+DA,.19,"I"))
+14 ; Policy Number
IF $GET(ABMR(30,70))=""
SET ABMR(30,70)=$GET(ABM(9000003.1,+DA,.04,"E"))
+15 ;claim number or patient SSN
IF $GET(ABME("ITYPE"))="W"
SET ABMR(30,70)=$SELECT($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,8)'="":$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),4),U,8),1:$PIECE($GET(^DPT(ABMP("PDFN"),0)),U,9))
+16 QUIT
+17 ;
BCBS ;Check if Blue Cross and Blue Shield
+1 KILL ABME("LOC")
+2 KILL ABME("BCBS")
+3 ; Insurer name
SET ABME("INM")=$PIECE(^AUTNINS(ABME("INS"),0),U)
+4 NEW I
+5 FOR I="B","C","B","S"
Begin DoDot:1
+6 SET ABME("LOC")=$FIND(ABME("INM"),I,$GET(ABME("LOC")))
End DoDot:1
IF 'ABME("LOC")
QUIT
+7 IF 'ABME("LOC")
QUIT
+8 SET ABME("BCBS")=1
+9 SET ABMR(30,60)=$SELECT($EXTRACT($GET(ABMR(30,70)))="R":"",1:$PIECE($GET(^AUTNEGRP(+ABME("GRP"),0)),"^",2))
+10 QUIT
+11 ;
DIQ1 ;PULL BILL DATA VIA DIQ1
+1 IF $DATA(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
QUIT
+2 NEW I
+3 SET DIQ="ABM("
+4 SET DIQ(0)="EI"
+5 SET DIC="^ABMDBILL(DUZ(2),"
+6 SET DA=ABMP("BDFN")
+7 SET DR=".66;.67;.68;.73;.74;.75;.99"
+8 DO EN^DIQ1
+9 KILL DIQ
+10 QUIT
+11 ;
DIQ2 ;POLICY HOLDER INFORMATION
+1 IF $DATA(ABM(9000003.1,ABME("PH"),ABME("FLD")))
QUIT
+2 NEW I
+3 SET DIQ="ABM("
+4 SET DIQ(0)="EI"
+5 SET DIC="^AUPN3PPH("
+6 SET DA=ABME("PH")
+7 SET DR=".02;.15"
+8 DO EN^DIQ1
+9 KILL DIQ
+10 QUIT
+11 ;
DIQ3 ;PATIENT IS INSURED
+1 IF $DATA(ABM(2,ABMP("PDFN"),ABME("FLD")))
QUIT
+2 NEW I
+3 SET DIQ="ABM("
+4 SET DIQ(0)="EI"
+5 SET DIC="^DPT("
+6 SET DA=ABMP("PDFN")
+7 SET DR=".31115"
+8 DO EN^DIQ1
+9 KILL DIQ
+10 QUIT
