- 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
