ABMZIPS ;IHS/DSD/DMJ - GENERATE CLAIMS FOR AHCCCS PHYSICIAN IP SVCS. [ 05/01/98 11:11 AM ]
;;2.0;IHS 3P BILLING SYSTEM;**1**;1 APRIL 98
START ;START
K ABMQUIT
W $$^ABMVDF("IOF")
W !!,"This option will generate 3P Bills"
W !,"for inpatient physician services.",!
W !,$$^ABMVDF("RVN"),"NOTE:",$$^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)),"^",1)
S ABMINAME=$P(^AUTNINS(ABMINS,0),"^",1)
CODE ;enter procedure code
K DIC
S DIC="^ICPT(",DIC(0)="AEMQ"
S DIC("B")="W0087"
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)
S DIR("A")="Enter Charge"
S DIR("B")=$G(ABMRATE)
S DIR(0)="N" D ^DIR K DIR
S ABMRATE=Y
ASK ;ask look-up method
S DIR(0)="S^1:INDIVIDUAL;2:LOOP"
S DIR("A")="Select Method of Bill Look-up"
S DIR("B")="INDIVIDUAL"
D ^DIR K DIR
Q:'Y
S ABM(1)="IND"
S ABM(2)="LOOP"
D @ABM(Y)
K ABMDUP,ABMPHY,ABMCODE,ABMPAT,ABMBATCH,ABMQUIT,ABMINS,ABMDTF,ABMDTT,ABMUNIT,ABMDICSV,ABMBNAME,ABM
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),"^",1)<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 ^ABMZBDIC
.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,"^",1),?10,$P(^DPT(ABMPAT,0),"^",1)
W ?40,$$SDT^ABMDUTL($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",1))
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),"^",1)
S:$G(ABMPHY) DIC("B")=$P($G(^VA(200,+$G(ABMPHY),0)),"^",1)
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////3;.05////"_DUZ_";.04////"_ABMINS_";.03////"_ABMITYP
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."
.W !,"Bill # ",$P(^ABMDBILL(DUZ(2),ABMDUP,0),"^",1)
.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)=3
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),"^",1)
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:$P($G(^ABMDBILL(DUZ(2),DA,8)),"^",10) $P(^(8),"^",10)=""
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_"^^"_ABMUNIT_"^"_ABMRATE_"^^"_1
S $P(^ABMDBILL(DUZ(2),DA,0),"^",4)="B"
S DIK="^ABMDBILL(DUZ(2)," D IX1^DIK
Q
BFILE ;file in 3P TX STATUS file
K DIC
S DIC(0)="LX"
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),"^",1),ABMDTT=$P(^(7),"^",2)
Q
HDR ;screen header
W $$^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!($G(ABMDUP)) D
.Q:$P(^ABMDBILL(DUZ(2),I,0),"^",7)'=141
.Q:$P(^ABMDBILL(DUZ(2),I,7),"^",1)'=ABMDTF
.S ABMDPV=$P($G(^ABMDBILL(DUZ(2),I,41,1,0)),"^",1)
.Q:ABMDPV'=ABMPHY
.Q:$P(^ABMDBILL(DUZ(2),I,0),"^",8)'=ABMINS
.S ABMDUP=I
Q
ABMZIPS ;IHS/DSD/DMJ - GENERATE CLAIMS FOR AHCCCS PHYSICIAN IP SVCS. [ 05/01/98 11:11 AM ]
+1 ;;2.0;IHS 3P BILLING SYSTEM;**1**;1 APRIL 98
START ;START
+1 KILL ABMQUIT
+2 WRITE $$^ABMVDF("IOF")
+3 WRITE !!,"This option will generate 3P Bills"
+4 WRITE !,"for inpatient physician services.",!
+5 WRITE !,$$^ABMVDF("RVN"),"NOTE:",$$^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)),"^",1)
+7 SET ABMINAME=$PIECE(^AUTNINS(ABMINS,0),"^",1)
CODE ;enter procedure code
+1 KILL DIC
+2 SET DIC="^ICPT("
SET DIC(0)="AEMQ"
+3 SET DIC("B")="W0087"
+4 DO ^DIC
IF +Y<0
QUIT
+5 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 SET ABMRATE=$PIECE(^ABMDFEE(1,ABMI,ABMDA,0),"^",2)
End DoDot:1
+5 SET DIR("A")="Enter Charge"
+6 SET DIR("B")=$GET(ABMRATE)
+7 SET DIR(0)="N"
DO ^DIR
KILL DIR
+8 SET ABMRATE=Y
ASK ;ask look-up method
+1 SET DIR(0)="S^1:INDIVIDUAL;2:LOOP"
+2 SET DIR("A")="Select Method of Bill Look-up"
+3 SET DIR("B")="INDIVIDUAL"
+4 DO ^DIR
KILL DIR
+5 IF 'Y
QUIT
+6 SET ABM(1)="IND"
+7 SET ABM(2)="LOOP"
+8 DO @ABM(Y)
+9 KILL ABMDUP,ABMPHY,ABMCODE,ABMPAT,ABMBATCH,ABMQUIT,ABMINS,ABMDTF,ABMDTT,ABMUNIT,ABMDICSV,ABMBNAME,ABM
+10 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),"^",1)<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 ^ABMZBDIC
+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,"^",1),?10,$PIECE(^DPT(ABMPAT,0),"^",1)
+4 WRITE ?40,$$SDT^ABMDUTL($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",1))
+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),"^",1)
+6 IF $GET(ABMPHY)
SET DIC("B")=$PIECE($GET(^VA(200,+$GET(ABMPHY),0)),"^",1)
+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////3;.05////"_DUZ_";.04////"_ABMINS_";.03////"_ABMITYP
+11 DO ^DIE
+12 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 WRITE !,"Bill # ",$PIECE(^ABMDBILL(DUZ(2),ABMDUP,0),"^",1)
+7 SET DIR("A")="Continue"
+8 SET DIR("B")="NO"
+9 SET DIR(0)="Y"
DO ^DIR
KILL DIR
End DoDot:1
IF Y'=1
QUIT
+10 SET ABM1(.02)=131
+11 SET ABM1(.03)=$PIECE(ABMZERO,"^",3)
+12 SET ABM1(.05)=$PIECE(ABMZERO,"^",5)
+13 SET ABM1(.06)=3
+14 SET ABM1(.07)=141
+15 SET ABM1(.08)=ABMINS
+16 SET ABM1(.09)="C"
+17 SET ABM1(.1)=$PIECE(ABMZERO,"^",10)
+18 SET ABM1(.14)=DUZ
+19 SET ABM1(.15)=DT
+20 SET ABM1(.16)="A"
+21 SET ABM1(.17)=ABMBATCH
+22 SET ABM1(.21)=ABMRATE*ABMUNIT
+23 SET ABM1(.23)=ABMRATE*ABMUNIT
+24 SET ABMBDFN=$$ADD^ABMDBAD1(.ABM1)
+25 IF 'DA
WRITE !!,"Bill NOT created."
QUIT
+26 SET ABMBNAME=$PIECE(^ABMDBILL(DUZ(2),DA,0),"^",1)
+27 WRITE !!,"Bill # ",ABMBNAME," created"
+28 NEW I
FOR I=5,6,7,8,9,11,13,17
Begin DoDot:1
+29 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),I))
QUIT
+30 MERGE ^ABMDBILL(DUZ(2),DA,I)=^ABMDBILL(DUZ(2),ABMP("BDFN"),I)
End DoDot:1
+31 IF $PIECE($GET(^ABMDBILL(DUZ(2),DA,8)),"^",10)
SET $PIECE(^(8),"^",10)=""
+32 SET ^ABMDBILL(DUZ(2),DA,41,0)="^9002274.4041P^1^1"
+33 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_"^^"_ABMUNIT_"^"_ABMRATE_"^^"_1
+3 SET $PIECE(^ABMDBILL(DUZ(2),DA,0),"^",4)="B"
+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)="LX"
+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),"^",1)
SET ABMDTT=$PIECE(^(7),"^",2)
+4 QUIT
HDR ;screen header
+1 WRITE $$^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!($GET(ABMDUP))
QUIT
Begin DoDot:1
+3 IF $PIECE(^ABMDBILL(DUZ(2),I,0),"^",7)'=141
QUIT
+4 IF $PIECE(^ABMDBILL(DUZ(2),I,7),"^",1)'=ABMDTF
QUIT
+5 SET ABMDPV=$PIECE($GET(^ABMDBILL(DUZ(2),I,41,1,0)),"^",1)
+6 IF ABMDPV'=ABMPHY
QUIT
+7 IF $PIECE(^ABMDBILL(DUZ(2),I,0),"^",8)'=ABMINS
QUIT
+8 SET ABMDUP=I
End DoDot:1
+9 QUIT
