ABMER50 ; 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
;
; IHS/ASDS/LSL - 12/04/01 - V2.4 Patch 10 - NOIS QBA-1201-130011
; 001 total line needs to be excluded from NM Medicaid UB-92-E V5
; that are sent through ACE$
;
; *********************************************************************
;
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:10: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 ;Record type
S ABMR(50,10)=50
Q
20 ;Sequence
S ABMR(50,20)=ABME("S#")
S ABMR(50,20)=$$FMT^ABMERUTL(ABMR(50,20),"2NR")
Q
30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
S ABMR(50,30)=$$EX^ABMER20(30,ABMP("BDFN"))
S ABMR(50,30)=$$FMT^ABMERUTL(ABMR(50,30),20)
Q
40 ;Accommodations Revenue Code 1 (SOURCE: FILE=9002274.4025 FIELD=.01)
D GET25 S ABMR(50,40)=$P(ABM(25,1),U)
S ABMR(50,40)=$$FMT^ABMERUTL(ABMR(50,40),"4NR")
Q
50 ;Accommodations Rate 1 (SOURCE: FILE=9002274.0131, FIELD=.02)
D GET25 S ABMR(50,50)=$P(ABM(25,1),"^",3)
S ABMR(50,50)=$$FMT^ABMERUTL(ABMR(50,50),"9RNJ2")
Q
60 ;Accommodation Days 1 (SOURCE: FILE=9002274.4025, FIELD=.02)
D GET25 S ABMR(50,60)=$P(ABM(25,1),"^",2)
S ABMR(50,60)=$$FMT^ABMERUTL(ABMR(50,60),"4NR")
Q
70 ;Accommodation Total Charges 1 (SOURCE: FILE=9002274.4025, FIELD=.03)
D GET25 S ABMR(50,70)=$P(ABM(25,1),"^",4)
S ABMR(50,70)=$$FMT^ABMERUTL(ABMR(50,70),"10NRJ2")
Q
80 ;Accommodations Non-Covered Charges 1 (SOURCE: FILE= FIELD=)
D GET25
S ABMR(50,80)=$$FMT^ABMERUTL(ABMR(50,80),"10NRJ2")
Q
90 ;Form Locator 49 1 (SOURCE: FILE= FIELD=)
S ABMR(50,90)=""
S ABMR(50,90)=$$FMT^ABMERUTL(ABMR(50,90),4)
Q
100 ;Filler (National Use)
S ABMR(50,100)=""
S ABMR(50,100)=$$FMT^ABMERUTL(ABMR(50,100),1)
Q
110 ;Accommodations Revenue Code 2 (SOURCE: FILE=9002274.4025)
D GET25
S ABM("RC#")=2
N I F I=1101:1:1107 D @I S ABMR(50,110)=$G(ABMR(50,110))_ABMR(50,I)
Q
120 ;Accommodations Revenue Code 3 (SOURCE: FILE=9002274.25)
D GET25
S ABM("RC#")=3
N I F I=1201:1:1207 D @(I-100) S ABMR(50,120)=$G(ABMR(50,120))_ABMR(50,I)
Q
130 ;Accommodations Revenue Code 4 (SOURCE: FILE=9002274.4025)
D GET25
S ABM("RC#")=4
N I F I=1301:1:1307 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
1107 ;Filler
S ABMR(50,I)=""
S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),1)
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)
I $$RCID^ABMERUTL(ABMP("INS"))'["MAD" D
. 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
ABMER50 ; 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
+3 ;
+4 ; IHS/ASDS/LSL - 12/04/01 - V2.4 Patch 10 - NOIS QBA-1201-130011
+5 ; 001 total line needs to be excluded from NM Medicaid UB-92-E V5
+6 ; that are sent through ACE$
+7 ;
+8 ; *********************************************************************
+9 ;
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:10: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 ;Record type
+1 SET ABMR(50,10)=50
+2 QUIT
20 ;Sequence
+1 SET ABMR(50,20)=ABME("S#")
+2 SET ABMR(50,20)=$$FMT^ABMERUTL(ABMR(50,20),"2NR")
+3 QUIT
30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
+1 SET ABMR(50,30)=$$EX^ABMER20(30,ABMP("BDFN"))
+2 SET ABMR(50,30)=$$FMT^ABMERUTL(ABMR(50,30),20)
+3 QUIT
40 ;Accommodations Revenue Code 1 (SOURCE: FILE=9002274.4025 FIELD=.01)
+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 ;Accommodations Rate 1 (SOURCE: FILE=9002274.0131, FIELD=.02)
+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 ;Accommodation Days 1 (SOURCE: FILE=9002274.4025, FIELD=.02)
+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 ;Accommodation Total Charges 1 (SOURCE: FILE=9002274.4025, FIELD=.03)
+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 ;Accommodations Non-Covered Charges 1 (SOURCE: FILE= FIELD=)
+1 DO GET25
+2 SET ABMR(50,80)=$$FMT^ABMERUTL(ABMR(50,80),"10NRJ2")
+3 QUIT
90 ;Form Locator 49 1 (SOURCE: FILE= FIELD=)
+1 SET ABMR(50,90)=""
+2 SET ABMR(50,90)=$$FMT^ABMERUTL(ABMR(50,90),4)
+3 QUIT
100 ;Filler (National Use)
+1 SET ABMR(50,100)=""
+2 SET ABMR(50,100)=$$FMT^ABMERUTL(ABMR(50,100),1)
+3 QUIT
110 ;Accommodations Revenue Code 2 (SOURCE: FILE=9002274.4025)
+1 DO GET25
+2 SET ABM("RC#")=2
+3 NEW I
FOR I=1101:1:1107
DO @I
SET ABMR(50,110)=$GET(ABMR(50,110))_ABMR(50,I)
+4 QUIT
120 ;Accommodations Revenue Code 3 (SOURCE: FILE=9002274.25)
+1 DO GET25
+2 SET ABM("RC#")=3
+3 NEW I
FOR I=1201:1:1207
DO @(I-100)
SET ABMR(50,120)=$GET(ABMR(50,120))_ABMR(50,I)
+4 QUIT
130 ;Accommodations Revenue Code 4 (SOURCE: FILE=9002274.4025)
+1 DO GET25
+2 SET ABM("RC#")=4
+3 NEW I
FOR I=1301:1:1307
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
1107 ;Filler
+1 SET ABMR(50,I)=""
+2 SET ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),1)
+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 IF $$RCID^ABMERUTL(ABMP("INS"))'["MAD"
Begin DoDot:1
+24 SET CNT=CNT+1
SET ABM(25,CNT)="001^"_ABM("T2")_"^^"_ABM("T4")
End DoDot:1
+25 FOR I=1:1:4
IF '$DATA(ABM(25,I))
SET ABM(25,I)=""
+26 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
