ABMDF28T ; IHS/SD/SDR - PRINT UB-04 ;
;;2.6;IHS 3P BILLING SYSTEM;**3,8,9,10,11,14,16,21**;NOV 12, 2009;Build 379
;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 from ABMDF28Z 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.
;
55 ;
W !
N I
F I=40:10:120 D
.D @(I_"^ABMER70A")
N I
F I=250,260,290,300 D
.D @(I_"^ABMER70")
S ABMDE=ABMR(70,40)_"^1^7" ;Principle DX
D WRT^ABMDF28W ;FL #67
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,40,"POA")'=1:$G(ABMR(70,40,"POA")),1:"")_"^8^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,50)_"^9^7" ;Other DX 1
D WRT^ABMDF28W ;FL #67a
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,50,"POA")'=1:$G(ABMR(70,50,"POA")),1:"")_"^16^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,60)_"^17^7" ;Other DX 2
D WRT^ABMDF28W ;FL #67b
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,60,"POA")'=1:$G(ABMR(70,60,"POA")),1:"")_"^24^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,70)_"^25^7" ;Other DX 3
D WRT^ABMDF28W ;FL #67c
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,70,"POA")'=1:$G(ABMR(70,70,"POA")),1:"")_"^32^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,80)_"^33^7" ;Other DX 4
D WRT^ABMDF28W ;FL #67d
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,80,"POA")'=1:$G(ABMR(70,80,"POA")),1:"")_"^40^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,90)_"^41^7" ;Other DX 5
D WRT^ABMDF28W ;FL #67e
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,90,"POA")'=1:$G(ABMR(70,90,"POA")),1:"")_"^48^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,100)_"^49^7" ;Other DX 6
D WRT^ABMDF28W ;FL #67f
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,100,"POA")'=1:$G(ABMR(70,100,"POA")),1:"")_"^56^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,110)_"^57^7" ;Other DX 7
D WRT^ABMDF28W ;FL #67g
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,110,"POA")'=1:$G(ABMR(70,110,"POA")),1:"")_"^64^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,120)_"^65^7" ;Other DX 8
D WRT^ABMDF28W ;FL #67h
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,120,"POA")'=1:$G(ABMR(70,120,"POA")),1:"")_"^72^1"
D WRT^ABMDF28W ;FL #67 POA
F I=130:10:200 D
.D @(I_"^ABMER70A")
W !
;S ABMDE="9^^1" ;DX Version Qualifier-always 9 ;abm*2.6*14 ICD10 002F
S ABMDE=$S(+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,21)=10:"0",1:"9")_"^^1" ;DX Version Qualifier -9 for ICD9; 0 for ICD10 ;abm*2.6*14 ICD10 002F
D WRT^ABMDF28W ;FL #66
S ABMDE=ABMR(70,130)_"^1^7" ;Other DX 9
D WRT^ABMDF28W ;FL #67i
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,130,"POA")'=1:$G(ABMR(70,130,"POA")),1:"")_"^8^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,140)_"^9^7" ;Other DX 10
D WRT^ABMDF28W ;FL #67j
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,140,"POA")'=1:$G(ABMR(70,140,"POA")),1:"")_"^16^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,150)_"^17^7" ;Other DX 11
D WRT^ABMDF28W ;FL #67k
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,150,"POA")'=1:$G(ABMR(70,150,"POA")),1:"")_"^24^1"
D WRT^ABMDF28W ; FL #67 POA
S ABMDE=ABMR(70,160)_"^25^7" ;Other DX 12
D WRT^ABMDF28W ;FL #67l
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,160,"POA")'=1:$G(ABMR(70,160,"POA")),1:"")_"^32^1"
D WRT^ABMDF28W ; FL #67 POA
S ABMDE=ABMR(70,170)_"^33^7" ;Other DX 13
D WRT^ABMDF28W ;FL #67m
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,170,"POA")'=1:$G(ABMR(70,170,"POA")),1:"")_"^40^1"
D WRT^ABMDF28W ; FL #67 POA
S ABMDE=ABMR(70,180)_"^41^7" ;Other DX 14
D WRT^ABMDF28W ;FL #67n
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,180,"POA")'=1:$G(ABMR(70,180,"POA")),1:"")_"^48^1"
D WRT^ABMDF28W ; FL #67 POA
S ABMDE=ABMR(70,190)_"^49^7" ;Other DX 15
D WRT^ABMDF28W ;FL #67o
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,190,"POA")'=1:$G(ABMR(70,190,"POA")),1:"")_"^56^1"
D WRT^ABMDF28W ; FL #67 POA
S ABMDE=ABMR(70,200)_"^57^7" ;Other DX 16
D WRT^ABMDF28W ;FL #67p
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,200,"POA")'=1:$G(ABMR(70,200,"POA")),1:"")_"^64^1"
D WRT^ABMDF28W ; FL #67 POA
W !
;
S ABMDE=ABMR(70,250)_"^4^7" ;Admitting DX
D WRT^ABMDF28W ;FL #69
S ABMDE=ABMR(70,250)_"^17^7" ;Pt Reason Dx
D WRT^ABMDF28W ;FL #70
;
S ABMDE=ABMR(70,260)_"^48^7" ;Ext. cause of injury (1)
D WRT^ABMDF28W ;FL #72
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,260,"POA")'=1:$G(ABMR(70,260,"POA")),1:"")_"^55^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,290)_"^56^7" ;Ext. cause of injury (2)
D WRT^ABMDF28W ;FL #72
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,290,"POA")'=1:$G(ABMR(70,290,"POA")),1:"")_"^63^1"
D WRT^ABMDF28W ;FL #67 POA
S ABMDE=ABMR(70,300)_"^64^7" ;Ext. cause of injury (3)
D WRT^ABMDF28W ;FL #72
;I ABMP("ITYPE")="R" D
S ABMDE=$S(ABMR(70,300,"POA")'=1:$G(ABMR(70,300,"POA")),1:"")_"^71^1"
D WRT^ABMDF28W ;FL #67 POA
;
Q
56 ;
W !
D PROV^ABMDF28W
;Attending Prov
;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 $P(ABM("PRV",1),U,4)'="" D
..S ABMDE=$P($P(ABM("PRV",1),U,4),"#",2)_"^59^10" ;NPI
..I $P($G(^AUTNINS(ABMP("INS"),0)),U)="MONTANA DPHHS" S ABMDE=$P($P(ABM("PRV",1),U,4),"#",2)_"^57^10" ;NPI ;abm*2.6*21 IHS/SD/SDR HEAT162190
..D WRT^ABMDF28W ;FL #76
.;don't print 76 ID qual and ID if Medicare and Tribal Self-Insured
.I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)=2,$G(ABMTSIFG)=1 Q ;abm*2.6*21 IHS/SD/SDR HEAT97615
.;S ABMDE=$P($P(ABM("PRV",1),U,3),"#")_"^71^2" ;ID qualifier ;abm*2.6*21 IHS/SD/SDR HEAT217449
.S ABMDE=$P($P(ABM("PRV",1),U,3),"#")_"^70^2" ;ID qualifier ;abm*2.6*21 IHS/SD/SDR HEAT217449
.I DUZ("2")=1157 S ABMDE="^71^2" ;IHS/SD/AML HEAT46786 - Remove ID Qualifier
.I $P($G(^AUTNINS(ABMP("INS"),0)),U)="MONTANA DPHHS" S ABMDE="ZZ^68^2" ;abm*2.6*21 IHS/SD/SDR HEAT162190
.D WRT^ABMDF28W ;FL #76
.;S ABMDE=$P($P(ABM("PRV",1),U,3),"#",2)_"^73^9" ;ID ;abm*2.6*21 IHS/SD/SDR HEAT217449
.S ABMDE=$P($P(ABM("PRV",1),U,3),"#",2)_"^72^9" ;ID ;abm*2.6*21 IHS/SD/SDR HEAT217449
.I DUZ("2")=1157 S ABMDE="^73^9" ;IHS/SD/AML HEAT46786 - Remove ID
.I $P($G(^AUTNINS(ABMP("INS"),0)),U)="MONTANA DPHHS" S ABMDE="261QR1300X^70^10" ;abm*2.6*21 IHS/SD/SDR HEAT162190
.D WRT^ABMDF28W ;FL #76
;start new abm*2.6*21 IHS/SD/SDR HEAT240744
I ($$RCID^ABMERUTL(ABMP("INS"))["61044")&($P($G(^ABMDVTYP(ABMP("VTYP"),0)),U)["DIALYSIS")&(+$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","F",0))'=0) D ;Medi-Cal, Dialysis, and a referring provider
.S ABMPRV=+$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","F",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 #76
;end new abm*2.6*21 IHS/SD/SDR HEAT240744
Q
57 ;
W !
N I
F I=130:10:240,270 D
.D @(I_"^ABMER70")
I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,9)'="N" D
.;S ABMDE=$TR(ABMR(70,130),".")_"^1^7" ;Principle Procedure code ;abm*2.6*16 IHS/SD/SDR HEAT236243
.S ABMDE=$TR(ABMR(70,130),".")_"^0^7" ;Principle Procedure code ;abm*2.6*16 IHS/SD/SDR HEAT236243
.D WRT^ABMDF28W ;FL #74
.S ABMDE=ABMR(70,140)_"^8^6" ;Principle Procedure date
.D WRT^ABMDF28W ;FL #74a
.S ABMDE=$TR(ABMR(70,150),".")_"^15^7" ;Other Procedure code - 1
.D WRT^ABMDF28W ;FL #74b
.S ABMDE=ABMR(70,160)_"^23^6" ;Other Procedure date - 1
.D WRT^ABMDF28W ;FL #74c
.S ABMDE=$TR(ABMR(70,170),".")_"^30^7" ;Other Procedure code - 2
.D WRT^ABMDF28W ;FL #74d
.S ABMDE=ABMR(70,180)_"^38^6" ;Other Procedure date - 2
.D WRT^ABMDF28W ;FL #74e
;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(ABM("PRV",1),U),",")_"^53^15" ;Attending provider name
.D WRT^ABMDF28W ; FL #76
.S ABMDE=$P($P(ABM("PRV",1),U),",",2)_"^70^11" ;Attending provider name
.D WRT^ABMDF28W ; FL #76
Q
ABMDF28T ; IHS/SD/SDR - PRINT UB-04 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**3,8,9,10,11,14,16,21**;NOV 12, 2009;Build 379
+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 from ABMDF28Z 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 ;
55 ;
+1 WRITE !
+2 NEW I
+3 FOR I=40:10:120
Begin DoDot:1
+4 DO @(I_"^ABMER70A")
End DoDot:1
+5 NEW I
+6 FOR I=250,260,290,300
Begin DoDot:1
+7 DO @(I_"^ABMER70")
End DoDot:1
+8 ;Principle DX
SET ABMDE=ABMR(70,40)_"^1^7"
+9 ;FL #67
DO WRT^ABMDF28W
+10 ;I ABMP("ITYPE")="R" D
+11 SET ABMDE=$SELECT(ABMR(70,40,"POA")'=1:$GET(ABMR(70,40,"POA")),1:"")_"^8^1"
+12 ;FL #67 POA
DO WRT^ABMDF28W
+13 ;Other DX 1
SET ABMDE=ABMR(70,50)_"^9^7"
+14 ;FL #67a
DO WRT^ABMDF28W
+15 ;I ABMP("ITYPE")="R" D
+16 SET ABMDE=$SELECT(ABMR(70,50,"POA")'=1:$GET(ABMR(70,50,"POA")),1:"")_"^16^1"
+17 ;FL #67 POA
DO WRT^ABMDF28W
+18 ;Other DX 2
SET ABMDE=ABMR(70,60)_"^17^7"
+19 ;FL #67b
DO WRT^ABMDF28W
+20 ;I ABMP("ITYPE")="R" D
+21 SET ABMDE=$SELECT(ABMR(70,60,"POA")'=1:$GET(ABMR(70,60,"POA")),1:"")_"^24^1"
+22 ;FL #67 POA
DO WRT^ABMDF28W
+23 ;Other DX 3
SET ABMDE=ABMR(70,70)_"^25^7"
+24 ;FL #67c
DO WRT^ABMDF28W
+25 ;I ABMP("ITYPE")="R" D
+26 SET ABMDE=$SELECT(ABMR(70,70,"POA")'=1:$GET(ABMR(70,70,"POA")),1:"")_"^32^1"
+27 ;FL #67 POA
DO WRT^ABMDF28W
+28 ;Other DX 4
SET ABMDE=ABMR(70,80)_"^33^7"
+29 ;FL #67d
DO WRT^ABMDF28W
+30 ;I ABMP("ITYPE")="R" D
+31 SET ABMDE=$SELECT(ABMR(70,80,"POA")'=1:$GET(ABMR(70,80,"POA")),1:"")_"^40^1"
+32 ;FL #67 POA
DO WRT^ABMDF28W
+33 ;Other DX 5
SET ABMDE=ABMR(70,90)_"^41^7"
+34 ;FL #67e
DO WRT^ABMDF28W
+35 ;I ABMP("ITYPE")="R" D
+36 SET ABMDE=$SELECT(ABMR(70,90,"POA")'=1:$GET(ABMR(70,90,"POA")),1:"")_"^48^1"
+37 ;FL #67 POA
DO WRT^ABMDF28W
+38 ;Other DX 6
SET ABMDE=ABMR(70,100)_"^49^7"
+39 ;FL #67f
DO WRT^ABMDF28W
+40 ;I ABMP("ITYPE")="R" D
+41 SET ABMDE=$SELECT(ABMR(70,100,"POA")'=1:$GET(ABMR(70,100,"POA")),1:"")_"^56^1"
+42 ;FL #67 POA
DO WRT^ABMDF28W
+43 ;Other DX 7
SET ABMDE=ABMR(70,110)_"^57^7"
+44 ;FL #67g
DO WRT^ABMDF28W
+45 ;I ABMP("ITYPE")="R" D
+46 SET ABMDE=$SELECT(ABMR(70,110,"POA")'=1:$GET(ABMR(70,110,"POA")),1:"")_"^64^1"
+47 ;FL #67 POA
DO WRT^ABMDF28W
+48 ;Other DX 8
SET ABMDE=ABMR(70,120)_"^65^7"
+49 ;FL #67h
DO WRT^ABMDF28W
+50 ;I ABMP("ITYPE")="R" D
+51 SET ABMDE=$SELECT(ABMR(70,120,"POA")'=1:$GET(ABMR(70,120,"POA")),1:"")_"^72^1"
+52 ;FL #67 POA
DO WRT^ABMDF28W
+53 FOR I=130:10:200
Begin DoDot:1
+54 DO @(I_"^ABMER70A")
End DoDot:1
+55 WRITE !
+56 ;S ABMDE="9^^1" ;DX Version Qualifier-always 9 ;abm*2.6*14 ICD10 002F
+57 ;DX Version Qualifier -9 for ICD9; 0 for ICD10 ;abm*2.6*14 ICD10 002F
SET ABMDE=$SELECT(+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,21)=10:"0",1:"9")_"^^1"
+58 ;FL #66
DO WRT^ABMDF28W
+59 ;Other DX 9
SET ABMDE=ABMR(70,130)_"^1^7"
+60 ;FL #67i
DO WRT^ABMDF28W
+61 ;I ABMP("ITYPE")="R" D
+62 SET ABMDE=$SELECT(ABMR(70,130,"POA")'=1:$GET(ABMR(70,130,"POA")),1:"")_"^8^1"
+63 ;FL #67 POA
DO WRT^ABMDF28W
+64 ;Other DX 10
SET ABMDE=ABMR(70,140)_"^9^7"
+65 ;FL #67j
DO WRT^ABMDF28W
+66 ;I ABMP("ITYPE")="R" D
+67 SET ABMDE=$SELECT(ABMR(70,140,"POA")'=1:$GET(ABMR(70,140,"POA")),1:"")_"^16^1"
+68 ;FL #67 POA
DO WRT^ABMDF28W
+69 ;Other DX 11
SET ABMDE=ABMR(70,150)_"^17^7"
+70 ;FL #67k
DO WRT^ABMDF28W
+71 ;I ABMP("ITYPE")="R" D
+72 SET ABMDE=$SELECT(ABMR(70,150,"POA")'=1:$GET(ABMR(70,150,"POA")),1:"")_"^24^1"
+73 ; FL #67 POA
DO WRT^ABMDF28W
+74 ;Other DX 12
SET ABMDE=ABMR(70,160)_"^25^7"
+75 ;FL #67l
DO WRT^ABMDF28W
+76 ;I ABMP("ITYPE")="R" D
+77 SET ABMDE=$SELECT(ABMR(70,160,"POA")'=1:$GET(ABMR(70,160,"POA")),1:"")_"^32^1"
+78 ; FL #67 POA
DO WRT^ABMDF28W
+79 ;Other DX 13
SET ABMDE=ABMR(70,170)_"^33^7"
+80 ;FL #67m
DO WRT^ABMDF28W
+81 ;I ABMP("ITYPE")="R" D
+82 SET ABMDE=$SELECT(ABMR(70,170,"POA")'=1:$GET(ABMR(70,170,"POA")),1:"")_"^40^1"
+83 ; FL #67 POA
DO WRT^ABMDF28W
+84 ;Other DX 14
SET ABMDE=ABMR(70,180)_"^41^7"
+85 ;FL #67n
DO WRT^ABMDF28W
+86 ;I ABMP("ITYPE")="R" D
+87 SET ABMDE=$SELECT(ABMR(70,180,"POA")'=1:$GET(ABMR(70,180,"POA")),1:"")_"^48^1"
+88 ; FL #67 POA
DO WRT^ABMDF28W
+89 ;Other DX 15
SET ABMDE=ABMR(70,190)_"^49^7"
+90 ;FL #67o
DO WRT^ABMDF28W
+91 ;I ABMP("ITYPE")="R" D
+92 SET ABMDE=$SELECT(ABMR(70,190,"POA")'=1:$GET(ABMR(70,190,"POA")),1:"")_"^56^1"
+93 ; FL #67 POA
DO WRT^ABMDF28W
+94 ;Other DX 16
SET ABMDE=ABMR(70,200)_"^57^7"
+95 ;FL #67p
DO WRT^ABMDF28W
+96 ;I ABMP("ITYPE")="R" D
+97 SET ABMDE=$SELECT(ABMR(70,200,"POA")'=1:$GET(ABMR(70,200,"POA")),1:"")_"^64^1"
+98 ; FL #67 POA
DO WRT^ABMDF28W
+99 WRITE !
+100 ;
+101 ;Admitting DX
SET ABMDE=ABMR(70,250)_"^4^7"
+102 ;FL #69
DO WRT^ABMDF28W
+103 ;Pt Reason Dx
SET ABMDE=ABMR(70,250)_"^17^7"
+104 ;FL #70
DO WRT^ABMDF28W
+105 ;
+106 ;Ext. cause of injury (1)
SET ABMDE=ABMR(70,260)_"^48^7"
+107 ;FL #72
DO WRT^ABMDF28W
+108 ;I ABMP("ITYPE")="R" D
+109 SET ABMDE=$SELECT(ABMR(70,260,"POA")'=1:$GET(ABMR(70,260,"POA")),1:"")_"^55^1"
+110 ;FL #67 POA
DO WRT^ABMDF28W
+111 ;Ext. cause of injury (2)
SET ABMDE=ABMR(70,290)_"^56^7"
+112 ;FL #72
DO WRT^ABMDF28W
+113 ;I ABMP("ITYPE")="R" D
+114 SET ABMDE=$SELECT(ABMR(70,290,"POA")'=1:$GET(ABMR(70,290,"POA")),1:"")_"^63^1"
+115 ;FL #67 POA
DO WRT^ABMDF28W
+116 ;Ext. cause of injury (3)
SET ABMDE=ABMR(70,300)_"^64^7"
+117 ;FL #72
DO WRT^ABMDF28W
+118 ;I ABMP("ITYPE")="R" D
+119 SET ABMDE=$SELECT(ABMR(70,300,"POA")'=1:$GET(ABMR(70,300,"POA")),1:"")_"^71^1"
+120 ;FL #67 POA
DO WRT^ABMDF28W
+121 ;
+122 QUIT
56 ;
+1 WRITE !
+2 DO PROV^ABMDF28W
+3 ;Attending Prov
+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 $PIECE(ABM("PRV",1),U,4)'=""
Begin DoDot:2
+7 ;NPI
SET ABMDE=$PIECE($PIECE(ABM("PRV",1),U,4),"#",2)_"^59^10"
+8 ;NPI ;abm*2.6*21 IHS/SD/SDR HEAT162190
IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="MONTANA DPHHS"
SET ABMDE=$PIECE($PIECE(ABM("PRV",1),U,4),"#",2)_"^57^10"
+9 ;FL #76
DO WRT^ABMDF28W
End DoDot:2
+10 ;don't print 76 ID qual and ID if Medicare and Tribal Self-Insured
+11 ;abm*2.6*21 IHS/SD/SDR HEAT97615
IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)=2
IF $GET(ABMTSIFG)=1
QUIT
+12 ;S ABMDE=$P($P(ABM("PRV",1),U,3),"#")_"^71^2" ;ID qualifier ;abm*2.6*21 IHS/SD/SDR HEAT217449
+13 ;ID qualifier ;abm*2.6*21 IHS/SD/SDR HEAT217449
SET ABMDE=$PIECE($PIECE(ABM("PRV",1),U,3),"#")_"^70^2"
+14 ;IHS/SD/AML HEAT46786 - Remove ID Qualifier
IF DUZ("2")=1157
SET ABMDE="^71^2"
+15 ;abm*2.6*21 IHS/SD/SDR HEAT162190
IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="MONTANA DPHHS"
SET ABMDE="ZZ^68^2"
+16 ;FL #76
DO WRT^ABMDF28W
+17 ;S ABMDE=$P($P(ABM("PRV",1),U,3),"#",2)_"^73^9" ;ID ;abm*2.6*21 IHS/SD/SDR HEAT217449
+18 ;ID ;abm*2.6*21 IHS/SD/SDR HEAT217449
SET ABMDE=$PIECE($PIECE(ABM("PRV",1),U,3),"#",2)_"^72^9"
+19 ;IHS/SD/AML HEAT46786 - Remove ID
IF DUZ("2")=1157
SET ABMDE="^73^9"
+20 ;abm*2.6*21 IHS/SD/SDR HEAT162190
IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="MONTANA DPHHS"
SET ABMDE="261QR1300X^70^10"
+21 ;FL #76
DO WRT^ABMDF28W
End DoDot:1
+22 ;start new abm*2.6*21 IHS/SD/SDR HEAT240744
+23 ;Medi-Cal, Dialysis, and a referring provider
IF ($$RCID^ABMERUTL(ABMP("INS"))["61044")&($PIECE($GET(^ABMDVTYP(ABMP("VTYP"),0)),U)["DIALYSIS")&(+$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","F",0))'=0)
Begin DoDot:1
+24 SET ABMPRV=+$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","F",0))
+25 SET ABMPRV=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRV,0),U)
+26 IF $PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0
Begin DoDot:2
+27 SET ABMDE=$PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)_"^59^10"
+28 ;FL #76
DO WRT^ABMDF28W
End DoDot:2
End DoDot:1
+29 ;end new abm*2.6*21 IHS/SD/SDR HEAT240744
+30 QUIT
57 ;
+1 WRITE !
+2 NEW I
+3 FOR I=130:10:240,270
Begin DoDot:1
+4 DO @(I_"^ABMER70")
End DoDot:1
+5 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,9)'="N"
Begin DoDot:1
+6 ;S ABMDE=$TR(ABMR(70,130),".")_"^1^7" ;Principle Procedure code ;abm*2.6*16 IHS/SD/SDR HEAT236243
+7 ;Principle Procedure code ;abm*2.6*16 IHS/SD/SDR HEAT236243
SET ABMDE=$TRANSLATE(ABMR(70,130),".")_"^0^7"
+8 ;FL #74
DO WRT^ABMDF28W
+9 ;Principle Procedure date
SET ABMDE=ABMR(70,140)_"^8^6"
+10 ;FL #74a
DO WRT^ABMDF28W
+11 ;Other Procedure code - 1
SET ABMDE=$TRANSLATE(ABMR(70,150),".")_"^15^7"
+12 ;FL #74b
DO WRT^ABMDF28W
+13 ;Other Procedure date - 1
SET ABMDE=ABMR(70,160)_"^23^6"
+14 ;FL #74c
DO WRT^ABMDF28W
+15 ;Other Procedure code - 2
SET ABMDE=$TRANSLATE(ABMR(70,170),".")_"^30^7"
+16 ;FL #74d
DO WRT^ABMDF28W
+17 ;Other Procedure date - 2
SET ABMDE=ABMR(70,180)_"^38^6"
+18 ;FL #74e
DO WRT^ABMDF28W
End DoDot:1
+19 ;I $$RCID^ABMERUTL(ABMP("INS"))'=61044 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
+20 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMERUTL(ABMP("INS"))'["61044"
Begin DoDot:1
+21 ;Attending provider name
SET ABMDE=$PIECE($PIECE(ABM("PRV",1),U),",")_"^53^15"
+22 ; FL #76
DO WRT^ABMDF28W
+23 ;Attending provider name
SET ABMDE=$PIECE($PIECE(ABM("PRV",1),U),",",2)_"^70^11"
+24 ; FL #76
DO WRT^ABMDF28W
End DoDot:1
+25 QUIT
