ABMDF28W ; IHS/ASDST/DMJ - PRINT UB-04 ;
;;2.6;IHS 3P BILLING SYSTEM;**8,20**;NOV 12, 2009;Build 317
;
; IHS/SD/SDR - v2.5 p12 - IM24881 - Form alignment changes
;
;IHS/SD/SDR 2.6*20 - HEAT270943 - If the provider doesn't have a NPI it will print the facility NPI as the default.
; *********************************************************************
;
Q
;
WRT ; EP
; Write data element in requested format
S ABMTAB=+$P(ABMDE,"^",2)+ABMP("LM")
I $P(ABMDE,"^",3)["R" S $P(ABMDE,"^")=$J($P(ABMDE,"^"),+$P(ABMDE,"^",3))
S ABMDE=$E($P(ABMDE,"^"),1,+$P(ABMDE,"^",3))
S:ABMTAB+$L(ABMDE)>IOM ABMDE=$E(ABMDE,1,IOM-ABMTAB)
W ?ABMTAB,ABMDE
Q
;
TEST ; EP
; Test Alignment
S ABMP("LM")=$P(^ABMDEXP(28,0),"^",2)
N I
F I=1:1:4 D
.W !
.S ABMDE="XXXXX BLOCK 1 LINE "_I_" XXXXX"_"^^25"
.D WRT
.I I=2 D
..S ABMDE="XXXXXXXXXXXXXXXXXXXXX"_"^53^20"
..D WRT
..S ABMDE="XXX"_"^77^4"
..D WRT
..Q
N I
F I=1:1:14 W !
S ABMDE="0100 ALL INCL ROOM & BOARD/ANC"_"^^29"
D WRT
S ABMDE="450.00 ^30^9R"
D WRT
S ABMDE=3_"^52^7R"
D WRT
S ABMDE=135000_" ^60^10R"
D WRT
W $$EN^ABMVDF("IOF")
Q
;
PROV ;EP - PROVIDER INFORMATION
; ABM("PRV",#) = UPIN/MCD #_Provider Name ^ UPIN/MCD# ^
; Provider State License Number ^ NPI
S ABMPCNT=1 ; Initialize Provider Count
S ABMPRVTP="A"
S ABMPRVNO=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
D GETPROV
S ABMPCNT=2
S ABMPRVTP="O"
S ABMPRVNO=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","O",0))
D GETPROV
F ABMPRVTP="R","T","F","S","P" D
.S ABMPRVNO=0 ; Initialize Provider number
.F S ABMPRVNO=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABMPRVTP,ABMPRVNO)) Q:'ABMPRVNO D
..Q:+$G(ABMPRVNO)=0
..S ABMPCNT=ABMPCNT+1
..Q:ABMPCNT>4 ; only 1st 4 providers
..D GETPROV
Q
GETPROV ;
; NEW PERSON file IEN
Q:+$G(ABMPRVNO)=0
S ABMPRV=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRVNO,0)),U)
S ABM("PRV",ABMPCNT)=$P($G(^VA(200,ABMPRV,0)),U) ;provider name
;I $P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0 D ;abm*2.6*20 IHS/SD/SDR HEAT270943
I (($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0)!($P($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)>0)) D ;abm*2.6*20 IHS/SD/SDR HEAT270943
.S $P(ABM("PRV",ABMPCNT),U,4)=$S(ABMPRVTP="F":"DN",ABMPRVTP="R":82,1:"ZZ")
.;S $P(ABM("PRV",ABMPCNT),U,4)=$P(ABM("PRV",ABMPCNT),U,4)_"#"_$P($$NPI^XUSNPI("Individual_ID",ABMPRV),U) ;abm*2.6*20 IHS/SD/SDR HEAT270943
.S $P(ABM("PRV",ABMPCNT),U,4)=$P(ABM("PRV",ABMPCNT),U,4)_"#"_$S($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0:$P($$NPI^XUSNPI("Individual_ID",ABMPRV),U),1:$P($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)) ;abm*2.6*20 IHS/SD/SDR HEAT270943
S $P(ABM("PRV",ABMPCNT),U,2)=""
; If Medicare FI, find provider UPIN
I ABMP("ITYPE")="R" D
.S ABMUPIN=$P($G(^VA(200,ABMPRV,9999999)),"^",8)
.S:ABMUPIN="" ABMUPIN="PHS000"
.S $P(ABM("PRV",ABMPCNT),U,2)=ABMUPIN
;If Medicaid FI, get MCD Number
I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") D
.S $P(ABM("PRV",ABMPCNT),U,2)=$P($G(^VA(200,ABMPRV,9999999.18,+ABMP("INS"),0)),U,2)
.S:$P(ABM("PRV",ABMPCNT),U,2)="" $P(ABM("PRV",ABMPCNT),U,2)=$P($G(^VA(200,ABMPRV,9999999)),U,7)
S ABMVST=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",23) ; state IEN
S:ABMVST="" ABMVST=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",14)
S ABMP("RTYPE")=$S(ABMP("ITYPE")="R":"1G",ABMP("ITYPE")="D":"1D",$P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$P($G(^ABMREFID($P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B")
D ABMPNUM(ABMP("RTYPE"),ABMPRV)
Q:$G(ABMR("REF",30))="" ;abm*2.6*8 HEAT39389
I $P($G(^AUTNINS(ABMP("INS"),0)),U)="ARKANSAS MEDICAID" S ABMP("RTYPE")="0B"
I $P($G(^AUTNINS(ABMP("INS"),0)),U)="IOWA MEDICAID"!($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEBRASKA MEDICAID") S ABMP("RTYPE")=" "
S $P(ABM("PRV",ABMPCNT),U,3)=ABMP("RTYPE")_"#"_$S($P(ABM("PRV",ABMPCNT),U,2)'="":$P(ABM("PRV",ABMPCNT),U,2),1:$S(ABMR("REF",30)["-":$P(ABMR("REF",30),"-",2),1:ABMR("REF",30))) ;Qualifier and Other Provider number
Q
ABMPNUM(X,Y) ;
;x=type
;y=provider
S ABMEIC=X
S ABMIEN=Y
I ABMEIC="1C" D
.S ABMR("REF",30)=$$MCR^ABMEEPRV(ABMIEN)
.Q:$$RCID^ABMUTLP(ABMP("INS"))'="C00900"
.Q:$$RCID^ABMUTLP(ABMP("INS"))'="04402"
.S ABMR("REF",30)=$$NPI^ABMEEPRV(ABMIEN,ABMP("LDFN"),ABMP("INS"))
I ABMEIC="1D" D
.S ABMR("REF",30)=$$MCD^ABMEEPRV(ABMIEN,+$G(ABMPAYER))
I ABMEIC="0B" D
.S ABMR("REF",30)=$$SLN^ABMEEPRV(ABMIEN)
I ABMEIC="1G" D
.S ABMR("REF",30)=$$UPIN^ABMEEPRV(ABMIEN)
I "^BQ^G2^1A^1B^B3^1H^1J^EI^FH^G5^LU^SY^U3^X5^"[("^"_ABMEIC_"^") D
.S ABMR("REF",30)=$$PI^ABMUTLF(ABMP("LDFN"))
Q
ABMDF28W ; IHS/ASDST/DMJ - PRINT UB-04 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**8,20**;NOV 12, 2009;Build 317
+2 ;
+3 ; IHS/SD/SDR - v2.5 p12 - IM24881 - Form alignment changes
+4 ;
+5 ;IHS/SD/SDR 2.6*20 - HEAT270943 - If the provider doesn't have a NPI it will print the facility NPI as the default.
+6 ; *********************************************************************
+7 ;
+8 QUIT
+9 ;
WRT ; EP
+1 ; Write data element in requested format
+2 SET ABMTAB=+$PIECE(ABMDE,"^",2)+ABMP("LM")
+3 IF $PIECE(ABMDE,"^",3)["R"
SET $PIECE(ABMDE,"^")=$JUSTIFY($PIECE(ABMDE,"^"),+$PIECE(ABMDE,"^",3))
+4 SET ABMDE=$EXTRACT($PIECE(ABMDE,"^"),1,+$PIECE(ABMDE,"^",3))
+5 IF ABMTAB+$LENGTH(ABMDE)>IOM
SET ABMDE=$EXTRACT(ABMDE,1,IOM-ABMTAB)
+6 WRITE ?ABMTAB,ABMDE
+7 QUIT
+8 ;
TEST ; EP
+1 ; Test Alignment
+2 SET ABMP("LM")=$PIECE(^ABMDEXP(28,0),"^",2)
+3 NEW I
+4 FOR I=1:1:4
Begin DoDot:1
+5 WRITE !
+6 SET ABMDE="XXXXX BLOCK 1 LINE "_I_" XXXXX"_"^^25"
+7 DO WRT
+8 IF I=2
Begin DoDot:2
+9 SET ABMDE="XXXXXXXXXXXXXXXXXXXXX"_"^53^20"
+10 DO WRT
+11 SET ABMDE="XXX"_"^77^4"
+12 DO WRT
+13 QUIT
End DoDot:2
End DoDot:1
+14 NEW I
+15 FOR I=1:1:14
WRITE !
+16 SET ABMDE="0100 ALL INCL ROOM & BOARD/ANC"_"^^29"
+17 DO WRT
+18 SET ABMDE="450.00 ^30^9R"
+19 DO WRT
+20 SET ABMDE=3_"^52^7R"
+21 DO WRT
+22 SET ABMDE=135000_" ^60^10R"
+23 DO WRT
+24 WRITE $$EN^ABMVDF("IOF")
+25 QUIT
+26 ;
PROV ;EP - PROVIDER INFORMATION
+1 ; ABM("PRV",#) = UPIN/MCD #_Provider Name ^ UPIN/MCD# ^
+2 ; Provider State License Number ^ NPI
+3 ; Initialize Provider Count
SET ABMPCNT=1
+4 SET ABMPRVTP="A"
+5 SET ABMPRVNO=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
+6 DO GETPROV
+7 SET ABMPCNT=2
+8 SET ABMPRVTP="O"
+9 SET ABMPRVNO=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","O",0))
+10 DO GETPROV
+11 FOR ABMPRVTP="R","T","F","S","P"
Begin DoDot:1
+12 ; Initialize Provider number
SET ABMPRVNO=0
+13 FOR
SET ABMPRVNO=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABMPRVTP,ABMPRVNO))
IF 'ABMPRVNO
QUIT
Begin DoDot:2
+14 IF +$GET(ABMPRVNO)=0
QUIT
+15 SET ABMPCNT=ABMPCNT+1
+16 ; only 1st 4 providers
IF ABMPCNT>4
QUIT
+17 DO GETPROV
End DoDot:2
End DoDot:1
+18 QUIT
GETPROV ;
+1 ; NEW PERSON file IEN
+2 IF +$GET(ABMPRVNO)=0
QUIT
+3 SET ABMPRV=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRVNO,0)),U)
+4 ;provider name
SET ABM("PRV",ABMPCNT)=$PIECE($GET(^VA(200,ABMPRV,0)),U)
+5 ;I $P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0 D ;abm*2.6*20 IHS/SD/SDR HEAT270943
+6 ;abm*2.6*20 IHS/SD/SDR HEAT270943
IF (($PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0)!($PIECE($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)>0))
Begin DoDot:1
+7 SET $PIECE(ABM("PRV",ABMPCNT),U,4)=$SELECT(ABMPRVTP="F":"DN",ABMPRVTP="R":82,1:"ZZ")
+8 ;S $P(ABM("PRV",ABMPCNT),U,4)=$P(ABM("PRV",ABMPCNT),U,4)_"#"_$P($$NPI^XUSNPI("Individual_ID",ABMPRV),U) ;abm*2.6*20 IHS/SD/SDR HEAT270943
+9 ;abm*2.6*20 IHS/SD/SDR HEAT270943
SET $PIECE(ABM("PRV",ABMPCNT),U,4)=$PIECE(ABM("PRV",ABMPCNT),U,4)_"#"_$SELECT($PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0:$PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U),1:$PIECE($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U))
End DoDot:1
+10 SET $PIECE(ABM("PRV",ABMPCNT),U,2)=""
+11 ; If Medicare FI, find provider UPIN
+12 IF ABMP("ITYPE")="R"
Begin DoDot:1
+13 SET ABMUPIN=$PIECE($GET(^VA(200,ABMPRV,9999999)),"^",8)
+14 IF ABMUPIN=""
SET ABMUPIN="PHS000"
+15 SET $PIECE(ABM("PRV",ABMPCNT),U,2)=ABMUPIN
End DoDot:1
+16 ;If Medicaid FI, get MCD Number
+17 IF ABMP("ITYPE")="D"!(ABMP("ITYPE")="K")
Begin DoDot:1
+18 SET $PIECE(ABM("PRV",ABMPCNT),U,2)=$PIECE($GET(^VA(200,ABMPRV,9999999.18,+ABMP("INS"),0)),U,2)
+19 IF $PIECE(ABM("PRV",ABMPCNT),U,2)=""
SET $PIECE(ABM("PRV",ABMPCNT),U,2)=$PIECE($GET(^VA(200,ABMPRV,9999999)),U,7)
End DoDot:1
+20 ; state IEN
SET ABMVST=$PIECE($GET(^AUTTLOC(+ABMP("LDFN"),0)),"^",23)
+21 IF ABMVST=""
SET ABMVST=$PIECE($GET(^AUTTLOC(+ABMP("LDFN"),0)),"^",14)
+22 SET ABMP("RTYPE")=$SELECT(ABMP("ITYPE")="R":"1G",ABMP("ITYPE")="D":"1D",$PIECE($GET(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$PIECE($GET(^ABMREFID($PIECE($GET(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B")
+23 DO ABMPNUM(ABMP("RTYPE"),ABMPRV)
+24 ;abm*2.6*8 HEAT39389
IF $GET(ABMR("REF",30))=""
QUIT
+25 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="ARKANSAS MEDICAID"
SET ABMP("RTYPE")="0B"
+26 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="IOWA MEDICAID"!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="NEBRASKA MEDICAID")
SET ABMP("RTYPE")=" "
+27 ;Qualifier and Other Provider number
SET $PIECE(ABM("PRV",ABMPCNT),U,3)=ABMP("RTYPE")_"#"_$SELECT($PIECE(ABM("PRV",ABMPCNT),U,2)'="":$PIECE(ABM("PRV",ABMPCNT),U,2),1:$SELECT(ABMR("REF",30)["-":$PIECE(ABMR("REF",30),"-",2),1:ABMR("REF",30)))
+28 QUIT
ABMPNUM(X,Y) ;
+1 ;x=type
+2 ;y=provider
+3 SET ABMEIC=X
+4 SET ABMIEN=Y
+5 IF ABMEIC="1C"
Begin DoDot:1
+6 SET ABMR("REF",30)=$$MCR^ABMEEPRV(ABMIEN)
+7 IF $$RCID^ABMUTLP(ABMP("INS"))'="C00900"
QUIT
+8 IF $$RCID^ABMUTLP(ABMP("INS"))'="04402"
QUIT
+9 SET ABMR("REF",30)=$$NPI^ABMEEPRV(ABMIEN,ABMP("LDFN"),ABMP("INS"))
End DoDot:1
+10 IF ABMEIC="1D"
Begin DoDot:1
+11 SET ABMR("REF",30)=$$MCD^ABMEEPRV(ABMIEN,+$GET(ABMPAYER))
End DoDot:1
+12 IF ABMEIC="0B"
Begin DoDot:1
+13 SET ABMR("REF",30)=$$SLN^ABMEEPRV(ABMIEN)
End DoDot:1
+14 IF ABMEIC="1G"
Begin DoDot:1
+15 SET ABMR("REF",30)=$$UPIN^ABMEEPRV(ABMIEN)
End DoDot:1
+16 IF "^BQ^G2^1A^1B^B3^1H^1J^EI^FH^G5^LU^SY^U3^X5^"[("^"_ABMEIC_"^")
Begin DoDot:1
+17 SET ABMR("REF",30)=$$PI^ABMUTLF(ABMP("LDFN"))
End DoDot:1
+18 QUIT
