ABMDF26A ; IHS/ASDST/DMJ - ADA Dental Export -part 2 ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;08/13/96 11:47 AM
;
; IHS/SD/SDR - v2.5 p8 - IM12857/IM13525
; Copied from export mode 18 and modified
;
; IHS/SD/SDR - v2.5 p8 - IM12859
; Added code to print Dentist License Number
;
; IHS/SD/SDR - v2.5 p10 - IM20936
; Fields 64,65,66 missing
; NOTE: old code removed due to routine size
;
; IHS/SD/SDR - v2.5 p10 - IM21043
; Changed treatment address to physical address
;
; *********************************************************************
;
ENT ; EP for getting data
S ABMP("B0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0) ; 3P Bill file 0 node
S ABMP("INS")=$P(ABMP("B0"),U,8) ; Active insurer
S ABMP("PDFN")=$P(ABMP("B0"),U,5) ; Patient IEN
S ABMP("LDFN")=$P(ABMP("B0"),U,3) ; Location IEN
S ABMP("VTYP")=$P(ABMP("B0"),U,7) ; Visit Type
S ABMP("BTYP")=$P(ABMP("B0"),U,2) ; Bill Type
Q:'ABMP("PDFN")!'ABMP("LDFN")!'ABMP("INS")
S ABMP("VDT")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U) ; Visit Date
;
BADDR ;
; Billing Address
S ABM("J")=ABMP("BDFN")
S ABM("I")=$P(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")
S ABM("INS",ABM("I"),ABM("J"))=""
I $P($G(^AUTNINS(ABMP("INS"),2)),U)="N" D
.S ABM("INS",ABM("I"),ABM("J"))=ABMP("PDFN")
S ABM("IDFN")=ABMP("INS")
D BADDR^ABMDLBL1
G PAT:'$D(ABM("ADD"))
S ABMF(3)="^"_$P(ABM("ADD"),U,1) ; Ins Name (3)
S ABMF(4)="^"_$P(ABM("ADD"),U,2) ; Address (4)
S $P(ABMF(6),U)=$P(ABMCSZ,U) ; City (5)
S ABMSTATE=$P(ABMCSZ,"^",2) ; State (6)
S $P(ABMF(6),U,2)=$P($G(^DIC(5,+ABMSTATE,0)),"^",2)
S $P(ABMF(6),U,3)=$P(ABMCSZ,"^",3) ; Zip (7) K ABMCSZ,ABMSTATE
;
PAT ;
; Patient Information
S ABM("P0")=^DPT(ABMP("PDFN"),0) ; 0 node patient file
S ABMF(8)=$P(ABM("P0"),U) ; Name (8)
S ABM("P11")=$G(^DPT(ABMP("PDFN"),.11))
S $P(ABMF(8),U,2)=$P(ABM("P11"),U) ; Mailing address (9)
S $P(ABMF(8),U,3)=$P(ABM("P11"),U,4) ; Mailing - city (10)
S $P(ABMF(8),U,4)=$P(^DIC(5,$P(ABM("P11"),U,5),0),U,2) ; Mailing - State (11)
S ABMDOB=$P(ABM("P0"),U,3) ; dob
S $P(ABMF(10),U)=$E(ABMDOB,4,5) ; dob - month (12)
S $P(ABMF(10),U,2)=$E(ABMDOB,6,7) ; dob - day (12)
S $P(ABMF(10),U,3)=($E(ABMDOB,1,3)+1700) ; dob - yr (12)
I $P(ABM("P0"),U,2)="M" S $P(ABMF(10),U,5)="X" ; sex - male (14)
E S $P(ABMF(10),U,6)="X" ; sex - female (14)
S $P(ABMF(10),U,7)=$P($G(^DPT(ABMP("PDFN"),.13)),U) ; phone (15)
S $P(ABMF(10),U,8)=$P(ABM("P11"),U,6) ; zip (16)
K ABM("P0"),ABM("P11")
;
S (ABMV("X1"),ABMV("X2"),ABMV("X3"))=""
D PAT^ABMDE1X
D REMPL^ABMDE1X1
D LOC^ABMDE1X1
K ABME
;
LOC ;
; Location info
S $P(ABMF(28),U)=$S($P(ABMV("X1"),U,2)]"":$P(ABMV("X1"),U,2),1:$P($P(ABMV("X1"),U),";",2)) ; billing entity name (42)
S $P(ABMF(30),U)=$P(ABMV("X1"),U,3) ; address (46)
S ABMCSZ=$P(ABMV("X1"),"^",4)
S $P(ABMF(32),U)=$P(ABMCSZ,",",1) ; City (50)
S ABMCSZ=$P(ABMCSZ,",",2)
S $P(ABMF(32),U,2)=$P(ABMCSZ," ",2) ; State (51)
S $P(ABMF(32),U,3)=$P(ABMCSZ," ",4) ; zip (52)
K ABMCSZ
S $P(ABMF(28),U,4)=$P(ABMV("X1"),U,6) ; SSN/TIN (45)
S $P(ABMF(28),U,2)=$P(ABMV("X1"),U,5) ; Phone (43)
S ABMLOC=$P(ABMP("B0"),U,3)
S ABMV("X1")=$G(^AUTTLOC(ABMLOC,0))
S $P(ABMF(58),U)=$P(ABMV("X1"),U,12) ;address (63)
S $P(ABMF(60),U,4)=$P(ABMV("X1"),U,13) ;city (64)
S ABML=$P(ABMV("X1"),U,14)
S $P(ABMF(60),U,5)=$P(^DIC(5,ABML,0),U,2) ;state (65)
S $P(ABMF(60),U,6)=$P(ABMV("X1"),U,15) ;zip (66)
I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" D
.S $P(ABMF(58),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;address (56)
.S $P(ABMF(60),U,4)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city (56)
.S ABMX("STATE")=$P($G(^DIC(4,ABMP("LDFN"),0)),U,2) ;state (56)
.S $P(ABMF(60),U,5)=$P($G(^DIC(5,+ABMX("STATE"),0)),U,2)
.S $P(ABMF(60),U,6)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip (56)
;
INSNUM ;
; Insurer Information
S ABM("INUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$P(ABMP("B0"),U,7),0)),U,8)
S:ABM("INUM")="" ABM("INUM")=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),U,2)
I ABM("INUM")="" D
.S ABMPRV=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
.S:ABMPRV ABMPRV=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRV,0)),U)
.S:ABMPRV ABM("INUM")=$P($G(^VA(200,ABMPRV,9999999.18,ABMP("INS"),0)),U,2)
S $P(ABMF(28),"^",3)=ABM("INUM")
S $P(ABMF(30),U,2)=ABM("INUM") ; Dentist License (47)
S ABMP("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ; Ins. type
I ABMP("ITYP")="D" D
.S ABMMCD=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMP("INS"),0)),U,6)
.S:+ABMMCD $P(ABMF(10),U,4)=$P($G(^AUPNMCD(ABMMCD,0)),U,3) ; mcd # (13)
;
PRV ;
; Provider?
S ABM("X")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
I ABM("X") D
.D SELBILL^ABMDE4X
.D PAYED^ABMERUTL
.S $P(ABMF(60),U)=$P(ABM("A"),U),$P(ABMF(60),U,2)=ABM("PNUM"),$P(ABMF(60),U,3)=DT
.S ABMF(51)=$G(ABMP("PAYED")) ; Payment by other plans
;
POL ;
; Policy Information
N I
S I=0
F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I)) Q:'I D
. I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),"^",3)="I" S ABM("XIEN")=I
S Y=ABMP("INS")
S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
D SEL^ABMDE2X ; ABMV("X2") ; Policy holder info
I ABM("ADD")["NON-BEN" D
.S ABM("ADD")=ABMV("X2")
.S ABMF(3)="^^"_$P($P(ABM("ADD"),U),";",2)
.S ABMF(3)="^"_$P(ABM("ADD"),U,3)
.S ABMF(4)="^^"_$P(ABM("ADD"),U,4)
S $P(ABMF(16),U)=$P($P(ABMV("X2"),U),";",2) ; Subscriber name (22)
S $P(ABMF(17),U)=$P(ABMV("X2"),U,3) ; Address (23)
S $P(ABMF(17),U,2)=$P(ABMV("X2"),U,5) ; Phone (24)
S ABMCSZ=$P(ABMV("X2"),"^",4)
S $P(ABMF(19),U)=$P(ABMCSZ,",",1) ; City (25)
S ABMCSZ=$P(ABMCSZ,",",2)
S $P(ABMF(19),U,2)=$P(ABMCSZ," ",2) ; State (26)
S $P(ABMF(19),U,3)=$P(ABMCSZ," ",4) ; Zip (27)
K ABMCSZ
S $P(ABMF(21),U,$S($P(ABMV("X2"),U,6)="M":7,1:8))="X" ; Sex (30)
S $P(ABMF(14),U)=$P(ABMV("X1"),U,4) ; Emp. id (19)
S $P(ABMF(21),U)=$E($P(ABMV("X2"),U,7),4,5) ; dob - month (28)
S $P(ABMF(21),U,2)=$E($P(ABMV("X2"),U,7),6,7) ; dob - day (28)
S $P(ABMF(21),U,3)=($E($P(ABMV("X2"),U,7),1,3)+1700) ; dob - yr (28)
S ABMSTAT=$P($P(ABMV("X3"),U,5),";")
I ABMSTAT=1 S $P(ABMF(21),U,9)="X" ; Employed full time (38)
I ABMSTAT=2 S $P(ABMF(21),U,10)="X" ; Employed parttiime (38)
I "12"[ABMSTAT S $P(ABMF(23),U)=$P(ABMV("X3"),U,6) ; Employer (40)
;
EMPL ;
; Employer information
S $P(ABMF(14),U,2)=$P(ABMV("X3"),U) ; Employer name (20)
S $P(ABMF(14),U,3)=$P(ABMV("X3"),U,7) ; Group number (21)
;
REL ;
; Relationship
G INS:'$P(ABMV("X2"),U,2)
S ABM=+$P($G(^AUTTRLSH(+$P(ABMV("X2"),U,2),0)),U,2)
I ABM,ABM<8,ABM'=2 S $P(ABMF(12),U,$S(ABM=1:1,1:3))="X" ; (17)
E S $P(ABMF(12),U,$S(ABM=2:2,1:4))="X"
;
INS ;
; Insurer Information
S ABM("I")=0
F S ABM("I")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I"))) Q:'ABM("I") D
.S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I"),0))
.S ABM=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM,0),U)
.I ABM'=ABMP("INS") D Q
..I "U"[$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM,0)),U,3) Q
..S Y=ABM
..S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
..D SEL^ABMDE2X
..S $P(ABMF(17),U,3)=$E($P(ABMV("X2"),U,7),4,5) ; (34)
..S $P(ABMF(17),U,4)=$E($P(ABMV("X2"),U,7),6,7) ; (34)
..S $P(ABMF(17),U,5)=($E($P(ABMV("X2"),U,7),1,3)+1700) ; (34)
..I $P($G(^AUTNINS(ABM,2)),U,5)="O" S $P(ABMF(14),U,6)="X" ; den (31)
..E S $P(ABMF(14),U,7)="X" ; Other Medical (31)
..S $P(ABMF(14),U,5)="X" ; Other coverage (31)
S:$P(ABMF(14),U,5)="" $P(ABMF(14),U,4)="X" ; No other coverage (31)
;
BNODES ;
; Bill nodes
I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)) D
. S ABM("B4")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4))
. S ABM("B5")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),5))
. S ABM("B7")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7))
. S ABM("B8")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8))
. S ABM("B9")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9))
S $P(ABMF(5),U,2)=$P(ABM("B5"),U,8) ; Prior Auth (2)
I $P(ABM("B9"),U)]"" S $P(ABMF(35),U,2)="X"
E S $P(ABMF(35),U)="X"
;
ACCD ;
; Accident?
I $P(ABM("B8"),U,3)'="" D
.I "12"[$P(ABM("B8"),U,3) D Q
..S $P(ABMF(35),U,3)="X" ; auto accident (57)
.I "5"[$P(ABM("B8"),U,3) D Q
..S $P(ABMF(35),U,4)="X" ; other accident (57)
.S $P(ABMF(35),U,5)="X" ; neither (57)
;
FSYM ;
S $P(ABMF(30),U,3)=$P(ABM("B8"),U,6) ; 1st date series(48)
I $P(ABM("B7"),U,4)="Y" D ; Release of Info
. S ABMF(25)="SIGNATURE ON FILE" ; (39)
. S $P(ABMF(25),U,2)=DT ; (39)
I $P(ABM("B7"),U,5)="Y" D ; Assignment of Benefits
. S $P(ABMF(25),U,3)="SIGNATURE ON FILE" ; (41)
. S $P(ABMF(25),U,4)=DT ; (41)
S $P(ABMF(30),U,4)="X" ; office place of tx (49)
;
XRAY ;
; Number of X-rays included
S $P(ABMF(32),U,$S($P(ABM("B4"),U,3):4,1:6))="X" ; (53)
S $P(ABMF(32),U,6)=$P(ABM("B4"),U,3) ; (53)
;
ORTHO ;
; Orthodontic Related?
S $P(ABMF(31),U,$S($P(ABM("B4"),U,4):1,1:2))="X" ; (54)
; Orthodontic Placement Date
I $P(ABM("B4"),U,4) S $P(ABMF(34),U,5)=$P(ABM("B4"),U,5) ; (54)
;
PROTH ;
; Prothesis Included?
S $P(ABMF(34),U,$S($P(ABM("B4"),U,6):1,1:2))="X" ; (55)
; Prior Placement Date
I $P(ABM("B4"),U,6) S $P(ABMF(36),U)=$P(ABM("B4"),U,7) ; (55)
S ABMBIL=$P(ABMP("B0"),U) ; Bill number
S ABMSFX=$P($G(^ABMDPARM(DUZ(2),1,2)),U,4) ; Bill Number suffix
S ABMAHRN=$P($G(^ABMDPARM(DUZ(2),1,1,3)),U,3) ; Append HRN?
S ABMHRN=$P($G(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2) ; HRN
S $P(ABMF(54),U)="Bill Number: "_ABMBIL_"-"_ABMSFX_" "_ABMHRN ;Comments (61)
I +ABMAHRN,+ABMHRN S $P(ABMF(55),U)=$P(ABMF(55),U)_+ABMHRN
;
XIT ;
K ABM,ABMV
Q
ABMDF26A ; IHS/ASDST/DMJ - ADA Dental Export -part 2 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;08/13/96 11:47 AM
+3 ;
+4 ; IHS/SD/SDR - v2.5 p8 - IM12857/IM13525
+5 ; Copied from export mode 18 and modified
+6 ;
+7 ; IHS/SD/SDR - v2.5 p8 - IM12859
+8 ; Added code to print Dentist License Number
+9 ;
+10 ; IHS/SD/SDR - v2.5 p10 - IM20936
+11 ; Fields 64,65,66 missing
+12 ; NOTE: old code removed due to routine size
+13 ;
+14 ; IHS/SD/SDR - v2.5 p10 - IM21043
+15 ; Changed treatment address to physical address
+16 ;
+17 ; *********************************************************************
+18 ;
ENT ; EP for getting data
+1 ; 3P Bill file 0 node
SET ABMP("B0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
+2 ; Active insurer
SET ABMP("INS")=$PIECE(ABMP("B0"),U,8)
+3 ; Patient IEN
SET ABMP("PDFN")=$PIECE(ABMP("B0"),U,5)
+4 ; Location IEN
SET ABMP("LDFN")=$PIECE(ABMP("B0"),U,3)
+5 ; Visit Type
SET ABMP("VTYP")=$PIECE(ABMP("B0"),U,7)
+6 ; Bill Type
SET ABMP("BTYP")=$PIECE(ABMP("B0"),U,2)
+7 IF 'ABMP("PDFN")!'ABMP("LDFN")!'ABMP("INS")
QUIT
+8 ; Visit Date
SET ABMP("VDT")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U)
+9 ;
BADDR ;
+1 ; Billing Address
+2 SET ABM("J")=ABMP("BDFN")
+3 SET ABM("I")=$PIECE(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")
+4 SET ABM("INS",ABM("I"),ABM("J"))=""
+5 IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)="N"
Begin DoDot:1
+6 SET ABM("INS",ABM("I"),ABM("J"))=ABMP("PDFN")
End DoDot:1
+7 SET ABM("IDFN")=ABMP("INS")
+8 DO BADDR^ABMDLBL1
+9 IF '$DATA(ABM("ADD"))
GOTO PAT
+10 ; Ins Name (3)
SET ABMF(3)="^"_$PIECE(ABM("ADD"),U,1)
+11 ; Address (4)
SET ABMF(4)="^"_$PIECE(ABM("ADD"),U,2)
+12 ; City (5)
SET $PIECE(ABMF(6),U)=$PIECE(ABMCSZ,U)
+13 ; State (6)
SET ABMSTATE=$PIECE(ABMCSZ,"^",2)
+14 SET $PIECE(ABMF(6),U,2)=$PIECE($GET(^DIC(5,+ABMSTATE,0)),"^",2)
+15 ; Zip (7) K ABMCSZ,ABMSTATE
SET $PIECE(ABMF(6),U,3)=$PIECE(ABMCSZ,"^",3)
+16 ;
PAT ;
+1 ; Patient Information
+2 ; 0 node patient file
SET ABM("P0")=^DPT(ABMP("PDFN"),0)
+3 ; Name (8)
SET ABMF(8)=$PIECE(ABM("P0"),U)
+4 SET ABM("P11")=$GET(^DPT(ABMP("PDFN"),.11))
+5 ; Mailing address (9)
SET $PIECE(ABMF(8),U,2)=$PIECE(ABM("P11"),U)
+6 ; Mailing - city (10)
SET $PIECE(ABMF(8),U,3)=$PIECE(ABM("P11"),U,4)
+7 ; Mailing - State (11)
SET $PIECE(ABMF(8),U,4)=$PIECE(^DIC(5,$PIECE(ABM("P11"),U,5),0),U,2)
+8 ; dob
SET ABMDOB=$PIECE(ABM("P0"),U,3)
+9 ; dob - month (12)
SET $PIECE(ABMF(10),U)=$EXTRACT(ABMDOB,4,5)
+10 ; dob - day (12)
SET $PIECE(ABMF(10),U,2)=$EXTRACT(ABMDOB,6,7)
+11 ; dob - yr (12)
SET $PIECE(ABMF(10),U,3)=($EXTRACT(ABMDOB,1,3)+1700)
+12 ; sex - male (14)
IF $PIECE(ABM("P0"),U,2)="M"
SET $PIECE(ABMF(10),U,5)="X"
+13 ; sex - female (14)
IF '$TEST
SET $PIECE(ABMF(10),U,6)="X"
+14 ; phone (15)
SET $PIECE(ABMF(10),U,7)=$PIECE($GET(^DPT(ABMP("PDFN"),.13)),U)
+15 ; zip (16)
SET $PIECE(ABMF(10),U,8)=$PIECE(ABM("P11"),U,6)
+16 KILL ABM("P0"),ABM("P11")
+17 ;
+18 SET (ABMV("X1"),ABMV("X2"),ABMV("X3"))=""
+19 DO PAT^ABMDE1X
+20 DO REMPL^ABMDE1X1
+21 DO LOC^ABMDE1X1
+22 KILL ABME
+23 ;
LOC ;
+1 ; Location info
+2 ; billing entity name (42)
SET $PIECE(ABMF(28),U)=$SELECT($PIECE(ABMV("X1"),U,2)]"":$PIECE(ABMV("X1"),U,2),1:$PIECE($PIECE(ABMV("X1"),U),";",2))
+3 ; address (46)
SET $PIECE(ABMF(30),U)=$PIECE(ABMV("X1"),U,3)
+4 SET ABMCSZ=$PIECE(ABMV("X1"),"^",4)
+5 ; City (50)
SET $PIECE(ABMF(32),U)=$PIECE(ABMCSZ,",",1)
+6 SET ABMCSZ=$PIECE(ABMCSZ,",",2)
+7 ; State (51)
SET $PIECE(ABMF(32),U,2)=$PIECE(ABMCSZ," ",2)
+8 ; zip (52)
SET $PIECE(ABMF(32),U,3)=$PIECE(ABMCSZ," ",4)
+9 KILL ABMCSZ
+10 ; SSN/TIN (45)
SET $PIECE(ABMF(28),U,4)=$PIECE(ABMV("X1"),U,6)
+11 ; Phone (43)
SET $PIECE(ABMF(28),U,2)=$PIECE(ABMV("X1"),U,5)
+12 SET ABMLOC=$PIECE(ABMP("B0"),U,3)
+13 SET ABMV("X1")=$GET(^AUTTLOC(ABMLOC,0))
+14 ;address (63)
SET $PIECE(ABMF(58),U)=$PIECE(ABMV("X1"),U,12)
+15 ;city (64)
SET $PIECE(ABMF(60),U,4)=$PIECE(ABMV("X1"),U,13)
+16 SET ABML=$PIECE(ABMV("X1"),U,14)
+17 ;state (65)
SET $PIECE(ABMF(60),U,5)=$PIECE(^DIC(5,ABML,0),U,2)
+18 ;zip (66)
SET $PIECE(ABMF(60),U,6)=$PIECE(ABMV("X1"),U,15)
+19 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"
Begin DoDot:1
+20 ;address (56)
SET $PIECE(ABMF(58),U)=$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U)
+21 ;city (56)
SET $PIECE(ABMF(60),U,4)=$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U,3)
+22 ;state (56)
SET ABMX("STATE")=$PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U,2)
+23 SET $PIECE(ABMF(60),U,5)=$PIECE($GET(^DIC(5,+ABMX("STATE"),0)),U,2)
+24 ;zip (56)
SET $PIECE(ABMF(60),U,6)=$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U,4)
End DoDot:1
+25 ;
INSNUM ;
+1 ; Insurer Information
+2 SET ABM("INUM")=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$PIECE(ABMP("B0"),U,7),0)),U,8)
+3 IF ABM("INUM")=""
SET ABM("INUM")=$PIECE($GET(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),U,2)
+4 IF ABM("INUM")=""
Begin DoDot:1
+5 SET ABMPRV=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
+6 IF ABMPRV
SET ABMPRV=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRV,0)),U)
+7 IF ABMPRV
SET ABM("INUM")=$PIECE($GET(^VA(200,ABMPRV,9999999.18,ABMP("INS"),0)),U,2)
End DoDot:1
+8 SET $PIECE(ABMF(28),"^",3)=ABM("INUM")
+9 ; Dentist License (47)
SET $PIECE(ABMF(30),U,2)=ABM("INUM")
+10 ; Ins. type
SET ABMP("ITYP")=$PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)
+11 IF ABMP("ITYP")="D"
Begin DoDot:1
+12 SET ABMMCD=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMP("INS"),0)),U,6)
+13 ; mcd # (13)
IF +ABMMCD
SET $PIECE(ABMF(10),U,4)=$PIECE($GET(^AUPNMCD(ABMMCD,0)),U,3)
End DoDot:1
+14 ;
PRV ;
+1 ; Provider?
+2 SET ABM("X")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
+3 IF ABM("X")
Begin DoDot:1
+4 DO SELBILL^ABMDE4X
+5 DO PAYED^ABMERUTL
+6 SET $PIECE(ABMF(60),U)=$PIECE(ABM("A"),U)
SET $PIECE(ABMF(60),U,2)=ABM("PNUM")
SET $PIECE(ABMF(60),U,3)=DT
+7 ; Payment by other plans
SET ABMF(51)=$GET(ABMP("PAYED"))
End DoDot:1
+8 ;
POL ;
+1 ; Policy Information
+2 NEW I
+3 SET I=0
+4 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I))
IF 'I
QUIT
Begin DoDot:1
+5 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),"^",3)="I"
SET ABM("XIEN")=I
End DoDot:1
+6 SET Y=ABMP("INS")
+7 SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
+8 ; ABMV("X2") ; Policy holder info
DO SEL^ABMDE2X
+9 IF ABM("ADD")["NON-BEN"
Begin DoDot:1
+10 SET ABM("ADD")=ABMV("X2")
+11 SET ABMF(3)="^^"_$PIECE($PIECE(ABM("ADD"),U),";",2)
+12 SET ABMF(3)="^"_$PIECE(ABM("ADD"),U,3)
+13 SET ABMF(4)="^^"_$PIECE(ABM("ADD"),U,4)
End DoDot:1
+14 ; Subscriber name (22)
SET $PIECE(ABMF(16),U)=$PIECE($PIECE(ABMV("X2"),U),";",2)
+15 ; Address (23)
SET $PIECE(ABMF(17),U)=$PIECE(ABMV("X2"),U,3)
+16 ; Phone (24)
SET $PIECE(ABMF(17),U,2)=$PIECE(ABMV("X2"),U,5)
+17 SET ABMCSZ=$PIECE(ABMV("X2"),"^",4)
+18 ; City (25)
SET $PIECE(ABMF(19),U)=$PIECE(ABMCSZ,",",1)
+19 SET ABMCSZ=$PIECE(ABMCSZ,",",2)
+20 ; State (26)
SET $PIECE(ABMF(19),U,2)=$PIECE(ABMCSZ," ",2)
+21 ; Zip (27)
SET $PIECE(ABMF(19),U,3)=$PIECE(ABMCSZ," ",4)
+22 KILL ABMCSZ
+23 ; Sex (30)
SET $PIECE(ABMF(21),U,$SELECT($PIECE(ABMV("X2"),U,6)="M":7,1:8))="X"
+24 ; Emp. id (19)
SET $PIECE(ABMF(14),U)=$PIECE(ABMV("X1"),U,4)
+25 ; dob - month (28)
SET $PIECE(ABMF(21),U)=$EXTRACT($PIECE(ABMV("X2"),U,7),4,5)
+26 ; dob - day (28)
SET $PIECE(ABMF(21),U,2)=$EXTRACT($PIECE(ABMV("X2"),U,7),6,7)
+27 ; dob - yr (28)
SET $PIECE(ABMF(21),U,3)=($EXTRACT($PIECE(ABMV("X2"),U,7),1,3)+1700)
+28 SET ABMSTAT=$PIECE($PIECE(ABMV("X3"),U,5),";")
+29 ; Employed full time (38)
IF ABMSTAT=1
SET $PIECE(ABMF(21),U,9)="X"
+30 ; Employed parttiime (38)
IF ABMSTAT=2
SET $PIECE(ABMF(21),U,10)="X"
+31 ; Employer (40)
IF "12"[ABMSTAT
SET $PIECE(ABMF(23),U)=$PIECE(ABMV("X3"),U,6)
+32 ;
EMPL ;
+1 ; Employer information
+2 ; Employer name (20)
SET $PIECE(ABMF(14),U,2)=$PIECE(ABMV("X3"),U)
+3 ; Group number (21)
SET $PIECE(ABMF(14),U,3)=$PIECE(ABMV("X3"),U,7)
+4 ;
REL ;
+1 ; Relationship
+2 IF '$PIECE(ABMV("X2"),U,2)
GOTO INS
+3 SET ABM=+$PIECE($GET(^AUTTRLSH(+$PIECE(ABMV("X2"),U,2),0)),U,2)
+4 ; (17)
IF ABM
IF ABM<8
IF ABM'=2
SET $PIECE(ABMF(12),U,$SELECT(ABM=1:1,1:3))="X"
+5 IF '$TEST
SET $PIECE(ABMF(12),U,$SELECT(ABM=2:2,1:4))="X"
+6 ;
INS ;
+1 ; Insurer Information
+2 SET ABM("I")=0
+3 FOR
SET ABM("I")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I")))
IF 'ABM("I")
QUIT
Begin DoDot:1
+4 SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I"),0))
+5 SET ABM=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM,0),U)
+6 IF ABM'=ABMP("INS")
Begin DoDot:2
+7 IF "U"[$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM,0)),U,3)
QUIT
+8 SET Y=ABM
+9 SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
+10 DO SEL^ABMDE2X
+11 ; (34)
SET $PIECE(ABMF(17),U,3)=$EXTRACT($PIECE(ABMV("X2"),U,7),4,5)
+12 ; (34)
SET $PIECE(ABMF(17),U,4)=$EXTRACT($PIECE(ABMV("X2"),U,7),6,7)
+13 ; (34)
SET $PIECE(ABMF(17),U,5)=($EXTRACT($PIECE(ABMV("X2"),U,7),1,3)+1700)
+14 ; den (31)
IF $PIECE($GET(^AUTNINS(ABM,2)),U,5)="O"
SET $PIECE(ABMF(14),U,6)="X"
+15 ; Other Medical (31)
IF '$TEST
SET $PIECE(ABMF(14),U,7)="X"
+16 ; Other coverage (31)
SET $PIECE(ABMF(14),U,5)="X"
End DoDot:2
QUIT
End DoDot:1
+17 ; No other coverage (31)
IF $PIECE(ABMF(14),U,5)=""
SET $PIECE(ABMF(14),U,4)="X"
+18 ;
BNODES ;
+1 ; Bill nodes
+2 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
Begin DoDot:1
+3 SET ABM("B4")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4))
+4 SET ABM("B5")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),5))
+5 SET ABM("B7")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7))
+6 SET ABM("B8")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8))
+7 SET ABM("B9")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9))
End DoDot:1
+8 ; Prior Auth (2)
SET $PIECE(ABMF(5),U,2)=$PIECE(ABM("B5"),U,8)
+9 IF $PIECE(ABM("B9"),U)]""
SET $PIECE(ABMF(35),U,2)="X"
+10 IF '$TEST
SET $PIECE(ABMF(35),U)="X"
+11 ;
ACCD ;
+1 ; Accident?
+2 IF $PIECE(ABM("B8"),U,3)'=""
Begin DoDot:1
+3 IF "12"[$PIECE(ABM("B8"),U,3)
Begin DoDot:2
+4 ; auto accident (57)
SET $PIECE(ABMF(35),U,3)="X"
End DoDot:2
QUIT
+5 IF "5"[$PIECE(ABM("B8"),U,3)
Begin DoDot:2
+6 ; other accident (57)
SET $PIECE(ABMF(35),U,4)="X"
End DoDot:2
QUIT
+7 ; neither (57)
SET $PIECE(ABMF(35),U,5)="X"
End DoDot:1
+8 ;
FSYM ;
+1 ; 1st date series(48)
SET $PIECE(ABMF(30),U,3)=$PIECE(ABM("B8"),U,6)
+2 ; Release of Info
IF $PIECE(ABM("B7"),U,4)="Y"
Begin DoDot:1
+3 ; (39)
SET ABMF(25)="SIGNATURE ON FILE"
+4 ; (39)
SET $PIECE(ABMF(25),U,2)=DT
End DoDot:1
+5 ; Assignment of Benefits
IF $PIECE(ABM("B7"),U,5)="Y"
Begin DoDot:1
+6 ; (41)
SET $PIECE(ABMF(25),U,3)="SIGNATURE ON FILE"
+7 ; (41)
SET $PIECE(ABMF(25),U,4)=DT
End DoDot:1
+8 ; office place of tx (49)
SET $PIECE(ABMF(30),U,4)="X"
+9 ;
XRAY ;
+1 ; Number of X-rays included
+2 ; (53)
SET $PIECE(ABMF(32),U,$SELECT($PIECE(ABM("B4"),U,3):4,1:6))="X"
+3 ; (53)
SET $PIECE(ABMF(32),U,6)=$PIECE(ABM("B4"),U,3)
+4 ;
ORTHO ;
+1 ; Orthodontic Related?
+2 ; (54)
SET $PIECE(ABMF(31),U,$SELECT($PIECE(ABM("B4"),U,4):1,1:2))="X"
+3 ; Orthodontic Placement Date
+4 ; (54)
IF $PIECE(ABM("B4"),U,4)
SET $PIECE(ABMF(34),U,5)=$PIECE(ABM("B4"),U,5)
+5 ;
PROTH ;
+1 ; Prothesis Included?
+2 ; (55)
SET $PIECE(ABMF(34),U,$SELECT($PIECE(ABM("B4"),U,6):1,1:2))="X"
+3 ; Prior Placement Date
+4 ; (55)
IF $PIECE(ABM("B4"),U,6)
SET $PIECE(ABMF(36),U)=$PIECE(ABM("B4"),U,7)
+5 ; Bill number
SET ABMBIL=$PIECE(ABMP("B0"),U)
+6 ; Bill Number suffix
SET ABMSFX=$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,4)
+7 ; Append HRN?
SET ABMAHRN=$PIECE($GET(^ABMDPARM(DUZ(2),1,1,3)),U,3)
+8 ; HRN
SET ABMHRN=$PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2)
+9 ;Comments (61)
SET $PIECE(ABMF(54),U)="Bill Number: "_ABMBIL_"-"_ABMSFX_" "_ABMHRN
+10 IF +ABMAHRN
IF +ABMHRN
SET $PIECE(ABMF(55),U)=$PIECE(ABMF(55),U)_+ABMHRN
+11 ;
XIT ;
+1 KILL ABM,ABMV
+2 QUIT
