ABMDF24 ; IHS/ASDST/DMJ - Set NCPDP Print Array ;
;;2.6;IHS Third Party Billing;**1,3**;NOV 12, 2009
;
; IHS/SD/SDR - v2.5 p10 - Format changes
; Adrian made these changes and asked they be included
;
; IHS/SD/SDR - v2.5 p11 - NPI
;
; IHS/SD/SDR - v2.5 p13 - NO IM
;
; IHS/SD/SDR - v2.6 CSV
; IHS/SD/SDR - abm*2.6*1 - HEAT5361 - Added provider NPI to print
; IHS/SD/SDR - abm*2.6*3 - HEAT12251 - default DOS to claim header svc from dt
;
START ;EP - enter here
K ABMP,ABMF
S ABMP("EXP")=24
D TXST^ABMDFUTL
S ABMTOT(1)=0,ABMTOT(2)=0,ABMTOT(3)=0
D LOOP
F I=1:1:3 D
.S $P(ABMY("TOT"),"^",I)=ABMTOT(I)
K ABM,ABMV,ABMF,ABMS,ABMR,ABMFP,ABMTOT
D ^%ZISC
Q
;
LOOP ;loop through ABMY array
S ABMY("N")=0
F S ABMY("N")=$O(ABMY(ABMY("N"))) Q:'ABMY("N") D
.S ABMTOT(3)=ABMTOT(3)+1
.S ABMP("BDFN")=0
.F S ABMP("BDFN")=$O(ABMY(ABMY("N"),ABMP("BDFN"))) Q:'ABMP("BDFN") D
..D ENT
Q
;
ENT ;EP - one bill
Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
S ABMTOT(1)=+$G(ABMTOT(1))+1
S ABMTOT(2)=+$G(ABMTOT(2))+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U)
K ABMFP
D GET1
D FSET1
D GET2
S DIE="^ABMDBILL(DUZ(2),"
S DA=ABMP("BDFN")
S DR=".04////B;.16////A;.17////"_ABMP("XMIT")
D ^ABMDDIE
Q:$D(ABM("DIE-FAIL"))
K ^ABMDBILL(DUZ(2),"AS",+^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"A",ABMP("BDFN"))
K ^ABMDBILL(DUZ(2),"AC","A",ABMP("BDFN"))
Q
;
GET1 ;EP for setting up export array
K ABMP("INS"),ABMP("CDFN"),ABMFP
S ABM0=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
S ABMP("B0")=ABM0 ;abm*2.6*1 HEAT5361
S ABMP("INS")=$P(ABM0,"^",8)
S ABMPOL=$$SBR^ABMUTLP(ABMP("BDFN"))
S ABMPAT=$P(ABM0,"^",5)
S ABMDOB=$P(^DPT(ABMPAT,0),"^",3)
S ABMSEX=$P(^DPT(ABMPAT,0),"^",2)
S ABMSEX=$S(ABMSEX="M":1,ABMSEX="F":2,1:0)
S ABMREL=$$REL^ABMUTLP(ABMP("BDFN"))
S ABMREL=$S(+ABMREL=1:1,+ABMREL=2:2,+ABMREL=3:3,1:4)
S ABMID=$$PNUM^ABMUTLP(ABMP("BDFN"))
S ABMGID=$G(ABMP("GRP#"))
S ABMLDFN=$P(ABM0,"^",3)
S ABMPAUTH=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),5)),"^",12)
S ABMCSZ=$P(^AUTTLOC(ABMLDFN,0),"^",11,18)
S ABMPHONE=$P(ABMCSZ,U)
S ABMPHONE=$TR(ABMPHONE,"("," ")
S ABMPHONE=$TR(ABMPHONE,")"," ")
S ABMSTATE=$P(ABMCSZ,"^",4)
S ABMSTATE=$P($G(^DIC(5,+ABMSTATE,0)),U)
S ABMSPN=$P($G(^ABMNINS(ABMLDFN,ABMP("INS"),1,997,0)),"^",8)
Q
FSET1 ;set printing array patient info
S ABMFP(1,5)=ABMID ;ID
S ABMFP(1,40)=ABMGID ;GROUP ID
S ABMFP(1,55)="Claim# "_ABMP("PCN")
S ABMFP(5,5)=$P($G(^DPT(ABMPAT,0)),U) ;PATIENT NAME
S ABMFP(3,51)=$P($G(^AUTNINS(ABMP("INS"),0)),U) ;PLAN NAME
S ABMFP(3,5)=$P($G(^AUPN3PPH(ABMPOL,0)),U) ;NAME
;PATIENT DOB/GENDER/RELATIONSHIP
S ABMFP(7,10)=$E(ABMDOB,4,5)
S ABMFP(7,15)=$E(ABMDOB,6,7)
S ABMFP(7,20)=$E(ABMDOB,1,3)+1700
S ABMFP(7,46)=ABMSEX
S ABMFP(7,65)=ABMREL
;
S ABMFP(9,8)=$P(^DIC(4,ABMLDFN,0),U) ;PHARMACY NAME
;PHARMACY ADDRESS
S ABMFP(11,8)=$P(ABMCSZ,"^",2)
;PHARMACY SERVICE PROVIDER ID
S ABMNPIU=$$NPIUSAGE^ABMUTLF(ABMLDFN,ABMP("INS"))
I $G(ABMNPIU)="N"!($G(ABMNPIU)="B") D
.S ABMLNPI=$S($P($G(^ABMNINS(ABMLDFN,ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMLDFN,ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMLDFN,1,2)),U,12)'="":$P(^ABMDPARM(ABMLDFN,1,2),U,12),1:ABMLDFN)
.S ABMFP(11,45)=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)'="":$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")
.S ABMFP(11,67)="01"
I $G(ABMNPIU)'="N",($G(ABMFP(11,45))="") D
.I ABMSPN="" D
..S ABMFP(11,45)=$P(ABMCSZ,U,8)
..S ABMFP(11,67)=11
.I ABMSPN'="" D
..S ABMFP(11,45)=ABMSPN
..S ABMFP(11,67)="07"
;PHARMACY CITY/PHONE NUMBER
S ABMFP(13,8)=$P(ABMCSZ,"^",3)
S ABMFP(13,44)=ABMPHONE
;PHARMACY STATE/ZIP/FAX NUMBER
S ABMFP(15,12)=ABMSTATE
S ABMFP(15,28)=$P(ABMCSZ,"^",5)
;
S ABMFP(20,52)="SIGNATURE ON FILE"
Q
GET2 ;rx multiple
S ABMI=0,ABMCNT=0
F S ABMI=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,ABMI)) Q:'ABMI D
.S ABMCNT=ABMCNT+1
.S ABMRX0=^ABMDBILL(DUZ(2),ABMP("BDFN"),23,ABMI,0)
.D FSET2
.I ABMCNT=2 D PRT
I ABMCNT=1 D PRT
Q
FSET2 ;set printing array rx multiple
S ABMCHARG=$P(ABMRX0,"^",3)*$P(ABMRX0,"^",4)
S ABMLINE=$S(ABMCNT=1:28,1:47)
S ABMFP(ABMLINE,67)=$J(ABMCHARG,8,2)
S ABMLINE=ABMLINE+2
S ABMDFEE=$P(ABMRX0,"^",5)
S ABMGROSS=ABMCHARG+ABMDFEE
S ABMFP(ABMLINE,67)=$J(ABMDFEE,8,2)
S ABMLINE=$S(ABMCNT=1:33,1:51)
S ABMFP(ABMLINE,1)=$P(ABMRX0,"^",22)
I ABMFP(ABMLINE,1)="" D
.S ABMFP(ABMLINE,1)=$O(^PSRX("B",+$P(ABMRX0,"^",6),0))
S:ABMFP(ABMLINE,1)="" ABMFP(ABMLINE,1)=$G(ABMRXNUM)
S ABMFP(ABMLINE,16)=1 ;qualifier
S ABMFP(ABMLINE,18)=$$POSDT^ABMDUTL($P(ABMRX0,"^",25)) ;date written
S ABMFP(ABMLINE,29)=$$POSDT^ABMDUTL($P(ABMRX0,"^",14)) ;dos
I ABMFP(ABMLINE,29)="" S ABMFP(ABMLINE,29)=$$POSDT^ABMDUTL($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^")) ;abm*2.6*3 HEAT12251
S ABMFP(ABMLINE,41)=$P(ABMRX0,"^",19)+1 ;fill #
S ABMFP(ABMLINE,43)=$J($P(ABMRX0,"^",3),13,3) ;quantity
S ABMFP(ABMLINE,58)=$P(ABMRX0,"^",20) ;days supply
S ABMLINE=ABMLINE+4
I $P(ABMRX0,"^",24) D
.S ABMFP(ABMLINE,1)=$P(ABMRX0,"^",24) ;ndc
.S ABMFP(ABMLINE,19)="03"
I '$P(ABMRX0,"^",24) D
.S ABMDRUG=$P($G(^PSDRUG(+ABMRX0,0)),U) ;drug name
.S ABMFP(ABMLINE,1)=$E(ABMDRUG,1,17)
I ABMPAUTH'="" D
.S ABMFP(ABMLINE,26)=ABMPAUTH ;prior auth #
.S ABMFP(ABMLINE,39)=1
I $G(ABMNPIU)="N"!($G(ABMNPIU)="B") D
.S ABMLNPI=$S($P($G(^ABMNINS(ABMLDFN,ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMLDFN,ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMLDFN,1,2)),U,12)'="":$P(^ABMDPARM(ABMLDFN,1,2),U,12),1:ABMLDFN)
.S ABMFP(ABMLINE,43)=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)'="":$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")
.S ABMFP(ABMLINE,58)="05"
I $G(ABMNPIU)'="N",($G(ABMFP(ABMLINE,43))="") D
.S ABMFP(ABMLINE,43)=$P($G(^DIC(4,DUZ(2),"DEA")),U)
.S ABMFP(ABMLINE,58)="12"
S ABMLINE=$S(ABMCNT=1:ABMLINE+1,1:ABMLINE+2)
S ABMFP(ABMLINE,67)=$J(ABMGROSS,8,2)
S ABMLINE=$S(ABMCNT=1:ABMLINE+3,1:ABMLINE+2)
;start new code abm*2.6*1 HEAT5361
;Attending provider
S ABM("X")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0)) D
.Q:'ABM("X")
.D SELBILL^ABMDE4X
I $G(ABMNPIU)="N"!($G(ABMNPIU)="B") D
.S ABMPNPI=$S($P($$NPI^XUSNPI("Individual_ID",$P(ABM("A"),U,2)),U)>0:$P($$NPI^XUSNPI("Individual_ID",$P(ABM("A"),U,2)),U),1:"")
.S ABMFP(ABMLINE,15)=ABMPNPI
.S ABMFP(ABMLINE,30)="05"
;end new code HEAT5361
S ABMDXP=+$P(ABMRX0,"^",13)
I '$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABMDXP)) D
.S ABMDXP=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",0))
S ABMDX=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",+ABMDXP,0))
S ABMDX=$P($$DX^ABMCVAPI(+ABMDX,ABMP("VDT")),U,2) ;CSV-c
S ABMFP(ABMLINE,43)=ABMDX
S ABMFP(ABMLINE,52)="01"
S ABMLINE=$S(ABMCNT=1:ABMLINE+3,1:ABMLINE+4)
S ABMFP(ABMLINE,67)=$J(ABMGROSS,8,2)
S:ABMCNT=1 ABMLINE=ABMLINE+1
S ABMFP(ABMLINE,47)=$J(ABMGROSS,8,2)
Q
;
PRT ;print
D EN^ABMFPRT(.ABMFP)
S J=27
F S J=$O(ABMFP(J)) Q:'J D
.K ABMFP(J)
S ABMCNT=0
Q
ABMDF24 ; IHS/ASDST/DMJ - Set NCPDP Print Array ;
+1 ;;2.6;IHS Third Party Billing;**1,3**;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - v2.5 p10 - Format changes
+4 ; Adrian made these changes and asked they be included
+5 ;
+6 ; IHS/SD/SDR - v2.5 p11 - NPI
+7 ;
+8 ; IHS/SD/SDR - v2.5 p13 - NO IM
+9 ;
+10 ; IHS/SD/SDR - v2.6 CSV
+11 ; IHS/SD/SDR - abm*2.6*1 - HEAT5361 - Added provider NPI to print
+12 ; IHS/SD/SDR - abm*2.6*3 - HEAT12251 - default DOS to claim header svc from dt
+13 ;
START ;EP - enter here
+1 KILL ABMP,ABMF
+2 SET ABMP("EXP")=24
+3 DO TXST^ABMDFUTL
+4 SET ABMTOT(1)=0
SET ABMTOT(2)=0
SET ABMTOT(3)=0
+5 DO LOOP
+6 FOR I=1:1:3
Begin DoDot:1
+7 SET $PIECE(ABMY("TOT"),"^",I)=ABMTOT(I)
End DoDot:1
+8 KILL ABM,ABMV,ABMF,ABMS,ABMR,ABMFP,ABMTOT
+9 DO ^%ZISC
+10 QUIT
+11 ;
LOOP ;loop through ABMY array
+1 SET ABMY("N")=0
+2 FOR
SET ABMY("N")=$ORDER(ABMY(ABMY("N")))
IF 'ABMY("N")
QUIT
Begin DoDot:1
+3 SET ABMTOT(3)=ABMTOT(3)+1
+4 SET ABMP("BDFN")=0
+5 FOR
SET ABMP("BDFN")=$ORDER(ABMY(ABMY("N"),ABMP("BDFN")))
IF 'ABMP("BDFN")
QUIT
Begin DoDot:2
+6 DO ENT
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
ENT ;EP - one bill
+1 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
QUIT
+2 SET ABMTOT(1)=+$GET(ABMTOT(1))+1
+3 SET ABMTOT(2)=+$GET(ABMTOT(2))+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U)
+4 KILL ABMFP
+5 DO GET1
+6 DO FSET1
+7 DO GET2
+8 SET DIE="^ABMDBILL(DUZ(2),"
+9 SET DA=ABMP("BDFN")
+10 SET DR=".04////B;.16////A;.17////"_ABMP("XMIT")
+11 DO ^ABMDDIE
+12 IF $DATA(ABM("DIE-FAIL"))
QUIT
+13 KILL ^ABMDBILL(DUZ(2),"AS",+^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"A",ABMP("BDFN"))
+14 KILL ^ABMDBILL(DUZ(2),"AC","A",ABMP("BDFN"))
+15 QUIT
+16 ;
GET1 ;EP for setting up export array
+1 KILL ABMP("INS"),ABMP("CDFN"),ABMFP
+2 SET ABM0=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
+3 ;abm*2.6*1 HEAT5361
SET ABMP("B0")=ABM0
+4 SET ABMP("INS")=$PIECE(ABM0,"^",8)
+5 SET ABMPOL=$$SBR^ABMUTLP(ABMP("BDFN"))
+6 SET ABMPAT=$PIECE(ABM0,"^",5)
+7 SET ABMDOB=$PIECE(^DPT(ABMPAT,0),"^",3)
+8 SET ABMSEX=$PIECE(^DPT(ABMPAT,0),"^",2)
+9 SET ABMSEX=$SELECT(ABMSEX="M":1,ABMSEX="F":2,1:0)
+10 SET ABMREL=$$REL^ABMUTLP(ABMP("BDFN"))
+11 SET ABMREL=$SELECT(+ABMREL=1:1,+ABMREL=2:2,+ABMREL=3:3,1:4)
+12 SET ABMID=$$PNUM^ABMUTLP(ABMP("BDFN"))
+13 SET ABMGID=$GET(ABMP("GRP#"))
+14 SET ABMLDFN=$PIECE(ABM0,"^",3)
+15 SET ABMPAUTH=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),5)),"^",12)
+16 SET ABMCSZ=$PIECE(^AUTTLOC(ABMLDFN,0),"^",11,18)
+17 SET ABMPHONE=$PIECE(ABMCSZ,U)
+18 SET ABMPHONE=$TRANSLATE(ABMPHONE,"("," ")
+19 SET ABMPHONE=$TRANSLATE(ABMPHONE,")"," ")
+20 SET ABMSTATE=$PIECE(ABMCSZ,"^",4)
+21 SET ABMSTATE=$PIECE($GET(^DIC(5,+ABMSTATE,0)),U)
+22 SET ABMSPN=$PIECE($GET(^ABMNINS(ABMLDFN,ABMP("INS"),1,997,0)),"^",8)
+23 QUIT
FSET1 ;set printing array patient info
+1 ;ID
SET ABMFP(1,5)=ABMID
+2 ;GROUP ID
SET ABMFP(1,40)=ABMGID
+3 SET ABMFP(1,55)="Claim# "_ABMP("PCN")
+4 ;PATIENT NAME
SET ABMFP(5,5)=$PIECE($GET(^DPT(ABMPAT,0)),U)
+5 ;PLAN NAME
SET ABMFP(3,51)=$PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)
+6 ;NAME
SET ABMFP(3,5)=$PIECE($GET(^AUPN3PPH(ABMPOL,0)),U)
+7 ;PATIENT DOB/GENDER/RELATIONSHIP
+8 SET ABMFP(7,10)=$EXTRACT(ABMDOB,4,5)
+9 SET ABMFP(7,15)=$EXTRACT(ABMDOB,6,7)
+10 SET ABMFP(7,20)=$EXTRACT(ABMDOB,1,3)+1700
+11 SET ABMFP(7,46)=ABMSEX
+12 SET ABMFP(7,65)=ABMREL
+13 ;
+14 ;PHARMACY NAME
SET ABMFP(9,8)=$PIECE(^DIC(4,ABMLDFN,0),U)
+15 ;PHARMACY ADDRESS
+16 SET ABMFP(11,8)=$PIECE(ABMCSZ,"^",2)
+17 ;PHARMACY SERVICE PROVIDER ID
+18 SET ABMNPIU=$$NPIUSAGE^ABMUTLF(ABMLDFN,ABMP("INS"))
+19 IF $GET(ABMNPIU)="N"!($GET(ABMNPIU)="B")
Begin DoDot:1
+20 SET ABMLNPI=$SELECT($PIECE($GET(^ABMNINS(ABMLDFN,ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$PIECE(^ABMNINS(ABMLDFN,ABMP("INS"),1,ABMP("VTYP"),1),U,8),$PIECE($GET(^ABMDPARM(ABMLDFN,1,2)),U,12)'="":$PIECE(^ABMDPARM(ABMLDFN,1,2),U,12),1:ABML
DFN)
+21 SET ABMFP(11,45)=$SELECT($PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)'="":$PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")
+22 SET ABMFP(11,67)="01"
End DoDot:1
+23 IF $GET(ABMNPIU)'="N"
IF ($GET(ABMFP(11,45))="")
Begin DoDot:1
+24 IF ABMSPN=""
Begin DoDot:2
+25 SET ABMFP(11,45)=$PIECE(ABMCSZ,U,8)
+26 SET ABMFP(11,67)=11
End DoDot:2
+27 IF ABMSPN'=""
Begin DoDot:2
+28 SET ABMFP(11,45)=ABMSPN
+29 SET ABMFP(11,67)="07"
End DoDot:2
End DoDot:1
+30 ;PHARMACY CITY/PHONE NUMBER
+31 SET ABMFP(13,8)=$PIECE(ABMCSZ,"^",3)
+32 SET ABMFP(13,44)=ABMPHONE
+33 ;PHARMACY STATE/ZIP/FAX NUMBER
+34 SET ABMFP(15,12)=ABMSTATE
+35 SET ABMFP(15,28)=$PIECE(ABMCSZ,"^",5)
+36 ;
+37 SET ABMFP(20,52)="SIGNATURE ON FILE"
+38 QUIT
GET2 ;rx multiple
+1 SET ABMI=0
SET ABMCNT=0
+2 FOR
SET ABMI=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+3 SET ABMCNT=ABMCNT+1
+4 SET ABMRX0=^ABMDBILL(DUZ(2),ABMP("BDFN"),23,ABMI,0)
+5 DO FSET2
+6 IF ABMCNT=2
DO PRT
End DoDot:1
+7 IF ABMCNT=1
DO PRT
+8 QUIT
FSET2 ;set printing array rx multiple
+1 SET ABMCHARG=$PIECE(ABMRX0,"^",3)*$PIECE(ABMRX0,"^",4)
+2 SET ABMLINE=$SELECT(ABMCNT=1:28,1:47)
+3 SET ABMFP(ABMLINE,67)=$JUSTIFY(ABMCHARG,8,2)
+4 SET ABMLINE=ABMLINE+2
+5 SET ABMDFEE=$PIECE(ABMRX0,"^",5)
+6 SET ABMGROSS=ABMCHARG+ABMDFEE
+7 SET ABMFP(ABMLINE,67)=$JUSTIFY(ABMDFEE,8,2)
+8 SET ABMLINE=$SELECT(ABMCNT=1:33,1:51)
+9 SET ABMFP(ABMLINE,1)=$PIECE(ABMRX0,"^",22)
+10 IF ABMFP(ABMLINE,1)=""
Begin DoDot:1
+11 SET ABMFP(ABMLINE,1)=$ORDER(^PSRX("B",+$PIECE(ABMRX0,"^",6),0))
End DoDot:1
+12 IF ABMFP(ABMLINE,1)=""
SET ABMFP(ABMLINE,1)=$GET(ABMRXNUM)
+13 ;qualifier
SET ABMFP(ABMLINE,16)=1
+14 ;date written
SET ABMFP(ABMLINE,18)=$$POSDT^ABMDUTL($PIECE(ABMRX0,"^",25))
+15 ;dos
SET ABMFP(ABMLINE,29)=$$POSDT^ABMDUTL($PIECE(ABMRX0,"^",14))
+16 ;abm*2.6*3 HEAT12251
IF ABMFP(ABMLINE,29)=""
SET ABMFP(ABMLINE,29)=$$POSDT^ABMDUTL($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^"))
+17 ;fill #
SET ABMFP(ABMLINE,41)=$PIECE(ABMRX0,"^",19)+1
+18 ;quantity
SET ABMFP(ABMLINE,43)=$JUSTIFY($PIECE(ABMRX0,"^",3),13,3)
+19 ;days supply
SET ABMFP(ABMLINE,58)=$PIECE(ABMRX0,"^",20)
+20 SET ABMLINE=ABMLINE+4
+21 IF $PIECE(ABMRX0,"^",24)
Begin DoDot:1
+22 ;ndc
SET ABMFP(ABMLINE,1)=$PIECE(ABMRX0,"^",24)
+23 SET ABMFP(ABMLINE,19)="03"
End DoDot:1
+24 IF '$PIECE(ABMRX0,"^",24)
Begin DoDot:1
+25 ;drug name
SET ABMDRUG=$PIECE($GET(^PSDRUG(+ABMRX0,0)),U)
+26 SET ABMFP(ABMLINE,1)=$EXTRACT(ABMDRUG,1,17)
End DoDot:1
+27 IF ABMPAUTH'=""
Begin DoDot:1
+28 ;prior auth #
SET ABMFP(ABMLINE,26)=ABMPAUTH
+29 SET ABMFP(ABMLINE,39)=1
End DoDot:1
+30 IF $GET(ABMNPIU)="N"!($GET(ABMNPIU)="B")
Begin DoDot:1
+31 SET ABMLNPI=$SELECT($PIECE($GET(^ABMNINS(ABMLDFN,ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$PIECE(^ABMNINS(ABMLDFN,ABMP("INS"),1,ABMP("VTYP"),1),U,8),$PIECE($GET(^ABMDPARM(ABMLDFN,1,2)),U,12)'="":$PIECE(^ABMDPARM(ABMLDFN,1,2),U,12),1:ABML
DFN)
+32 SET ABMFP(ABMLINE,43)=$SELECT($PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)'="":$PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")
+33 SET ABMFP(ABMLINE,58)="05"
End DoDot:1
+34 IF $GET(ABMNPIU)'="N"
IF ($GET(ABMFP(ABMLINE,43))="")
Begin DoDot:1
+35 SET ABMFP(ABMLINE,43)=$PIECE($GET(^DIC(4,DUZ(2),"DEA")),U)
+36 SET ABMFP(ABMLINE,58)="12"
End DoDot:1
+37 SET ABMLINE=$SELECT(ABMCNT=1:ABMLINE+1,1:ABMLINE+2)
+38 SET ABMFP(ABMLINE,67)=$JUSTIFY(ABMGROSS,8,2)
+39 SET ABMLINE=$SELECT(ABMCNT=1:ABMLINE+3,1:ABMLINE+2)
+40 ;start new code abm*2.6*1 HEAT5361
+41 ;Attending provider
+42 SET ABM("X")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
Begin DoDot:1
+43 IF 'ABM("X")
QUIT
+44 DO SELBILL^ABMDE4X
End DoDot:1
+45 IF $GET(ABMNPIU)="N"!($GET(ABMNPIU)="B")
Begin DoDot:1
+46 SET ABMPNPI=$SELECT($PIECE($$NPI^XUSNPI("Individual_ID",$PIECE(ABM("A"),U,2)),U)>0:$PIECE($$NPI^XUSNPI("Individual_ID",$PIECE(ABM("A"),U,2)),U),1:"")
+47 SET ABMFP(ABMLINE,15)=ABMPNPI
+48 SET ABMFP(ABMLINE,30)="05"
End DoDot:1
+49 ;end new code HEAT5361
+50 SET ABMDXP=+$PIECE(ABMRX0,"^",13)
+51 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABMDXP))
Begin DoDot:1
+52 SET ABMDXP=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",0))
End DoDot:1
+53 SET ABMDX=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",+ABMDXP,0))
+54 ;CSV-c
SET ABMDX=$PIECE($$DX^ABMCVAPI(+ABMDX,ABMP("VDT")),U,2)
+55 SET ABMFP(ABMLINE,43)=ABMDX
+56 SET ABMFP(ABMLINE,52)="01"
+57 SET ABMLINE=$SELECT(ABMCNT=1:ABMLINE+3,1:ABMLINE+4)
+58 SET ABMFP(ABMLINE,67)=$JUSTIFY(ABMGROSS,8,2)
+59 IF ABMCNT=1
SET ABMLINE=ABMLINE+1
+60 SET ABMFP(ABMLINE,47)=$JUSTIFY(ABMGROSS,8,2)
+61 QUIT
+62 ;
PRT ;print
+1 DO EN^ABMFPRT(.ABMFP)
+2 SET J=27
+3 FOR
SET J=$ORDER(ABMFP(J))
IF 'J
QUIT
Begin DoDot:1
+4 KILL ABMFP(J)
End DoDot:1
+5 SET ABMCNT=0
+6 QUIT
