ABME650 ; IHS/ASDST/DMJ - UB92 EMC RECORD 50 (INPATIENT ACCOMMODATIONS) ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;07/19/96 5:20 PM
START ;START HERE
K ABMR(50),ABMREC(50)
S ABME("RTYPE")=50
D SET^ABMERUTL
S ABME("S#")=1 D LOOP
D S90^ABMERUTL
K ABM
Q
LOOP ;LOOP HERE
F I=10,20,30,35,40:10:90,110,120,130 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),50,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(50,ABME("S#"))=$G(ABMREC(50,ABME("S#")))_ABMR(50,I)
Q
10 ;1-2 Record type
S ABMR(50,10)=50
Q
20 ;3-5 Sequence
S ABMR(50,20)=ABME("S#")
S ABMR(50,20)=$$FMT^ABMERUTL(ABMR(50,20),"3NR")
Q
30 ;6-25 Patient Control Number
S ABMR(50,30)=$$EX^ABMER20(30,ABMP("BDFN"))
S ABMR(50,30)=$$FMT^ABMERUTL(ABMR(50,30),20)
Q
35 ;26-28, Filler (National Use)
S ABMR(50,35)=""
S ABMR(50,35)=$$FMT^ABMERUTL(ABMR(50,35),3)
Q
40 ;29-32 Accommodations Revenue Code 1
D GET25 S ABMR(50,40)=$P(ABM(25,1),U)
S ABMR(50,40)=$$FMT^ABMERUTL(ABMR(50,40),"4NR")
Q
50 ;33-41 Accommodations Rate 1
D GET25 S ABMR(50,50)=$P(ABM(25,1),"^",3)
S ABMR(50,50)=$$FMT^ABMERUTL(ABMR(50,50),"9RNJ2")
Q
60 ;42-45 Accommodation Days 1
D GET25 S ABMR(50,60)=$P(ABM(25,1),"^",2)
S ABMR(50,60)=$$FMT^ABMERUTL(ABMR(50,60),"4NR")
Q
70 ;46-55 Accommodation Total Charges 1
D GET25 S ABMR(50,70)=$P(ABM(25,1),"^",4)
S ABMR(50,70)=$$FMT^ABMERUTL(ABMR(50,70),"10NRJ2")
Q
80 ;56-65 Accommodations Non-Covered Charges 1
D GET25
S ABMR(50,80)=$$FMT^ABMERUTL(ABMR(50,80),"10NRJ2")
Q
90 ;66-69 Form Locator 49 1
S ABMR(50,90)=""
S ABMR(50,90)=$$FMT^ABMERUTL(ABMR(50,90),4)
Q
110 ;70-110 Accommodations Revenue Code 2
D GET25
S ABM("RC#")=2
N I F I=1101:1:1106 D @I S ABMR(50,110)=$G(ABMR(50,110))_ABMR(50,I)
Q
120 ;111-151 Accommodations Revenue Code 3
D GET25
S ABM("RC#")=3
N I F I=1201:1:1206 D @(I-100) S ABMR(50,120)=$G(ABMR(50,120))_ABMR(50,I)
Q
130 ;152-192 Accommodations Revenue Code 4
D GET25
S ABM("RC#")=4
N I F I=1301:1:1306 D @(I-200) S ABMR(50,130)=$G(ABMR(50,130))_ABMR(50,I)
Q
1101 ;Revenue Code
S ABMR(50,I)=$P(ABM(25,ABM("RC#")),U)
S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"4NR")
Q
1102 ;Rate
S ABMR(50,I)=$P(ABM(25,ABM("RC#")),"^",3)
S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"9RNJ2")
Q
1103 ;Days
S ABMR(50,I)=$P(ABM(25,ABM("RC#")),"^",2)
S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"4NR")
Q
1104 ;Total Charges
S ABMR(50,I)=$P(ABM(25,ABM("RC#")),"^",4)
S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"10NRJ2")
Q
1105 ;Non-Covered Charges
S ABMR(50,I)=""
I $P(ABM(25,ABM("RC#")),U)="001" S ABMR(50,I)=ABMR(50,80)
S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"10NR")
Q
1106 ;Form Locator 49
S ABMR(50,I)=""
S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),4)
Q
GET25 ;GET INFO FOR ROOM AND BOARD CHARGES
Q:$D(ABM(25))
N I K ABMP("FLAT") D FRATE^ABMDF11
S ABM("T2")=0,ABM("T4")=0
I '$D(ABMP("FLAT")) D
.N I S I=0,CNT=0 F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,I)) Q:'I!(CNT>2) D
..S CNT=CNT+1
..S ABM(25,CNT)=^ABMDBILL(DUZ(2),ABMP("BDFN"),25,I,0)
..S $P(ABM(25,CNT),"^",4)=$P(ABM(25,CNT),"^",3)*$P(ABM(25,CNT),"^",2)
..S ABM("T2")=ABM("T2")+$P(ABM(25,CNT),"^",2),ABM("T4")=ABM("T4")+$P(ABM(25,CNT),"^",4)
I $D(ABMP("FLAT")) D
.Q:$P(ABMP("FLAT"),"^",2)>219
.S CNT=1
.S ABM(25,1)=$P(ABMP("FLAT"),"^",2)_"^"_$P(ABMP("FLAT"),"^",3)_"^"_$P(ABMP("FLAT"),U)_"^"_($P(ABMP("FLAT"),U)*$P(ABMP("FLAT"),"^",3))
.S ABM("T2")=ABM("T2")+$P(ABM(25,1),"^",2),ABM("T4")=ABM("T4")+$P(ABM(25,1),"^",4)
S ABMRT(90,130)=+$G(ABMRT(90,130))+ABM("T4")
S ABMRT(95,80)=+$G(ABMRT(95,80))+ABM("T4")
S ABMRT(99,60)=+$G(ABMRT(99,60))+ABM("T4")
S ABMR(50,80)="",ABM("NCDAYS")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),"^",6) I ABM("NCDAYS") D
.S ABMR(50,80)=ABM("NCDAYS")*$P(ABM(25,1),"^",3)
.S ABMRT(90,140)=ABMR(50,80)
.S ABMRT(95,90)=+$G(ABMRT(95,90))+ABMR(50,80)
.S ABMRT(99,70)=+$G(ABMRT(99,70))+ABMR(50,80)
S CNT=CNT+1,ABM(25,CNT)="001^"_ABM("T2")_"^^"_ABM("T4")
F I=1:1:4 S:'$D(ABM(25,I)) ABM(25,I)=""
Q
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
;X=data element, Y=bill internal entry number
S ABMP("BDFN")=ABMY D SET^ABMERUTL
I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
D @ABMX
S Y=ABMR(50,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(50,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
Q Y
ABME650 ; IHS/ASDST/DMJ - UB92 EMC RECORD 50 (INPATIENT ACCOMMODATIONS) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;07/19/96 5:20 PM
START ;START HERE
+1 KILL ABMR(50),ABMREC(50)
+2 SET ABME("RTYPE")=50
+3 DO SET^ABMERUTL
+4 SET ABME("S#")=1
DO LOOP
+5 DO S90^ABMERUTL
+6 KILL ABM
+7 QUIT
LOOP ;LOOP HERE
+1 FOR I=10,20,30,35,40:10:90,110,120,130
Begin DoDot:1
+2 DO @I
+3 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),50,I))
DO @(^(I))
+4 IF '$GET(ABMP("NOFMT"))
SET ABMREC(50,ABME("S#"))=$GET(ABMREC(50,ABME("S#")))_ABMR(50,I)
End DoDot:1
+5 QUIT
10 ;1-2 Record type
+1 SET ABMR(50,10)=50
+2 QUIT
20 ;3-5 Sequence
+1 SET ABMR(50,20)=ABME("S#")
+2 SET ABMR(50,20)=$$FMT^ABMERUTL(ABMR(50,20),"3NR")
+3 QUIT
30 ;6-25 Patient Control Number
+1 SET ABMR(50,30)=$$EX^ABMER20(30,ABMP("BDFN"))
+2 SET ABMR(50,30)=$$FMT^ABMERUTL(ABMR(50,30),20)
+3 QUIT
35 ;26-28, Filler (National Use)
+1 SET ABMR(50,35)=""
+2 SET ABMR(50,35)=$$FMT^ABMERUTL(ABMR(50,35),3)
+3 QUIT
40 ;29-32 Accommodations Revenue Code 1
+1 DO GET25
SET ABMR(50,40)=$PIECE(ABM(25,1),U)
+2 SET ABMR(50,40)=$$FMT^ABMERUTL(ABMR(50,40),"4NR")
+3 QUIT
50 ;33-41 Accommodations Rate 1
+1 DO GET25
SET ABMR(50,50)=$PIECE(ABM(25,1),"^",3)
+2 SET ABMR(50,50)=$$FMT^ABMERUTL(ABMR(50,50),"9RNJ2")
+3 QUIT
60 ;42-45 Accommodation Days 1
+1 DO GET25
SET ABMR(50,60)=$PIECE(ABM(25,1),"^",2)
+2 SET ABMR(50,60)=$$FMT^ABMERUTL(ABMR(50,60),"4NR")
+3 QUIT
70 ;46-55 Accommodation Total Charges 1
+1 DO GET25
SET ABMR(50,70)=$PIECE(ABM(25,1),"^",4)
+2 SET ABMR(50,70)=$$FMT^ABMERUTL(ABMR(50,70),"10NRJ2")
+3 QUIT
80 ;56-65 Accommodations Non-Covered Charges 1
+1 DO GET25
+2 SET ABMR(50,80)=$$FMT^ABMERUTL(ABMR(50,80),"10NRJ2")
+3 QUIT
90 ;66-69 Form Locator 49 1
+1 SET ABMR(50,90)=""
+2 SET ABMR(50,90)=$$FMT^ABMERUTL(ABMR(50,90),4)
+3 QUIT
110 ;70-110 Accommodations Revenue Code 2
+1 DO GET25
+2 SET ABM("RC#")=2
+3 NEW I
FOR I=1101:1:1106
DO @I
SET ABMR(50,110)=$GET(ABMR(50,110))_ABMR(50,I)
+4 QUIT
120 ;111-151 Accommodations Revenue Code 3
+1 DO GET25
+2 SET ABM("RC#")=3
+3 NEW I
FOR I=1201:1:1206
DO @(I-100)
SET ABMR(50,120)=$GET(ABMR(50,120))_ABMR(50,I)
+4 QUIT
130 ;152-192 Accommodations Revenue Code 4
+1 DO GET25
+2 SET ABM("RC#")=4
+3 NEW I
FOR I=1301:1:1306
DO @(I-200)
SET ABMR(50,130)=$GET(ABMR(50,130))_ABMR(50,I)
+4 QUIT
1101 ;Revenue Code
+1 SET ABMR(50,I)=$PIECE(ABM(25,ABM("RC#")),U)
+2 SET ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"4NR")
+3 QUIT
1102 ;Rate
+1 SET ABMR(50,I)=$PIECE(ABM(25,ABM("RC#")),"^",3)
+2 SET ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"9RNJ2")
+3 QUIT
1103 ;Days
+1 SET ABMR(50,I)=$PIECE(ABM(25,ABM("RC#")),"^",2)
+2 SET ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"4NR")
+3 QUIT
1104 ;Total Charges
+1 SET ABMR(50,I)=$PIECE(ABM(25,ABM("RC#")),"^",4)
+2 SET ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"10NRJ2")
+3 QUIT
1105 ;Non-Covered Charges
+1 SET ABMR(50,I)=""
+2 IF $PIECE(ABM(25,ABM("RC#")),U)="001"
SET ABMR(50,I)=ABMR(50,80)
+3 SET ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"10NR")
+4 QUIT
1106 ;Form Locator 49
+1 SET ABMR(50,I)=""
+2 SET ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),4)
+3 QUIT
GET25 ;GET INFO FOR ROOM AND BOARD CHARGES
+1 IF $DATA(ABM(25))
QUIT
+2 NEW I
KILL ABMP("FLAT")
DO FRATE^ABMDF11
+3 SET ABM("T2")=0
SET ABM("T4")=0
+4 IF '$DATA(ABMP("FLAT"))
Begin DoDot:1
+5 NEW I
SET I=0
SET CNT=0
FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,I))
IF 'I!(CNT>2)
QUIT
Begin DoDot:2
+6 SET CNT=CNT+1
+7 SET ABM(25,CNT)=^ABMDBILL(DUZ(2),ABMP("BDFN"),25,I,0)
+8 SET $PIECE(ABM(25,CNT),"^",4)=$PIECE(ABM(25,CNT),"^",3)*$PIECE(ABM(25,CNT),"^",2)
+9 SET ABM("T2")=ABM("T2")+$PIECE(ABM(25,CNT),"^",2)
SET ABM("T4")=ABM("T4")+$PIECE(ABM(25,CNT),"^",4)
End DoDot:2
End DoDot:1
+10 IF $DATA(ABMP("FLAT"))
Begin DoDot:1
+11 IF $PIECE(ABMP("FLAT"),"^",2)>219
QUIT
+12 SET CNT=1
+13 SET ABM(25,1)=$PIECE(ABMP("FLAT"),"^",2)_"^"_$PIECE(ABMP("FLAT"),"^",3)_"^"_$PIECE(ABMP("FLAT"),U)_"^"_($PIECE(ABMP("FLAT"),U)*$PIECE(ABMP("FLAT"),"^",3))
+14 SET ABM("T2")=ABM("T2")+$PIECE(ABM(25,1),"^",2)
SET ABM("T4")=ABM("T4")+$PIECE(ABM(25,1),"^",4)
End DoDot:1
+15 SET ABMRT(90,130)=+$GET(ABMRT(90,130))+ABM("T4")
+16 SET ABMRT(95,80)=+$GET(ABMRT(95,80))+ABM("T4")
+17 SET ABMRT(99,60)=+$GET(ABMRT(99,60))+ABM("T4")
+18 SET ABMR(50,80)=""
SET ABM("NCDAYS")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),"^",6)
IF ABM("NCDAYS")
Begin DoDot:1
+19 SET ABMR(50,80)=ABM("NCDAYS")*$PIECE(ABM(25,1),"^",3)
+20 SET ABMRT(90,140)=ABMR(50,80)
+21 SET ABMRT(95,90)=+$GET(ABMRT(95,90))+ABMR(50,80)
+22 SET ABMRT(99,70)=+$GET(ABMRT(99,70))+ABMR(50,80)
End DoDot:1
+23 SET CNT=CNT+1
SET ABM(25,CNT)="001^"_ABM("T2")_"^^"_ABM("T4")
+24 FOR I=1:1:4
IF '$DATA(ABM(25,I))
SET ABM(25,I)=""
+25 QUIT
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
+1 ;X=data element, Y=bill internal entry number
+2 SET ABMP("BDFN")=ABMY
DO SET^ABMERUTL
+3 IF '$GET(ABMP("NOFMT"))
SET ABMP("FMT")=0
+4 DO @ABMX
+5 SET Y=ABMR(50,ABMX)
+6 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+7 KILL ABMR(50,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
+8 QUIT Y
