- 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
