Routine: ABMDF24

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

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

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"))

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)

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"

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

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)

PRT ;print

 D EN^ABMFPRT(.ABMFP)

 S J=27

 F  S J=$O(ABMFP(J)) Q:'J  D

 .K ABMFP(J)

 S ABMCNT=0

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

ABMDF24.m