ABMDE8C ; IHS/ASDST/DMJ - Page 8 - ROOM AND BOARD ;
;;2.6;IHS Third Party Billing System;**2,6,8,9**;NOV 12, 2009
;
; IHS/SD/SDR - v2.5 p9 - IM16660 - 4-digit revenue codes
; IHS/SD/SDR - v2.5 p10 - IM20018 - Added CPT prompt
; IHS/SD/SDR - v2.5 p12 - IM24096 - Changed code to correct inpatient rev codes
; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - Modified to call ABMFEAPI
; IHS/SD/SDR - abm*2.6*6 - NOHEAT - DOS defaults but no prompt to edit it
;
DISP ;EP
K ABMZ,DIC S ABMZ("TITL")="REVENUE CODE",ABMZ("PG")="8C"
I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1
E D SUM^ABMDE1
;
FEE S ABMZ("CAT")=31,ABMZ("SUB")=25,ABMZ("DAYS")=0
S ABMZ("DR")=";W !;.02//1",ABMZ("CHRG")=";W !;.03",ABMZ("ITEM")="REVENUE CODE",ABMZ("DIC")="^AUTTREVN("
S ABMZ("X")="X",(ABMZ("TOTL"),ABMZ("DAYS"))=0
D C^ABMDE8X
D HD G LOOP
HD W !?71,"TOTAL"
W !?5,"REVENUE CODE",?37,"CPT",?44,"CHARGE",?54,"DAYS",?61,"UNITS",?71,"CHARGE"
W !?5,"=============================",?37,"===",?44,"======",?54,"====",?61,"=====",?70,"========="
Q
LOOP ;LOOP
S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,ABM)) Q:'ABM S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D PC1
I ABMZ("NUM")>0 W !?54,"====",?70,"=========",!?53,$J(ABMZ("DAYS"),4),?69,$J("$"_($FN(ABMZ("TOTL"),",",2)),10)
I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
G XIT
;
PC1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),25,ABM("X"),0),ABM("X")=$P(^(0),U)
S ABMZ("UNIT")=$P(ABM("X0"),U,2)
S:'+ABMZ("UNIT") ABMZ("UNIT")=1
S ABMZ(ABM("I"))=$$GETREV^ABMDUTL(ABM("X"))_U_ABM_U_$P(ABM("X0"),U,2)_U_$S($P(ABM("X0"),U,7):$P($G(^ICPT($P(ABM("X0"),U,7),0)),U),1:"")
EOP I $Y>(IOSL-5) D PAUSE^ABMDE1,HD
I ABM("X")\10=17,$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U)'=85 S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".51////85" D ^DIE
W !,"[",ABM("I"),"]"
I $P(ABM("X0"),"^",4) D
.W ?5,"CHARGE DATE: "
.W $$CDT^ABMDUTL($P(ABM("X0"),"^",4)),!
W ?5,$P(ABMZ(ABM("I")),U)
S ABMU(1)="?36"_U_$P(ABMZ(ABM("I")),U,4)
S ABMU(2)="?44"_U_$J($P(ABM("X0"),U,3)+$P(ABM("X0"),U,6),6,2)
I (+ABM("X")>99&(+ABM("X")<220)) S ABMU(3)="?54"_U_$J(ABMZ("UNIT"),3),ABMZ("DAYS")=ABMZ("UNIT")+ABMZ("DAYS")
E S ABMU(3)="?56"_U_0
S ABMU(4)="?62"_U_$J(ABMZ("UNIT"),3)
S ABMU(5)="?70"_U_$J($FN((ABMZ("UNIT")*$P(ABM("X0"),U,3))+$P(ABM("X0"),U,6),",",2),9)
S ABMZ("TOTL")=($P(ABM("X0"),U,3)*ABMZ("UNIT"))+$P(ABM("X0"),U,6)+ABMZ("TOTL")
S ABMU("TXT")=$P(^AUTTREVN(ABM("X"),0),U,2)
S ABMU("RM")=37,ABMU("LM")=10 D ^ABMDWRAP
Q
;
XIT K ABM
Q
A ;ADD ENTRY
S DIC("P")=$P(^DD(9002274.3,25,0),U,2)
S DIC="^AUTTREVN(",DIC(0)="AEMQ"
K DIC("A")
D ^DIC
Q:+Y<0 S ABMZ("RVCODE")=+Y
S DA(1)=ABMP("CDFN")
S DIC="^ABMDCLM(DUZ(2),DA(1),25,",X=ABMZ("RVCODE")
K DD,DO D FILE^DICN
Q:+Y<0 S DA=+Y
S ABMZ("NUM")=+$G(ABMZ("NUM"))+1
D DEL100
E ;EDIT EXISTING ENTRY
I '$G(ABMZ("NUM")) G A
I '$G(ABMZ("RVCODE")) D
.K DA
.S DA(1)=ABMP("CDFN")
.I ABMZ("NUM")=1 S Y=1
.E S DIR(0)="NO^1:"_ABMZ("NUM") D ^DIR K DIR Q:'Y
.S DA=$P(ABMZ(Y),"^",2)
.S ABMZ("RVCODE")=$P(^ABMDCLM(DUZ(2),DA(1),25,DA,0),U)
Q:'$G(DA)
;S ABMZ("UC")=$P($G(^ABMDFEE(ABMP("FEE"),31,ABMZ("RVCODE"),0)),"^",2) ;abm*2.6*2 3PMS10003A
S ABMZ("UC")=$P($$ONE^ABMFEAPI(ABMP("FEE"),31,ABMZ("RVCODE"),ABMP("VDT")),U) ;abm*2.6*2 3PMS10003A
S DIE="^ABMDCLM(DUZ(2),DA(1),25,"
S DR=".02;.03//"_ABMZ("UC")_";.07"
;start new code abm*2.6*9 NARR
D ^DIE
S DR=""
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7)'="",$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7))) D
.Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010" ;only 5010 formats
.S ABMCNCK=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7),0))
.I ABMCNCK,$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMCNCK,0)),U,2)="Y" S DR="22"
;end new code abm*2.6*9 NARR
;S:'$P(^AUTTREVN(ABMZ("RVCODE"),0),"^",5) DR=DR_";.04" ;abm*2.6*6 NOHEAT
S DR=DR_";.04" ;abm*2.6*6 NOHEAT
D ^DIE
;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7)'="",($P($G(^DIC(81.1,$P($G(^ICPT($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7),0)),U,3),0)),U)["IMMUNIZATION") S DR="15//" D ^DIE ;abm*2.6*6 5010 ;abm*2.6*8 HEAT41190
S ABMTCPT=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7) ;abm*2.6*8 HEAT41190
I ABMTCPT'="",$P($G(^ICPT($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7),0)),U,3),($P($G(^DIC(81.1,$P($G(^ICPT(ABMTCPT,0)),U,3),0)),U)["IMMUNIZATION") S DR="15//" D ^DIE ;abm*2.6*8 HEAT41190
Q
DEL100 ;if 100 ask to delete
Q:ABMZ("RVCODE")'=100
W !!,"You have entered an all inclusive revenue code. Do you want to"
W !,$$EN^ABMVDF("RVN"),"DELETE ALL",$$EN^ABMVDF("RVF")," line items from the other pages?",!
S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
Q:Y'=1
W !
N I F I=21,23,27,33,35,37,39,43,45 D
.Q:'$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,0))
.W !,$P(^DD(9002274.3,I,0),U)," deleted."
.K ^ABMDCLM(DUZ(2),ABMP("CDFN"),I)
W !
Q
ABMDE8C ; IHS/ASDST/DMJ - Page 8 - ROOM AND BOARD ;
+1 ;;2.6;IHS Third Party Billing System;**2,6,8,9**;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - v2.5 p9 - IM16660 - 4-digit revenue codes
+4 ; IHS/SD/SDR - v2.5 p10 - IM20018 - Added CPT prompt
+5 ; IHS/SD/SDR - v2.5 p12 - IM24096 - Changed code to correct inpatient rev codes
+6 ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - Modified to call ABMFEAPI
+7 ; IHS/SD/SDR - abm*2.6*6 - NOHEAT - DOS defaults but no prompt to edit it
+8 ;
DISP ;EP
+1 KILL ABMZ,DIC
SET ABMZ("TITL")="REVENUE CODE"
SET ABMZ("PG")="8C"
+2 IF $DATA(ABMP("DDL"))
IF $Y>(IOSL-9)
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
IF 1
+3 IF '$TEST
DO SUM^ABMDE1
+4 ;
FEE SET ABMZ("CAT")=31
SET ABMZ("SUB")=25
SET ABMZ("DAYS")=0
+1 SET ABMZ("DR")=";W !;.02//1"
SET ABMZ("CHRG")=";W !;.03"
SET ABMZ("ITEM")="REVENUE CODE"
SET ABMZ("DIC")="^AUTTREVN("
+2 SET ABMZ("X")="X"
SET (ABMZ("TOTL"),ABMZ("DAYS"))=0
+3 DO C^ABMDE8X
+4 DO HD
GOTO LOOP
HD WRITE !?71,"TOTAL"
+1 WRITE !?5,"REVENUE CODE",?37,"CPT",?44,"CHARGE",?54,"DAYS",?61,"UNITS",?71,"CHARGE"
+2 WRITE !?5,"=============================",?37,"===",?44,"======",?54,"====",?61,"=====",?70,"========="
+3 QUIT
LOOP ;LOOP
+1 SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0
FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,ABM))
IF 'ABM
QUIT
SET ABM("X")=ABM
SET ABMZ("NUM")=ABM("I")
DO PC1
+2 IF ABMZ("NUM")>0
WRITE !?54,"====",?70,"=========",!?53,$JUSTIFY(ABMZ("DAYS"),4),?69,$JUSTIFY("$"_($FNUMBER(ABMZ("TOTL"),",",2)),10)
+3 IF +$ORDER(ABME(0))
SET ABME("CONT")=""
DO ^ABMDERR
KILL ABME("CONT")
+4 GOTO XIT
+5 ;
PC1 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),25,ABM("X"),0)
SET ABM("X")=$PIECE(^(0),U)
+1 SET ABMZ("UNIT")=$PIECE(ABM("X0"),U,2)
+2 IF '+ABMZ("UNIT")
SET ABMZ("UNIT")=1
+3 SET ABMZ(ABM("I"))=$$GETREV^ABMDUTL(ABM("X"))_U_ABM_U_$PIECE(ABM("X0"),U,2)_U_$SELECT($PIECE(ABM("X0"),U,7):$PIECE($GET(^ICPT($PIECE(ABM("X0"),U,7),0)),U),1:"")
EOP IF $Y>(IOSL-5)
DO PAUSE^ABMDE1
DO HD
+1 IF ABM("X")\10=17
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U)'=85
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".51////85"
DO ^DIE
+2 WRITE !,"[",ABM("I"),"]"
+3 IF $PIECE(ABM("X0"),"^",4)
Begin DoDot:1
+4 WRITE ?5,"CHARGE DATE: "
+5 WRITE $$CDT^ABMDUTL($PIECE(ABM("X0"),"^",4)),!
End DoDot:1
+6 WRITE ?5,$PIECE(ABMZ(ABM("I")),U)
+7 SET ABMU(1)="?36"_U_$PIECE(ABMZ(ABM("I")),U,4)
+8 SET ABMU(2)="?44"_U_$JUSTIFY($PIECE(ABM("X0"),U,3)+$PIECE(ABM("X0"),U,6),6,2)
+9 IF (+ABM("X")>99&(+ABM("X")<220))
SET ABMU(3)="?54"_U_$JUSTIFY(ABMZ("UNIT"),3)
SET ABMZ("DAYS")=ABMZ("UNIT")+ABMZ("DAYS")
+10 IF '$TEST
SET ABMU(3)="?56"_U_0
+11 SET ABMU(4)="?62"_U_$JUSTIFY(ABMZ("UNIT"),3)
+12 SET ABMU(5)="?70"_U_$JUSTIFY($FNUMBER((ABMZ("UNIT")*$PIECE(ABM("X0"),U,3))+$PIECE(ABM("X0"),U,6),",",2),9)
+13 SET ABMZ("TOTL")=($PIECE(ABM("X0"),U,3)*ABMZ("UNIT"))+$PIECE(ABM("X0"),U,6)+ABMZ("TOTL")
+14 SET ABMU("TXT")=$PIECE(^AUTTREVN(ABM("X"),0),U,2)
+15 SET ABMU("RM")=37
SET ABMU("LM")=10
DO ^ABMDWRAP
+16 QUIT
+17 ;
XIT KILL ABM
+1 QUIT
A ;ADD ENTRY
+1 SET DIC("P")=$PIECE(^DD(9002274.3,25,0),U,2)
+2 SET DIC="^AUTTREVN("
SET DIC(0)="AEMQ"
+3 KILL DIC("A")
+4 DO ^DIC
+5 IF +Y<0
QUIT
SET ABMZ("RVCODE")=+Y
+6 SET DA(1)=ABMP("CDFN")
+7 SET DIC="^ABMDCLM(DUZ(2),DA(1),25,"
SET X=ABMZ("RVCODE")
+8 KILL DD,DO
DO FILE^DICN
+9 IF +Y<0
QUIT
SET DA=+Y
+10 SET ABMZ("NUM")=+$GET(ABMZ("NUM"))+1
+11 DO DEL100
E ;EDIT EXISTING ENTRY
+1 IF '$GET(ABMZ("NUM"))
GOTO A
+2 IF '$GET(ABMZ("RVCODE"))
Begin DoDot:1
+3 KILL DA
+4 SET DA(1)=ABMP("CDFN")
+5 IF ABMZ("NUM")=1
SET Y=1
+6 IF '$TEST
SET DIR(0)="NO^1:"_ABMZ("NUM")
DO ^DIR
KILL DIR
IF 'Y
QUIT
+7 SET DA=$PIECE(ABMZ(Y),"^",2)
+8 SET ABMZ("RVCODE")=$PIECE(^ABMDCLM(DUZ(2),DA(1),25,DA,0),U)
End DoDot:1
+9 IF '$GET(DA)
QUIT
+10 ;S ABMZ("UC")=$P($G(^ABMDFEE(ABMP("FEE"),31,ABMZ("RVCODE"),0)),"^",2) ;abm*2.6*2 3PMS10003A
+11 ;abm*2.6*2 3PMS10003A
SET ABMZ("UC")=$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),31,ABMZ("RVCODE"),ABMP("VDT")),U)
+12 SET DIE="^ABMDCLM(DUZ(2),DA(1),25,"
+13 SET DR=".02;.03//"_ABMZ("UC")_";.07"
+14 ;start new code abm*2.6*9 NARR
+15 DO ^DIE
+16 SET DR=""
+17 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7)'=""
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7)))
Begin DoDot:1
+18 ;only 5010 formats
IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"
QUIT
+19 SET ABMCNCK=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7),0))
+20 IF ABMCNCK
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMCNCK,0)),U,2)="Y"
SET DR="22"
End DoDot:1
+21 ;end new code abm*2.6*9 NARR
+22 ;S:'$P(^AUTTREVN(ABMZ("RVCODE"),0),"^",5) DR=DR_";.04" ;abm*2.6*6 NOHEAT
+23 ;abm*2.6*6 NOHEAT
SET DR=DR_";.04"
+24 DO ^DIE
+25 ;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7)'="",($P($G(^DIC(81.1,$P($G(^ICPT($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7),0)),U,3),0)),U)["IMMUNIZATION") S DR="15//" D ^DIE ;abm*2.6*6 5010 ;abm*2.6*8 HEAT41190
+26 ;abm*2.6*8 HEAT41190
SET ABMTCPT=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7)
+27 ;abm*2.6*8 HEAT41190
IF ABMTCPT'=""
IF $PIECE($GET(^ICPT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7),0)),U,3)
IF ($PIECE($GET(^DIC(81.1,$PIECE($GET(^ICPT(ABMTCPT,0)),U,3),0)),U)["IMMUNIZATION")
SET DR="15//"
DO ^DIE
+28 QUIT
DEL100 ;if 100 ask to delete
+1 IF ABMZ("RVCODE")'=100
QUIT
+2 WRITE !!,"You have entered an all inclusive revenue code. Do you want to"
+3 WRITE !,$$EN^ABMVDF("RVN"),"DELETE ALL",$$EN^ABMVDF("RVF")," line items from the other pages?",!
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+5 IF Y'=1
QUIT
+6 WRITE !
+7 NEW I
FOR I=21,23,27,33,35,37,39,43,45
Begin DoDot:1
+8 IF '$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,0))
QUIT
+9 WRITE !,$PIECE(^DD(9002274.3,I,0),U)," deleted."
+10 KILL ^ABMDCLM(DUZ(2),ABMP("CDFN"),I)
End DoDot:1
+11 WRITE !
+12 QUIT
