ABMDIPS ; IHS/ASDST/DMJ - GENERATE BILLS FOR PHYSICIAN IP SVCS. ;
;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009
;
;IHS/DSD/MRS - 8/3/1999 NOIS XAA-0899-200005 Patch 3 #7
; Changed variable name from ABMIO to ABMI0
;
; IHS/SD/SDR - v2.6 CSV
; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - modified to call ABMFEAPI
;
START ;START
K ABMQUIT
W $$EN^ABMVDF("IOF")
W !!,"This option will generate 3P Bills"
W !,"for inpatient physician services.",!
W !,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF"),"To use this option an inpatient bill must already exist"
W !,"in 3P Bill File.",!!
PAY ;enter payer
K DIC
S DIC("B")="ARIZONA MEDICAID"
S DIC="^AUTNINS(",DIC(0)="AEMQ"
D ^DIC Q:+Y<0
S ABMINS=+Y
S ABMITYP=$P($G(^AUTNINS(ABMINS,2)),U)
S ABMINAME=$P(^AUTNINS(ABMINS,0),U)
; Check for proper insurer file setup
S ABMI0=$G(^ABMNINS(DUZ(2),ABMINS,1,141,0))
I ABMI0="" D Q
.W *7,!,"Inpatient Physician Services not authorized for ",ABMINAME
.W !,"Need to add Visit Type 141 for insurer in Table Maintenance."
.D EOP^ABMDUTL(1)
CODE ;enter procedure code
S ABMCODE=$P(ABMI0,"^",16)
S:ABMCODE ABMCODE=$P($$CPT^ABMCVAPI(ABMCODE,ABMP("VDT")),U,2) ;CSV-c
K DIC
S DIC="^ICPT(",DIC(0)="AEMQ"
S DIC("A")="Enter HCPCS Code: "
S DIC("B")=$G(ABMCODE)
D ^DIC Q:+Y<0
S ABMCODE=+Y
RATE ;get rate
F ABMI=13,27 D
.S ABMDA=$O(^ABMDFEE(1,ABMI,"B",ABMCODE,0))
.Q:'ABMDA
.;S ABMRATE=$P(^ABMDFEE(1,ABMI,ABMDA,0),"^",2) ;abm*2.6*2 3PMS10003A
.S ABMRATE=$P($$ONE^ABMFEAPI(1,ABMI,ABMDA,$S($G(ABMP("VDT")):ABMP("VDT"),1:DT)),U) ;abm*2.6*2 3PMS10003A
S DIR("A")="Enter Charge"
S DIR("B")=$G(ABMRATE)
S DIR(0)="N" D ^DIR K DIR
S ABMRATE=Y
EXP ;mode of export
S ABMMOE=$P(ABMI0,"^",4)
I 'ABMMOE D
.W !
.K DIC S DIC="^ABMDEXP(",DIC(0)="AEMQ"
.D ^DIC S ABMMOE=+Y
Q:ABMMOE<0
S:^ABMDEXP(ABMMOE,0)["UB" ABMUB=1
REV ;revenue code
I $G(ABMUB) D
.S ABMRVCD=$P(ABMI0,"^",3)
.Q:ABMRVCD
.W !
.K DIC S DIC="^AUTTREVN(",DIC(0)="AEMQ"
.S DIC("A")="Enter Revenue Code: "
.D ^DIC S ABMRVCD=+Y
ASK ;ask look-up method
S DIR(0)="S^1:LOOP;2:INDIVIDUAL BILL"
S DIR("A")="Select Method of Bill Look-up"
S DIR("B")="LOOP"
D ^DIR K DIR
Q:'Y
S ABM(1)="LOOP"
S ABM(2)="IND"
D @ABM(Y)
S DIR("A")="Done - enter RETURN to continue" D EOP^ABMDUTL(0)
K ABMDUP,ABMPHY,ABMCODE,ABMPAT,ABMBATCH,ABMQUIT,ABMINS,ABMDTF,ABMDTT,ABMUNIT,ABMDICSV,ABMBNAME,ABM,ABMMOE,ABMI0,ABMRVCD,DIC
Q
LOOP ;LOOP HERE
W !!,"Begin Loop",!
S %DT("A")="Go Back to Date: "
S %DT("B")="01/01/97"
S %DT="AEP"
D ^%DT
Q:Y<0 S ABMSDT=+Y
S ABMP("BDFN")=+$G(^ABMDTMP("IPSVC",ABMINAME,"LAST"))
BY ;bypass with different ien
F S ABMP("BDFN")=$O(^ABMDBILL(DUZ(2),"AJ",ABMINS,ABMP("BDFN"))) Q:'ABMP("BDFN") D Q:$G(ABMQUIT)
.Q:$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U)<ABMSDT
.D SET
.Q:$P(ABMZERO,"^",7)'=111
.D ONE
.S ^ABMDTMP("IPSVC",ABMINAME,"LAST")=ABMP("BDFN")
.W ! S DIR(0)="E",DIR("A")="Enter RETURN to Continue Looping, ""^"" to Quit"
.D ^DIR K DIR
.K:Y ABMQUIT
Q
IND ;process one at a time
F D Q:'$G(ABMP("BDFN"))
.D ^ABMDBLK
.Q:'$G(ABMP("BDFN"))
.D SET
.D ONE
.K ABMQUIT
Q
ONE ;process one bill
S ABMCNT=0
D:$Y+IOSL>24 HDR
W !,$P(ABMZERO,U),?10,$P(^DPT(ABMPAT,0),U)
W ?40,$$SDT^ABMDUTL($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U))
W ?55,$$SDT^ABMDUTL($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",2))
F D Q:$G(ABMQUIT)
.S ABMCNT=ABMCNT+1
.D PHY Q:$G(ABMQUIT)
.D UNIT Q:$G(ABMQUIT)
.I '$G(ABMBATCH) D NB Q:$G(ABMQUIT)
.D NBILL
.Q:'$G(DA)
.D BFILE
Q
PHY ;enter physician
W !
K DIC,ABMPHY
S:ABMCNT=1 ABMPHY=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
S:ABMCNT=2 ABMPHY=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","O",0))
S:$G(ABMPHY) ABMPHY=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPHY,0),U)
S:$G(ABMPHY) DIC("B")=$P($G(^VA(200,+$G(ABMPHY),0)),U)
S DIC="^VA(200,",DIC(0)="AEMQ"
S DIC("A")="Enter Physician: "
D ^DIC
I +Y<0 S ABMQUIT=1 Q
S ABMPHY=+Y
Q
UNIT ;enter units
S X1=ABMDTT,X2=ABMDTF D ^%DTC S DIR("B")=X+1
S DIR(0)="N^1:99"
S DIR("A")="Enter # of Units: "
D ^DIR K DIR
S ABMUNIT=Y
I ABMUNIT'>0 S ABMQUIT=1
Q
NB ;enter new batch in file 9002274.6
K DIC
S DIC="^ABMDTXST(DUZ(2),"
S DIC(0)="LX"
D NOW^%DTC S X=%
D ^DIC
I +Y<0 S ABMQUIT=1 Q
S ABMBATCH=+Y
S DA=ABMBATCH
S DIE=DIC
S DR=".02////"_ABMMOE_";.05////"_DUZ_";.04////"_ABMINS_";.03////"_ABMITYP
S:$P($G(^ABMDEXP(ABMMOE,1)),"^",5)="E" DR=DR_";.14////IPPHYS.NUL"
D ^DIE
Q
NBILL ;create bill in bill file
K DA
D DUP I $G(ABMDUP) D I Y'=1 Q
.W !
.W !,"A physician IP services bill already exists for this provider"
.W !,"for this visit date and patient."
.S DIR("A")="Continue"
.S DIR("B")="NO"
.S DIR(0)="Y" D ^DIR K DIR
S ABM1(.02)=131
S ABM1(.03)=$P(ABMZERO,"^",3)
S ABM1(.05)=$P(ABMZERO,"^",5)
S ABM1(.06)=ABMMOE
S ABM1(.07)=141
S ABM1(.08)=ABMINS
S ABM1(.09)="C"
S ABM1(.1)=$P(ABMZERO,"^",10)
S ABM1(.14)=DUZ
S ABM1(.15)=DT
S ABM1(.16)="A"
S ABM1(.17)=ABMBATCH
S ABM1(.21)=ABMRATE*ABMUNIT
S ABM1(.23)=ABMRATE*ABMUNIT
S ABMBDFN=$$ADD^ABMDBAD1(.ABM1)
I 'DA W !!,"Bill NOT created." Q
S ABMBNAME=$P(^ABMDBILL(DUZ(2),DA,0),U)
W !!,"Bill # ",ABMBNAME," created"
N I F I=5,6,7,8,9,11,13,17 D
.Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),I))
.M ^ABMDBILL(DUZ(2),DA,I)=^ABMDBILL(DUZ(2),ABMP("BDFN"),I)
S ^ABMDBILL(DUZ(2),DA,41,0)="^9002274.4041P^1^1"
S ^ABMDBILL(DUZ(2),DA,41,1,0)=ABMPHY_"^A"
MED ;file entry under misc svcs
S ^ABMDBILL(DUZ(2),DA,43,0)="^9002274.4043P^1^1"
S ^ABMDBILL(DUZ(2),DA,43,1,0)=ABMCODE_"^"_$G(ABMRVCD)_"^"_ABMUNIT_"^"_ABMRATE_"^^"_1
S $P(^ABMDBILL(DUZ(2),DA,0),"^",4)="B",ABMAPOK=1
S DIK="^ABMDBILL(DUZ(2)," D IX1^DIK
Q
BFILE ;file in 3P TX STATUS file
K DIC
S DIC(0)="LXE"
S X=ABMBNAME
S DA(1)=ABMBATCH
S DIC="^ABMDTXST(DUZ(2),DA(1),2,"
S:'$D(^ABMDTXST(DUZ(2),DA(1),2,0)) ^(0)="^9002274.61P^^"
D ^DIC
I +Y<0 W !!,*7,"Bill NOT added to 3P TX STATUS FILE",! Q
W " - added to batch # ",ABMBATCH,!
Q
SET ;set some variables
S ABMZERO=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
S ABMPAT=$P(ABMZERO,"^",5)
S ABMDTF=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U),ABMDTT=$P(^(7),"^",2)
Q
HDR ;screen header
W $$EN^ABMVDF("IOF")
S:'$D(ABM("EQ")) $P(ABM("EQ"),"=",80)=""
W !,"BILL #"
W ?10,"PATIENT"
W ?40,"ADMIT DATE"
W ?55,"DISCHARGE DATE"
W !,ABM("EQ"),!
Q
DUP ;check for duplicate bill
K ABMDUP
N I S I=0 F S I=$O(^ABMDBILL(DUZ(2),"D",ABMPAT,I)) Q:'I D
.Q:$P(^ABMDBILL(DUZ(2),I,0),"^",7)'=141
.Q:$P(^ABMDBILL(DUZ(2),I,7),U)'=ABMDTF
.S ABMDPV=$P($G(^ABMDBILL(DUZ(2),I,41,1,0)),U)
.Q:ABMDPV'=ABMPHY
.Q:$P(^ABMDBILL(DUZ(2),I,0),"^",8)'=ABMINS
.S ABMDUP=1
Q
ABMDIPS ; IHS/ASDST/DMJ - GENERATE BILLS FOR PHYSICIAN IP SVCS. ;
+1 ;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009
+2 ;
+3 ;IHS/DSD/MRS - 8/3/1999 NOIS XAA-0899-200005 Patch 3 #7
+4 ; Changed variable name from ABMIO to ABMI0
+5 ;
+6 ; IHS/SD/SDR - v2.6 CSV
+7 ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - modified to call ABMFEAPI
+8 ;
START ;START
+1 KILL ABMQUIT
+2 WRITE $$EN^ABMVDF("IOF")
+3 WRITE !!,"This option will generate 3P Bills"
+4 WRITE !,"for inpatient physician services.",!
+5 WRITE !,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF"),"To use this option an inpatient bill must already exist"
+6 WRITE !,"in 3P Bill File.",!!
PAY ;enter payer
+1 KILL DIC
+2 SET DIC("B")="ARIZONA MEDICAID"
+3 SET DIC="^AUTNINS("
SET DIC(0)="AEMQ"
+4 DO ^DIC
IF +Y<0
QUIT
+5 SET ABMINS=+Y
+6 SET ABMITYP=$PIECE($GET(^AUTNINS(ABMINS,2)),U)
+7 SET ABMINAME=$PIECE(^AUTNINS(ABMINS,0),U)
+8 ; Check for proper insurer file setup
+9 SET ABMI0=$GET(^ABMNINS(DUZ(2),ABMINS,1,141,0))
+10 IF ABMI0=""
Begin DoDot:1
+11 WRITE *7,!,"Inpatient Physician Services not authorized for ",ABMINAME
+12 WRITE !,"Need to add Visit Type 141 for insurer in Table Maintenance."
+13 DO EOP^ABMDUTL(1)
End DoDot:1
QUIT
CODE ;enter procedure code
+1 SET ABMCODE=$PIECE(ABMI0,"^",16)
+2 ;CSV-c
IF ABMCODE
SET ABMCODE=$PIECE($$CPT^ABMCVAPI(ABMCODE,ABMP("VDT")),U,2)
+3 KILL DIC
+4 SET DIC="^ICPT("
SET DIC(0)="AEMQ"
+5 SET DIC("A")="Enter HCPCS Code: "
+6 SET DIC("B")=$GET(ABMCODE)
+7 DO ^DIC
IF +Y<0
QUIT
+8 SET ABMCODE=+Y
RATE ;get rate
+1 FOR ABMI=13,27
Begin DoDot:1
+2 SET ABMDA=$ORDER(^ABMDFEE(1,ABMI,"B",ABMCODE,0))
+3 IF 'ABMDA
QUIT
+4 ;S ABMRATE=$P(^ABMDFEE(1,ABMI,ABMDA,0),"^",2) ;abm*2.6*2 3PMS10003A
+5 ;abm*2.6*2 3PMS10003A
SET ABMRATE=$PIECE($$ONE^ABMFEAPI(1,ABMI,ABMDA,$SELECT($GET(ABMP("VDT")):ABMP("VDT"),1:DT)),U)
End DoDot:1
+6 SET DIR("A")="Enter Charge"
+7 SET DIR("B")=$GET(ABMRATE)
+8 SET DIR(0)="N"
DO ^DIR
KILL DIR
+9 SET ABMRATE=Y
EXP ;mode of export
+1 SET ABMMOE=$PIECE(ABMI0,"^",4)
+2 IF 'ABMMOE
Begin DoDot:1
+3 WRITE !
+4 KILL DIC
SET DIC="^ABMDEXP("
SET DIC(0)="AEMQ"
+5 DO ^DIC
SET ABMMOE=+Y
End DoDot:1
+6 IF ABMMOE<0
QUIT
+7 IF ^ABMDEXP(ABMMOE,0)["UB"
SET ABMUB=1
REV ;revenue code
+1 IF $GET(ABMUB)
Begin DoDot:1
+2 SET ABMRVCD=$PIECE(ABMI0,"^",3)
+3 IF ABMRVCD
QUIT
+4 WRITE !
+5 KILL DIC
SET DIC="^AUTTREVN("
SET DIC(0)="AEMQ"
+6 SET DIC("A")="Enter Revenue Code: "
+7 DO ^DIC
SET ABMRVCD=+Y
End DoDot:1
ASK ;ask look-up method
+1 SET DIR(0)="S^1:LOOP;2:INDIVIDUAL BILL"
+2 SET DIR("A")="Select Method of Bill Look-up"
+3 SET DIR("B")="LOOP"
+4 DO ^DIR
KILL DIR
+5 IF 'Y
QUIT
+6 SET ABM(1)="LOOP"
+7 SET ABM(2)="IND"
+8 DO @ABM(Y)
+9 SET DIR("A")="Done - enter RETURN to continue"
DO EOP^ABMDUTL(0)
+10 KILL ABMDUP,ABMPHY,ABMCODE,ABMPAT,ABMBATCH,ABMQUIT,ABMINS,ABMDTF,ABMDTT,ABMUNIT,ABMDICSV,ABMBNAME,ABM,ABMMOE,ABMI0,ABMRVCD,DIC
+11 QUIT
LOOP ;LOOP HERE
+1 WRITE !!,"Begin Loop",!
+2 SET %DT("A")="Go Back to Date: "
+3 SET %DT("B")="01/01/97"
+4 SET %DT="AEP"
+5 DO ^%DT
+6 IF Y<0
QUIT
SET ABMSDT=+Y
+7 SET ABMP("BDFN")=+$GET(^ABMDTMP("IPSVC",ABMINAME,"LAST"))
BY ;bypass with different ien
+1 FOR
SET ABMP("BDFN")=$ORDER(^ABMDBILL(DUZ(2),"AJ",ABMINS,ABMP("BDFN")))
IF 'ABMP("BDFN")
QUIT
Begin DoDot:1
+2 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U)<ABMSDT
QUIT
+3 DO SET
+4 IF $PIECE(ABMZERO,"^",7)'=111
QUIT
+5 DO ONE
+6 SET ^ABMDTMP("IPSVC",ABMINAME,"LAST")=ABMP("BDFN")
+7 WRITE !
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue Looping, ""^"" to Quit"
+8 DO ^DIR
KILL DIR
+9 IF Y
KILL ABMQUIT
End DoDot:1
IF $GET(ABMQUIT)
QUIT
+10 QUIT
IND ;process one at a time
+1 FOR
Begin DoDot:1
+2 DO ^ABMDBLK
+3 IF '$GET(ABMP("BDFN"))
QUIT
+4 DO SET
+5 DO ONE
+6 KILL ABMQUIT
End DoDot:1
IF '$GET(ABMP("BDFN"))
QUIT
+7 QUIT
ONE ;process one bill
+1 SET ABMCNT=0
+2 IF $Y+IOSL>24
DO HDR
+3 WRITE !,$PIECE(ABMZERO,U),?10,$PIECE(^DPT(ABMPAT,0),U)
+4 WRITE ?40,$$SDT^ABMDUTL($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U))
+5 WRITE ?55,$$SDT^ABMDUTL($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",2))
+6 FOR
Begin DoDot:1
+7 SET ABMCNT=ABMCNT+1
+8 DO PHY
IF $GET(ABMQUIT)
QUIT
+9 DO UNIT
IF $GET(ABMQUIT)
QUIT
+10 IF '$GET(ABMBATCH)
DO NB
IF $GET(ABMQUIT)
QUIT
+11 DO NBILL
+12 IF '$GET(DA)
QUIT
+13 DO BFILE
End DoDot:1
IF $GET(ABMQUIT)
QUIT
+14 QUIT
PHY ;enter physician
+1 WRITE !
+2 KILL DIC,ABMPHY
+3 IF ABMCNT=1
SET ABMPHY=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
+4 IF ABMCNT=2
SET ABMPHY=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","O",0))
+5 IF $GET(ABMPHY)
SET ABMPHY=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPHY,0),U)
+6 IF $GET(ABMPHY)
SET DIC("B")=$PIECE($GET(^VA(200,+$GET(ABMPHY),0)),U)
+7 SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
+8 SET DIC("A")="Enter Physician: "
+9 DO ^DIC
+10 IF +Y<0
SET ABMQUIT=1
QUIT
+11 SET ABMPHY=+Y
+12 QUIT
UNIT ;enter units
+1 SET X1=ABMDTT
SET X2=ABMDTF
DO ^%DTC
SET DIR("B")=X+1
+2 SET DIR(0)="N^1:99"
+3 SET DIR("A")="Enter # of Units: "
+4 DO ^DIR
KILL DIR
+5 SET ABMUNIT=Y
+6 IF ABMUNIT'>0
SET ABMQUIT=1
+7 QUIT
NB ;enter new batch in file 9002274.6
+1 KILL DIC
+2 SET DIC="^ABMDTXST(DUZ(2),"
+3 SET DIC(0)="LX"
+4 DO NOW^%DTC
SET X=%
+5 DO ^DIC
+6 IF +Y<0
SET ABMQUIT=1
QUIT
+7 SET ABMBATCH=+Y
+8 SET DA=ABMBATCH
+9 SET DIE=DIC
+10 SET DR=".02////"_ABMMOE_";.05////"_DUZ_";.04////"_ABMINS_";.03////"_ABMITYP
+11 IF $PIECE($GET(^ABMDEXP(ABMMOE,1)),"^",5)="E"
SET DR=DR_";.14////IPPHYS.NUL"
+12 DO ^DIE
+13 QUIT
NBILL ;create bill in bill file
+1 KILL DA
+2 DO DUP
IF $GET(ABMDUP)
Begin DoDot:1
+3 WRITE !
+4 WRITE !,"A physician IP services bill already exists for this provider"
+5 WRITE !,"for this visit date and patient."
+6 SET DIR("A")="Continue"
+7 SET DIR("B")="NO"
+8 SET DIR(0)="Y"
DO ^DIR
KILL DIR
End DoDot:1
IF Y'=1
QUIT
+9 SET ABM1(.02)=131
+10 SET ABM1(.03)=$PIECE(ABMZERO,"^",3)
+11 SET ABM1(.05)=$PIECE(ABMZERO,"^",5)
+12 SET ABM1(.06)=ABMMOE
+13 SET ABM1(.07)=141
+14 SET ABM1(.08)=ABMINS
+15 SET ABM1(.09)="C"
+16 SET ABM1(.1)=$PIECE(ABMZERO,"^",10)
+17 SET ABM1(.14)=DUZ
+18 SET ABM1(.15)=DT
+19 SET ABM1(.16)="A"
+20 SET ABM1(.17)=ABMBATCH
+21 SET ABM1(.21)=ABMRATE*ABMUNIT
+22 SET ABM1(.23)=ABMRATE*ABMUNIT
+23 SET ABMBDFN=$$ADD^ABMDBAD1(.ABM1)
+24 IF 'DA
WRITE !!,"Bill NOT created."
QUIT
+25 SET ABMBNAME=$PIECE(^ABMDBILL(DUZ(2),DA,0),U)
+26 WRITE !!,"Bill # ",ABMBNAME," created"
+27 NEW I
FOR I=5,6,7,8,9,11,13,17
Begin DoDot:1
+28 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),I))
QUIT
+29 MERGE ^ABMDBILL(DUZ(2),DA,I)=^ABMDBILL(DUZ(2),ABMP("BDFN"),I)
End DoDot:1
+30 SET ^ABMDBILL(DUZ(2),DA,41,0)="^9002274.4041P^1^1"
+31 SET ^ABMDBILL(DUZ(2),DA,41,1,0)=ABMPHY_"^A"
MED ;file entry under misc svcs
+1 SET ^ABMDBILL(DUZ(2),DA,43,0)="^9002274.4043P^1^1"
+2 SET ^ABMDBILL(DUZ(2),DA,43,1,0)=ABMCODE_"^"_$GET(ABMRVCD)_"^"_ABMUNIT_"^"_ABMRATE_"^^"_1
+3 SET $PIECE(^ABMDBILL(DUZ(2),DA,0),"^",4)="B"
SET ABMAPOK=1
+4 SET DIK="^ABMDBILL(DUZ(2),"
DO IX1^DIK
+5 QUIT
BFILE ;file in 3P TX STATUS file
+1 KILL DIC
+2 SET DIC(0)="LXE"
+3 SET X=ABMBNAME
+4 SET DA(1)=ABMBATCH
+5 SET DIC="^ABMDTXST(DUZ(2),DA(1),2,"
+6 IF '$DATA(^ABMDTXST(DUZ(2),DA(1),2,0))
SET ^(0)="^9002274.61P^^"
+7 DO ^DIC
+8 IF +Y<0
WRITE !!,*7,"Bill NOT added to 3P TX STATUS FILE",!
QUIT
+9 WRITE " - added to batch # ",ABMBATCH,!
+10 QUIT
SET ;set some variables
+1 SET ABMZERO=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
+2 SET ABMPAT=$PIECE(ABMZERO,"^",5)
+3 SET ABMDTF=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U)
SET ABMDTT=$PIECE(^(7),"^",2)
+4 QUIT
HDR ;screen header
+1 WRITE $$EN^ABMVDF("IOF")
+2 IF '$DATA(ABM("EQ"))
SET $PIECE(ABM("EQ"),"=",80)=""
+3 WRITE !,"BILL #"
+4 WRITE ?10,"PATIENT"
+5 WRITE ?40,"ADMIT DATE"
+6 WRITE ?55,"DISCHARGE DATE"
+7 WRITE !,ABM("EQ"),!
+8 QUIT
DUP ;check for duplicate bill
+1 KILL ABMDUP
+2 NEW I
SET I=0
FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),"D",ABMPAT,I))
IF 'I
QUIT
Begin DoDot:1
+3 IF $PIECE(^ABMDBILL(DUZ(2),I,0),"^",7)'=141
QUIT
+4 IF $PIECE(^ABMDBILL(DUZ(2),I,7),U)'=ABMDTF
QUIT
+5 SET ABMDPV=$PIECE($GET(^ABMDBILL(DUZ(2),I,41,1,0)),U)
+6 IF ABMDPV'=ABMPHY
QUIT
+7 IF $PIECE(^ABMDBILL(DUZ(2),I,0),"^",8)'=ABMINS
QUIT
+8 SET ABMDUP=1
End DoDot:1
+9 QUIT
