ABMDF28Z ; IHS/SD/SDR - PRINT UB-04 ;
;;2.6;IHS 3P BILLING SYSTEM;**3,8,9,10,11,14,16,21,27**;NOV 12, 2009;Build 486
;IHS/SD/SDR-2.6*3-POA changes-removed insurer type "R" check
;IHS/SD/SDR-2.6*14-ICD10 002F-Updated ICD indicator on form to 9 or 0
;IHS/SD/SDR-2.6*16-HEAT236243-Moved dt for box 74 so there is space between PX code and date.
;IHS/SD/SDR 2.6*21 Split routine to ABMDF28T due to size.
;IHS/SD/SDR-2.6*21 HEAT97615 Remove ID qualifier and ID from box 76 if Medicare is active and tribal
;IHS/SD/SDR-2.6*21 HEAT123457 changed 61044 references from 'equals' to 'contains'
;IHS/SD/SDR-2.6*21 HEAT128931 FL64 wasn't printing when insurer uses plan name
;IHS/SD/SDR-2.6*21 HEAT162190 Print taxnomoy in 81 for Montana DPHHS.
;IHS/SD/SDR-2.6*21 HEAT189659 Print taxonomy in 81 for SD Medicaid.
;IHS/SD/SDR-2.6*21 HEAT217449-Moved box 76 one char left. Was only printing 7 of 8 chars of prov id.
; self-insured has already been billed.
;IHS/SD/SDR-2.6*21 VMBP Updated p11 changes to include Serena ref#s. Moved VA Station Number to correct field on form.
;IHS/SD/SDR 2.6*27 CR9867 Added code to check new parameter BILLING PRV TAXONOMY instead of hardcoding for specific insurers
;
45 ; ABMPAID = Primary + Secondary + Tertiary + Prepaid
; ABMPBAL = Gross amount - ABM("PAID")
; FL #57
;
47 ;
W !
N I
F I=1:1:3 D
.W !
.Q:'$D(ABMREC(30,I))
.S ABMDE=$E(ABMREC(30,I),111,130) ;Insured's last name
.S ABMDE=$TR(ABMDE," ")
.I $E(ABMREC(30,I),131,139)]"" S ABMDE=ABMDE_","_$TR($E(ABMREC(30,I),131,139)," ") ;Add First Name
.I $E(ABMREC(30,I),140)]"" S ABMDE=ABMDE_" "_$E(ABMREC(30,I),140) ;Add Middle Init
.S ABMDE=ABMDE_"^^25" ;Insured's Name
.D WRT^ABMDF28W ;FL #58
.S ABMDE=$E(ABMREC(30,I),144,145)_"^26^2" ;Pat relation to Ins
.D WRT^ABMDF28W ;FL #59
.S ABMDE=$E(ABMREC(30,I),35,53)_"^29^20" ;Claim Certificate ID
.;start new abm*2.6*11 HEAT86014
.I ("^T^W^"[(ABMP("ITYPE")))&(I=1) D
..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,13)'="" S ABMDE=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,13)_"^29^20" Q
..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,26)'="" S ABMDE=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,26)_"^29^20" Q
..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,8)'="" S ABMDE=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,8)_"^29^20"
.;end new HEAT86014
.;I ($P($G(ABMP("INS",I)),U,2)="V")&($P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)'="") S ABMDE=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)_"^29^20" ;abm*2.6*11 VMBP RQMT_94 ;abm*2.6*21 IHS/SD/SDR VMBP
.D WRT^ABMDF28W ;FL #60
.S ABMDE=$E(ABMREC(30,I),97,110)_"^49^14" ;Insured Group Name
.D WRT^ABMDF28W ;FL #61
.S ABMDE=$E(ABMREC(30,I),80,96)_"^64^16" ;Insurance Group Num
.D WRT^ABMDF28W ;FL #62
51 ;
W !
N I
F I=50:10:70 D
.D @(I_"^ABMER40A")
N I
F I=1:1:3 D
.W !
.Q:'$D(ABMREC(30,I))
.S ABMDE=ABMR(40,(10*I)+40)_"^^30" ;Pro Auth #
.I (($P($G(ABMP("INS",I)),U,2)="V")!(ABMREC(30,I)["VMBP"))&($P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)'="") S ABMDE=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)_"^^30" ;abm*2.6*11 VMBP RQMT_94 ;abm*2.6*21 IHS/SD/SDR VMBP
.D WRT^ABMDF28W ;FL #63
.;Document Control Number for active ins
.;I $E(ABMREC(30,I),54,78)=$$FMT^ABMERUTL($P($G(^AUTNINS(ABMP("INS"),0)),U),25) D ;abm*2.6*21 IHS/SD/SDR HEAT128931
.I +$G(ABMP("INS",I))=ABMP("INS") D ;abm*2.6*21 IHS/SD/SDR HEAT128931
..S ABMDE=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)_"^30^26"
..D WRT^ABMDF28W ;FL #64
.S ABMDE=$E(ABMREC(31,I),87,110)_"^57^20" ;Employer name
.D WRT^ABMDF28W ;FL #65
.S ABMTMPDE=$E(ABMREC(31,I),129,143) ;Employer city/state
.S ABMDE=$P(ABMTMPDE," ",1)
.N J
55 ;
D 55^ABMDF28T ;abm*2.6*20 IHS/SD/SDR split routine
;
56 ;
D 56^ABMDF28T ;abm*2.6*20 IHS/SD/SDR split routine
57 ;
D 57^ABMDF28T ;abm*2.6*20 IHS/SD/SDR split routine
58 ;
; Secondary Provider License #
W !
;Operating provider
;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
I $$RCID^ABMERUTL(ABMP("INS"))'["61044" D ;abm*2.6*21 IHS/SD/SDR HEAT123457
.I $D(ABM("PRV",2)) D
..I $P(ABM("PRV",2),U,4)'="" D
...S ABMDE=$P($P($G(ABM("PRV",2)),U,4),"#",2)_"^59^10" ;NPI
...D WRT^ABMDF28W ;FL #77
..S ABMDE=$P($P(ABM("PRV",2),U,3),"#")_"^71^2" ;ID qualifier
..D WRT^ABMDF28W ;FL #77
..S ABMDE=$P($P(ABM("PRV",2),U,3),"#",2)_"^73^9" ;ID
..D WRT^ABMDF28W ;FL #77
;Operating provider-attending if Medical
;I $$RCID^ABMERUTL(ABMP("INS"))=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
I $$RCID^ABMERUTL(ABMP("INS"))["61044" D ;abm*2.6*21 IHS/SD/SDR HEAT123457
.I $D(ABM("PRV",1)) D ;attending
..I $P(ABM("PRV",1),U,4)'="" D
...S ABMDE=$P($P($G(ABM("PRV",1)),U,4),"#",2)_"^59^10" ;NPI
...D WRT^ABMDF28W ;FL #77
..S ABMDE=$P($P(ABM("PRV",1),U,3),"#")_"^71^2" ;ID qualifier
..D WRT^ABMDF28W ;FL #77
..S ABMDE=$P($P(ABM("PRV",1),U,3),"#",2)_"^73^9" ;ID
..D WRT^ABMDF28W ;FL #77
.;start new abm*2.6*21 IHS/SD/SDR HEAT240744
.I '$D(ABM("PRV",1)) D ;no attending; check for rendering if dialysis billing
..I $P($G(^ABMDVTYP(ABMP("VTYP"),0)),U)'["DIALYSIS" Q
..I +$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","R",0))'=0 D ;there's a rendering
...S ABMPRV=+$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","R",0))
...S ABMPRV=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRV,0),U)
...I $P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0 D
....S ABMDE=$P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)_"^59^10"
....D WRT^ABMDF28W ;FL #77
.;end new abm*2.6*21 IHS/SD/SDR HEAT240744
59 ;
W !
;S ABMDE=ABMR(70,190)_"^2^7" ;Other Procedure code - 3 ;abm*2.6*16 IHS/SD/SDR HEAT236243
S ABMDE=ABMR(70,190)_"^0^7" ;Other Procedure code - 3 ;abm*2.6*16 IHS/SD/SDR HEAT236243
D WRT^ABMDF28W ;FL #81e
;S ABMDE=ABMR(70,200)_"^9^6" ;Other Procedure date - 3 ;abm*2.6*16 IHS/SD/SDR HEAT236243
S ABMDE=ABMR(70,200)_"^8^6" ;Other Procedure date - 3 ;abm*2.6*16 IHS/SD/SDR HEAT236243
D WRT^ABMDF28W ;FL #81f
;S ABMDE=ABMR(70,210)_"^16^7" ;Other Procedure code - 4 ;abm*2.6*16 IHS/SD/SDR HEAT236243
S ABMDE=ABMR(70,210)_"^15^7" ;Other Procedure code - 4 ;abm*2.6*16 IHS/SD/SDR HEAT236243
D WRT^ABMDF28W ;FL #81g
;S ABMDE=ABMR(70,220)_"^24^6" ;Other Procedure date - 4 ;abm*2.6*16 IHS/SD/SDR HEAT236243
S ABMDE=ABMR(70,220)_"^23^6" ;Other Procedure date - 4 ;abm*2.6*16 IHS/SD/SDR HEAT236243
D WRT^ABMDF28W ;FL #81h
;S ABMDE=ABMR(70,230)_"^31^7" ;Other Procedure code - 5 ;abm*2.6*16 IHS/SD/SDR HEAT236243
S ABMDE=ABMR(70,230)_"^30^7" ;Other Procedure code - 5 ;abm*2.6*16 IHS/SD/SDR HEAT236243
D WRT^ABMDF28W ;FL #81i
;S ABMDE=ABMR(70,240)_"^39^6" ;Other Procedure date - 5 ;abm*2.6*16 IHS/SD/SDR HEAT236243
S ABMDE=ABMR(70,240)_"^38^6" ;Other Procedure date - 5 ;abm*2.6*16 IHS/SD/SDR HEAT236243
D WRT^ABMDF28W ;FL #81j
;Operating Provider name
;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
I $$RCID^ABMERUTL(ABMP("INS"))'["61044" D ;abm*2.6*21 IHS/SD/SDR HEAT123457
.S ABMDE=$P($P($G(ABM("PRV",2)),U),",")_"^53^15"
.D WRT^ABMDF28W ;FL #77
.S ABMDE=$P($P($G(ABM("PRV",2)),U),",",2)_"^70^11"
.D WRT^ABMDF28W ;FL #77
60 ;
W !
S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,1,0))_"^^19" ; remarks line 1
;I (ABMP("ITYPE")="V")&($P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)'="") S ABMDE=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)_"^^19" ;abm*2.6*11 VMBP RQMT_94 ;abm*2.6*21 IHS/SD/SDR VMBP
I ((ABMP("ITYPE")="V")!($$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")["VMBP"))&($P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)'="") S ABMDE=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)_"^^19" ;abm*2.6*11 VMBP RQMT_94 ;abm*2.6*21 IHS/SD/SDR VMBP
D WRT^ABMDF28W ;FL #80
;
;If NM Medicaid add Taxonomy and qualifier
;I ($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT") D ;abm*2.6*8 NOHEAT - ADD TAX FOR IA MCD ONLY
;I ($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="IOWA MEDICAID") D ;abm*2.6*8 NOHEAT - ADD TAX FOR IA MCD ONLY ;abm*2.6*21 IHS/SD/SDR HEAT189659
;start old abm*2.6*27 IHS/SD/AML CR9867
;I "^NEW MEXICO MEDICAID^MEDICAID EXEMPT^IOWA MEDICAID^SOUTH DAKOTA MEDICAID^MONTANA DPHHS^"[("^"_$P($G(^AUTNINS(ABMP("INS"),0)),U)_"^") D ;abm*2.6*8 NOHEAT - ADD TAX FOR IA MCD ONLY ;abm*2.6*21 IHS/SD/SDR HEAT189659, HEAT162190
;.S ABMNLOC=$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(^(2),U,12),1:ABMP("LDFN")) ;abm*2.6*10 HEAT82967
;.;S ABMDE="B3"_$$PTAX^ABMUTLF(ABMP("LDFN")) ;taxonomy - form locator #81D ;abm*2.6*10 IHS/SD/AML 9/18/12 - HEAT82967
;.S ABMDE="B3"_$$PTAX^ABMUTLF(ABMNLOC) ;taxonomy - form locator #81D ;abm*2.6*10 IHS/SD/AML 9/18/12 - HEAT82967
;.S ABMDE=ABMDE_"^26^15"
;.D WRT^ABMDF28W
;end old start new abm*2.6*27 IHS/SD/AML,SDR CR9867
S ABM81FLG=""
S ABM81FLG=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,23)
S ABMNLOC=$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(^(2),U,12),1:ABMP("LDFN"))
S ABMNLOC=$$PTAX^ABMUTLF(ABMNLOC)
I ABM81FLG["3T" D
.S ABMDE="B3"_ABMNLOC ;taxonomy - form locator #81CC
I ABM81FLG["0T" D
.S ABMDE=" "_ABMNLOC ;taxonomy - form locator #81CC
S ABMDE=ABMDE_"^26^15"
D WRT^ABMDF28W
;end new abm*2.6*27 IHS/SD/AML,SDR CR9867
;
;abm*2.6*10 IHS/SD/AML 9/12/2012 HEAT83791 Begin changes
I ($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEBRASKA MEDICAID") D
.S ABMDE=" "_$$PTAX^ABMUTLF(ABMP("LDFN"))
.S ABMDE=ABMDE_"^26^15"
.D WRT^ABMDF28W ;FL 81D, Line 1
;abm*2.6*10 IHS/SD/AML 9/11/12 HEAT83791 End changes
;
;Other provider (1)
;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
I $$RCID^ABMERUTL(ABMP("INS"))'["61044" D ;abm*2.6*21 IHS/SD/SDR HEAT123457
.I $D(ABM("PRV",3)) D
..I $P(ABM("PRV",3),U,4)'="" D
...S ABMDE=$P($P($G(ABM("PRV",3)),U,4),"#")_"^55^2" ;NPI qualifier
...D WRT^ABMDF28W ;FL #78
...S ABMDE=$P($P($G(ABM("PRV",3)),U,4),"#",2)_"^59^10" ;NPI
...D WRT^ABMDF28W ;FL #78
..S ABMDE=$P($P(ABM("PRV",3),U,3),"#")_"^71^2" ;ID qualifier
..D WRT^ABMDF28W ;FL #78
..S ABMDE=$P($P(ABM("PRV",3),U,3),"#",2)_"^73^9" ;ID
..D WRT^ABMDF28W ;FL #78
61 ;
W !
S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,2,0))_"^^24" ; remarks line 2
D WRT^ABMDF28W ; FL #80
;
;abm*2.6*10 IHS/SD/AML 9/11/2012 - BEGIN HEAT83791 - Winnebago Claim Form Modifications
I ($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEBRASKA MEDICAID") D
.I $D(^DIC(4,ABMP("LDFN"),1)) D
..S ABMVLOC=$G(^DIC(4,ABMP("LDFN"),1))
..S ABMLZIP=$P(ABMVLOC,U,4)
..S ABMDE=" "_ABMLZIP_"^26^15"
..D WRT^ABMDF28W ; FL #81D Line 2
;abm*2.6*10 IHS/SD/AML 9/11/12 - END HEAT83791 - Winnebago claim form modifications
;
;Other Provider name (1)
;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
I $$RCID^ABMERUTL(ABMP("INS"))'["61044" D ;abm*2.6*21 IHS/SD/SDR HEAT123457
.S ABMDE=$P($P($G(ABM("PRV",3)),U),",")_"^53^15"
.D WRT^ABMDF28W ;FL #78
.S ABMDE=$P($P($G(ABM("PRV",3)),U),",",2)_"^70^11"
.D WRT^ABMDF28W ;FL #78
62 ;
W !
S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,3,0))_"^^24" ; remarks line 3
D WRT^ABMDF28W ;FL #80
;
;Other provider (2)
;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
I $$RCID^ABMERUTL(ABMP("INS"))'["61044" D ;abm*2.6*21 IHS/SD/SDR HEAT123457
.I $D(ABM("PRV",4)) D
..I $P(ABM("PRV",4),U,4)'="" D
...S ABMDE=$P($P($G(ABM("PRV",4)),U,4),"#")_"^54^2" ;NPI qualifier
...D WRT^ABMDF28W ; FL #79
...S ABMDE=$P($P($G(ABM("PRV",4)),U,4),"#",2)_"^57^10" ;NPI
...D WRT^ABMDF28W ; FL #79
..S ABMDE=$P($P(ABM("PRV",4),U,3),"#")_"^70^2" ;ID qualifier
..D WRT^ABMDF28W ; FL #79
..S ABMDE=$P($P(ABM("PRV",4),U,3),"#",2)_"^72^9" ;ID
..D WRT^ABMDF28W ; FL #79
63 ;
W !
S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,4,0))_"^^24" ; remarks line 4
D WRT^ABMDF28W ; FL #80
;
;Other Provider name (2)
;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
I $$RCID^ABMERUTL(ABMP("INS"))'["61044" D ;abm*2.6*21 IHS/SD/SDR HEAT123457
.S ABMDE=$P($P($G(ABM("PRV",4)),U),",")_"^53^15"
.D WRT^ABMDF28W ; FL #79
.S ABMDE=$P($P($G(ABM("PRV",4)),U),",",2)_"^69^11"
.D WRT^ABMDF28W ; FL #79
Q
ABMDF28Z ; IHS/SD/SDR - PRINT UB-04 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**3,8,9,10,11,14,16,21,27**;NOV 12, 2009;Build 486
+2 ;IHS/SD/SDR-2.6*3-POA changes-removed insurer type "R" check
+3 ;IHS/SD/SDR-2.6*14-ICD10 002F-Updated ICD indicator on form to 9 or 0
+4 ;IHS/SD/SDR-2.6*16-HEAT236243-Moved dt for box 74 so there is space between PX code and date.
+5 ;IHS/SD/SDR 2.6*21 Split routine to ABMDF28T due to size.
+6 ;IHS/SD/SDR-2.6*21 HEAT97615 Remove ID qualifier and ID from box 76 if Medicare is active and tribal
+7 ;IHS/SD/SDR-2.6*21 HEAT123457 changed 61044 references from 'equals' to 'contains'
+8 ;IHS/SD/SDR-2.6*21 HEAT128931 FL64 wasn't printing when insurer uses plan name
+9 ;IHS/SD/SDR-2.6*21 HEAT162190 Print taxnomoy in 81 for Montana DPHHS.
+10 ;IHS/SD/SDR-2.6*21 HEAT189659 Print taxonomy in 81 for SD Medicaid.
+11 ;IHS/SD/SDR-2.6*21 HEAT217449-Moved box 76 one char left. Was only printing 7 of 8 chars of prov id.
+12 ; self-insured has already been billed.
+13 ;IHS/SD/SDR-2.6*21 VMBP Updated p11 changes to include Serena ref#s. Moved VA Station Number to correct field on form.
+14 ;IHS/SD/SDR 2.6*27 CR9867 Added code to check new parameter BILLING PRV TAXONOMY instead of hardcoding for specific insurers
+15 ;
45 ; ABMPAID = Primary + Secondary + Tertiary + Prepaid
+1 ; ABMPBAL = Gross amount - ABM("PAID")
+2 ; FL #57
+3 ;
47 ;
+1 WRITE !
+2 NEW I
+3 FOR I=1:1:3
Begin DoDot:1
+4 WRITE !
+5 IF '$DATA(ABMREC(30,I))
QUIT
+6 ;Insured's last name
SET ABMDE=$EXTRACT(ABMREC(30,I),111,130)
+7 SET ABMDE=$TRANSLATE(ABMDE," ")
+8 ;Add First Name
IF $EXTRACT(ABMREC(30,I),131,139)]""
SET ABMDE=ABMDE_","_$TRANSLATE($EXTRACT(ABMREC(30,I),131,139)," ")
+9 ;Add Middle Init
IF $EXTRACT(ABMREC(30,I),140)]""
SET ABMDE=ABMDE_" "_$EXTRACT(ABMREC(30,I),140)
+10 ;Insured's Name
SET ABMDE=ABMDE_"^^25"
+11 ;FL #58
DO WRT^ABMDF28W
+12 ;Pat relation to Ins
SET ABMDE=$EXTRACT(ABMREC(30,I),144,145)_"^26^2"
+13 ;FL #59
DO WRT^ABMDF28W
+14 ;Claim Certificate ID
SET ABMDE=$EXTRACT(ABMREC(30,I),35,53)_"^29^20"
+15 ;start new abm*2.6*11 HEAT86014
+16 IF ("^T^W^"[(ABMP("ITYPE")))&(I=1)
Begin DoDot:2
+17 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,13)'=""
SET ABMDE=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,13)_"^29^20"
QUIT
+18 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,26)'=""
SET ABMDE=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,26)_"^29^20"
QUIT
+19 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,8)'=""
SET ABMDE=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,8)_"^29^20"
End DoDot:2
+20 ;end new HEAT86014
+21 ;I ($P($G(ABMP("INS",I)),U,2)="V")&($P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)'="") S ABMDE=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)_"^29^20" ;abm*2.6*11 VMBP RQMT_94 ;abm*2.6*21 IHS/SD/SDR VMBP
+22 ;FL #60
DO WRT^ABMDF28W
+23 ;Insured Group Name
SET ABMDE=$EXTRACT(ABMREC(30,I),97,110)_"^49^14"
+24 ;FL #61
DO WRT^ABMDF28W
+25 ;Insurance Group Num
SET ABMDE=$EXTRACT(ABMREC(30,I),80,96)_"^64^16"
+26 ;FL #62
DO WRT^ABMDF28W
End DoDot:1
51 ;
+1 WRITE !
+2 NEW I
+3 FOR I=50:10:70
Begin DoDot:1
+4 DO @(I_"^ABMER40A")
End DoDot:1
+5 NEW I
+6 FOR I=1:1:3
Begin DoDot:1
+7 WRITE !
+8 IF '$DATA(ABMREC(30,I))
QUIT
+9 ;Pro Auth #
SET ABMDE=ABMR(40,(10*I)+40)_"^^30"
+10 ;abm*2.6*11 VMBP RQMT_94 ;abm*2.6*21 IHS/SD/SDR VMBP
IF (($PIECE($GET(ABMP("INS",I)),U,2)="V")!(ABMREC(30,I)["VMBP"))&($PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)'="")
SET ABMDE=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)_"^^30"
+11 ;FL #63
DO WRT^ABMDF28W
+12 ;Document Control Number for active ins
+13 ;I $E(ABMREC(30,I),54,78)=$$FMT^ABMERUTL($P($G(^AUTNINS(ABMP("INS"),0)),U),25) D ;abm*2.6*21 IHS/SD/SDR HEAT128931
+14 ;abm*2.6*21 IHS/SD/SDR HEAT128931
IF +$GET(ABMP("INS",I))=ABMP("INS")
Begin DoDot:2
+15 SET ABMDE=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)_"^30^26"
+16 ;FL #64
DO WRT^ABMDF28W
End DoDot:2
+17 ;Employer name
SET ABMDE=$EXTRACT(ABMREC(31,I),87,110)_"^57^20"
+18 ;FL #65
DO WRT^ABMDF28W
+19 ;Employer city/state
SET ABMTMPDE=$EXTRACT(ABMREC(31,I),129,143)
+20 SET ABMDE=$PIECE(ABMTMPDE," ",1)
+21 NEW J
End DoDot:1
55 ;
+1 ;abm*2.6*20 IHS/SD/SDR split routine
DO 55^ABMDF28T
+2 ;
56 ;
+1 ;abm*2.6*20 IHS/SD/SDR split routine
DO 56^ABMDF28T
57 ;
+1 ;abm*2.6*20 IHS/SD/SDR split routine
DO 57^ABMDF28T
58 ;
+1 ; Secondary Provider License #
+2 WRITE !
+3 ;Operating provider
+4 ;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
+5 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMERUTL(ABMP("INS"))'["61044"
Begin DoDot:1
+6 IF $DATA(ABM("PRV",2))
Begin DoDot:2
+7 IF $PIECE(ABM("PRV",2),U,4)'=""
Begin DoDot:3
+8 ;NPI
SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",2)),U,4),"#",2)_"^59^10"
+9 ;FL #77
DO WRT^ABMDF28W
End DoDot:3
+10 ;ID qualifier
SET ABMDE=$PIECE($PIECE(ABM("PRV",2),U,3),"#")_"^71^2"
+11 ;FL #77
DO WRT^ABMDF28W
+12 ;ID
SET ABMDE=$PIECE($PIECE(ABM("PRV",2),U,3),"#",2)_"^73^9"
+13 ;FL #77
DO WRT^ABMDF28W
End DoDot:2
End DoDot:1
+14 ;Operating provider-attending if Medical
+15 ;I $$RCID^ABMERUTL(ABMP("INS"))=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
+16 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMERUTL(ABMP("INS"))["61044"
Begin DoDot:1
+17 ;attending
IF $DATA(ABM("PRV",1))
Begin DoDot:2
+18 IF $PIECE(ABM("PRV",1),U,4)'=""
Begin DoDot:3
+19 ;NPI
SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",1)),U,4),"#",2)_"^59^10"
+20 ;FL #77
DO WRT^ABMDF28W
End DoDot:3
+21 ;ID qualifier
SET ABMDE=$PIECE($PIECE(ABM("PRV",1),U,3),"#")_"^71^2"
+22 ;FL #77
DO WRT^ABMDF28W
+23 ;ID
SET ABMDE=$PIECE($PIECE(ABM("PRV",1),U,3),"#",2)_"^73^9"
+24 ;FL #77
DO WRT^ABMDF28W
End DoDot:2
+25 ;start new abm*2.6*21 IHS/SD/SDR HEAT240744
+26 ;no attending; check for rendering if dialysis billing
IF '$DATA(ABM("PRV",1))
Begin DoDot:2
+27 IF $PIECE($GET(^ABMDVTYP(ABMP("VTYP"),0)),U)'["DIALYSIS"
QUIT
+28 ;there's a rendering
IF +$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","R",0))'=0
Begin DoDot:3
+29 SET ABMPRV=+$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","R",0))
+30 SET ABMPRV=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRV,0),U)
+31 IF $PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0
Begin DoDot:4
+32 SET ABMDE=$PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)_"^59^10"
+33 ;FL #77
DO WRT^ABMDF28W
End DoDot:4
End DoDot:3
End DoDot:2
+34 ;end new abm*2.6*21 IHS/SD/SDR HEAT240744
End DoDot:1
59 ;
+1 WRITE !
+2 ;S ABMDE=ABMR(70,190)_"^2^7" ;Other Procedure code - 3 ;abm*2.6*16 IHS/SD/SDR HEAT236243
+3 ;Other Procedure code - 3 ;abm*2.6*16 IHS/SD/SDR HEAT236243
SET ABMDE=ABMR(70,190)_"^0^7"
+4 ;FL #81e
DO WRT^ABMDF28W
+5 ;S ABMDE=ABMR(70,200)_"^9^6" ;Other Procedure date - 3 ;abm*2.6*16 IHS/SD/SDR HEAT236243
+6 ;Other Procedure date - 3 ;abm*2.6*16 IHS/SD/SDR HEAT236243
SET ABMDE=ABMR(70,200)_"^8^6"
+7 ;FL #81f
DO WRT^ABMDF28W
+8 ;S ABMDE=ABMR(70,210)_"^16^7" ;Other Procedure code - 4 ;abm*2.6*16 IHS/SD/SDR HEAT236243
+9 ;Other Procedure code - 4 ;abm*2.6*16 IHS/SD/SDR HEAT236243
SET ABMDE=ABMR(70,210)_"^15^7"
+10 ;FL #81g
DO WRT^ABMDF28W
+11 ;S ABMDE=ABMR(70,220)_"^24^6" ;Other Procedure date - 4 ;abm*2.6*16 IHS/SD/SDR HEAT236243
+12 ;Other Procedure date - 4 ;abm*2.6*16 IHS/SD/SDR HEAT236243
SET ABMDE=ABMR(70,220)_"^23^6"
+13 ;FL #81h
DO WRT^ABMDF28W
+14 ;S ABMDE=ABMR(70,230)_"^31^7" ;Other Procedure code - 5 ;abm*2.6*16 IHS/SD/SDR HEAT236243
+15 ;Other Procedure code - 5 ;abm*2.6*16 IHS/SD/SDR HEAT236243
SET ABMDE=ABMR(70,230)_"^30^7"
+16 ;FL #81i
DO WRT^ABMDF28W
+17 ;S ABMDE=ABMR(70,240)_"^39^6" ;Other Procedure date - 5 ;abm*2.6*16 IHS/SD/SDR HEAT236243
+18 ;Other Procedure date - 5 ;abm*2.6*16 IHS/SD/SDR HEAT236243
SET ABMDE=ABMR(70,240)_"^38^6"
+19 ;FL #81j
DO WRT^ABMDF28W
+20 ;Operating Provider name
+21 ;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
+22 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMERUTL(ABMP("INS"))'["61044"
Begin DoDot:1
+23 SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",2)),U),",")_"^53^15"
+24 ;FL #77
DO WRT^ABMDF28W
+25 SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",2)),U),",",2)_"^70^11"
+26 ;FL #77
DO WRT^ABMDF28W
End DoDot:1
60 ;
+1 WRITE !
+2 ; remarks line 1
SET ABMDE=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,1,0))_"^^19"
+3 ;I (ABMP("ITYPE")="V")&($P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)'="") S ABMDE=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)_"^^19" ;abm*2.6*11 VMBP RQMT_94 ;abm*2.6*21 IHS/SD/SDR VMBP
+4 ;abm*2.6*11 VMBP RQMT_94 ;abm*2.6*21 IHS/SD/SDR VMBP
IF ((ABMP("ITYPE")="V")!($$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")["VMBP"))&($PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)'="")
SET ABMDE=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)_"^^19"
+5 ;FL #80
DO WRT^ABMDF28W
+6 ;
+7 ;If NM Medicaid add Taxonomy and qualifier
+8 ;I ($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT") D ;abm*2.6*8 NOHEAT - ADD TAX FOR IA MCD ONLY
+9 ;I ($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="IOWA MEDICAID") D ;abm*2.6*8 NOHEAT - ADD TAX FOR IA MCD ONLY ;abm*2.6*21 IHS/SD/SDR HEAT189
659
+10 ;start old abm*2.6*27 IHS/SD/AML CR9867
+11 ;I "^NEW MEXICO MEDICAID^MEDICAID EXEMPT^IOWA MEDICAID^SOUTH DAKOTA MEDICAID^MONTANA DPHHS^"[("^"_$P($G(^AUTNINS(ABMP("INS"),0)),U)_"^") D ;abm*2.6*8 NOHEAT - ADD TAX FOR IA MCD ONLY ;abm*2.6*21 IHS/SD/SDR HEAT189659, HEAT162190
+12 ;.S ABMNLOC=$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(^(2),U,12),1:ABMP("LDFN")) ;abm*2.6*10 HEAT82967
+13 ;.;S ABMDE="B3"_$$PTAX^ABMUTLF(ABMP("LDFN")) ;taxonomy - form locator #81D ;abm*2.6*10 IHS/SD/AML 9/18/12 - HEAT82967
+14 ;.S ABMDE="B3"_$$PTAX^ABMUTLF(ABMNLOC) ;taxonomy - form locator #81D ;abm*2.6*10 IHS/SD/AML 9/18/12 - HEAT82967
+15 ;.S ABMDE=ABMDE_"^26^15"
+16 ;.D WRT^ABMDF28W
+17 ;end old start new abm*2.6*27 IHS/SD/AML,SDR CR9867
+18 SET ABM81FLG=""
+19 SET ABM81FLG=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,23)
+20 SET ABMNLOC=$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$PIECE(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$PIECE(^(2),U,12),1:ABMP("LDFN"))
+21 SET ABMNLOC=$$PTAX^ABMUTLF(ABMNLOC)
+22 IF ABM81FLG["3T"
Begin DoDot:1
+23 ;taxonomy - form locator #81CC
SET ABMDE="B3"_ABMNLOC
End DoDot:1
+24 IF ABM81FLG["0T"
Begin DoDot:1
+25 ;taxonomy - form locator #81CC
SET ABMDE=" "_ABMNLOC
End DoDot:1
+26 SET ABMDE=ABMDE_"^26^15"
+27 DO WRT^ABMDF28W
+28 ;end new abm*2.6*27 IHS/SD/AML,SDR CR9867
+29 ;
+30 ;abm*2.6*10 IHS/SD/AML 9/12/2012 HEAT83791 Begin changes
+31 IF ($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="NEBRASKA MEDICAID")
Begin DoDot:1
+32 SET ABMDE=" "_$$PTAX^ABMUTLF(ABMP("LDFN"))
+33 SET ABMDE=ABMDE_"^26^15"
+34 ;FL 81D, Line 1
DO WRT^ABMDF28W
End DoDot:1
+35 ;abm*2.6*10 IHS/SD/AML 9/11/12 HEAT83791 End changes
+36 ;
+37 ;Other provider (1)
+38 ;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
+39 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMERUTL(ABMP("INS"))'["61044"
Begin DoDot:1
+40 IF $DATA(ABM("PRV",3))
Begin DoDot:2
+41 IF $PIECE(ABM("PRV",3),U,4)'=""
Begin DoDot:3
+42 ;NPI qualifier
SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",3)),U,4),"#")_"^55^2"
+43 ;FL #78
DO WRT^ABMDF28W
+44 ;NPI
SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",3)),U,4),"#",2)_"^59^10"
+45 ;FL #78
DO WRT^ABMDF28W
End DoDot:3
+46 ;ID qualifier
SET ABMDE=$PIECE($PIECE(ABM("PRV",3),U,3),"#")_"^71^2"
+47 ;FL #78
DO WRT^ABMDF28W
+48 ;ID
SET ABMDE=$PIECE($PIECE(ABM("PRV",3),U,3),"#",2)_"^73^9"
+49 ;FL #78
DO WRT^ABMDF28W
End DoDot:2
End DoDot:1
61 ;
+1 WRITE !
+2 ; remarks line 2
SET ABMDE=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,2,0))_"^^24"
+3 ; FL #80
DO WRT^ABMDF28W
+4 ;
+5 ;abm*2.6*10 IHS/SD/AML 9/11/2012 - BEGIN HEAT83791 - Winnebago Claim Form Modifications
+6 IF ($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="NEBRASKA MEDICAID")
Begin DoDot:1
+7 IF $DATA(^DIC(4,ABMP("LDFN"),1))
Begin DoDot:2
+8 SET ABMVLOC=$GET(^DIC(4,ABMP("LDFN"),1))
+9 SET ABMLZIP=$PIECE(ABMVLOC,U,4)
+10 SET ABMDE=" "_ABMLZIP_"^26^15"
+11 ; FL #81D Line 2
DO WRT^ABMDF28W
End DoDot:2
End DoDot:1
+12 ;abm*2.6*10 IHS/SD/AML 9/11/12 - END HEAT83791 - Winnebago claim form modifications
+13 ;
+14 ;Other Provider name (1)
+15 ;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
+16 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMERUTL(ABMP("INS"))'["61044"
Begin DoDot:1
+17 SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",3)),U),",")_"^53^15"
+18 ;FL #78
DO WRT^ABMDF28W
+19 SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",3)),U),",",2)_"^70^11"
+20 ;FL #78
DO WRT^ABMDF28W
End DoDot:1
62 ;
+1 WRITE !
+2 ; remarks line 3
SET ABMDE=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,3,0))_"^^24"
+3 ;FL #80
DO WRT^ABMDF28W
+4 ;
+5 ;Other provider (2)
+6 ;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
+7 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMERUTL(ABMP("INS"))'["61044"
Begin DoDot:1
+8 IF $DATA(ABM("PRV",4))
Begin DoDot:2
+9 IF $PIECE(ABM("PRV",4),U,4)'=""
Begin DoDot:3
+10 ;NPI qualifier
SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",4)),U,4),"#")_"^54^2"
+11 ; FL #79
DO WRT^ABMDF28W
+12 ;NPI
SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",4)),U,4),"#",2)_"^57^10"
+13 ; FL #79
DO WRT^ABMDF28W
End DoDot:3
+14 ;ID qualifier
SET ABMDE=$PIECE($PIECE(ABM("PRV",4),U,3),"#")_"^70^2"
+15 ; FL #79
DO WRT^ABMDF28W
+16 ;ID
SET ABMDE=$PIECE($PIECE(ABM("PRV",4),U,3),"#",2)_"^72^9"
+17 ; FL #79
DO WRT^ABMDF28W
End DoDot:2
End DoDot:1
63 ;
+1 WRITE !
+2 ; remarks line 4
SET ABMDE=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,4,0))_"^^24"
+3 ; FL #80
DO WRT^ABMDF28W
+4 ;
+5 ;Other Provider name (2)
+6 ;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
+7 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMERUTL(ABMP("INS"))'["61044"
Begin DoDot:1
+8 SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",4)),U),",")_"^53^15"
+9 ; FL #79
DO WRT^ABMDF28W
+10 SET ABMDE=$PIECE($PIECE($GET(ABM("PRV",4)),U),",",2)_"^69^11"
+11 ; FL #79
DO WRT^ABMDF28W
End DoDot:1
+12 QUIT
