Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMER50

ABMER50.m

Go to the documentation of this file. 
  1. ABMER50 ; IHS/ASDST/DMJ - UB92 EMC RECORD 50 (INPATIENT ACCOMMODATIONS) ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;DMJ;07/19/96 5:20 PM
  1.  ;
  1.  ; IHS/ASDS/LSL - 12/04/01 - V2.4 Patch 10 - NOIS QBA-1201-130011
  1.  ;     001 total line needs to be excluded from NM Medicaid UB-92-E V5
  1.  ;     that are sent through ACE$
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. START ;START HERE
  1.  K ABMR(50),ABMREC(50)
  1.  S ABME("RTYPE")=50
  1.  D SET^ABMERUTL
  1.  S ABME("S#")=1 D LOOP
  1.  D S90^ABMERUTL
  1.  K ABM
  1.  Q
  1. LOOP ;LOOP HERE
  1.  F I=10:10:130 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),50,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(50,ABME("S#"))=$G(ABMREC(50,ABME("S#")))_ABMR(50,I)
  1.  Q
  1. 10 ;Record type
  1.  S ABMR(50,10)=50
  1.  Q
  1. 20 ;Sequence 
  1.  S ABMR(50,20)=ABME("S#")
  1.  S ABMR(50,20)=$$FMT^ABMERUTL(ABMR(50,20),"2NR")
  1.  Q
  1. 30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
  1.  S ABMR(50,30)=$$EX^ABMER20(30,ABMP("BDFN"))
  1.  S ABMR(50,30)=$$FMT^ABMERUTL(ABMR(50,30),20)
  1.  Q
  1. 40 ;Accommodations Revenue Code 1 (SOURCE: FILE=9002274.4025 FIELD=.01)
  1.  D GET25 S ABMR(50,40)=$P(ABM(25,1),U)
  1.  S ABMR(50,40)=$$FMT^ABMERUTL(ABMR(50,40),"4NR")
  1.  Q
  1. 50 ;Accommodations Rate 1 (SOURCE: FILE=9002274.0131, FIELD=.02)
  1.  D GET25 S ABMR(50,50)=$P(ABM(25,1),"^",3)
  1.  S ABMR(50,50)=$$FMT^ABMERUTL(ABMR(50,50),"9RNJ2")
  1.  Q
  1. 60 ;Accommodation Days 1 (SOURCE: FILE=9002274.4025, FIELD=.02)
  1.  D GET25 S ABMR(50,60)=$P(ABM(25,1),"^",2)
  1.  S ABMR(50,60)=$$FMT^ABMERUTL(ABMR(50,60),"4NR")
  1.  Q
  1. 70 ;Accommodation Total Charges 1 (SOURCE: FILE=9002274.4025, FIELD=.03)
  1.  D GET25 S ABMR(50,70)=$P(ABM(25,1),"^",4)
  1.  S ABMR(50,70)=$$FMT^ABMERUTL(ABMR(50,70),"10NRJ2")
  1.  Q
  1. 80 ;Accommodations Non-Covered Charges 1 (SOURCE: FILE= FIELD=)
  1.  D GET25
  1.  S ABMR(50,80)=$$FMT^ABMERUTL(ABMR(50,80),"10NRJ2")
  1.  Q
  1. 90 ;Form Locator 49 1 (SOURCE: FILE= FIELD=)
  1.  S ABMR(50,90)=""
  1.  S ABMR(50,90)=$$FMT^ABMERUTL(ABMR(50,90),4)
  1.  Q
  1. 100 ;Filler (National Use)
  1.  S ABMR(50,100)=""
  1.  S ABMR(50,100)=$$FMT^ABMERUTL(ABMR(50,100),1)
  1.  Q
  1. 110 ;Accommodations Revenue Code 2 (SOURCE: FILE=9002274.4025)
  1.  D GET25
  1.  S ABM("RC#")=2
  1.  N I F I=1101:1:1107 D @I S ABMR(50,110)=$G(ABMR(50,110))_ABMR(50,I)
  1.  Q
  1. 120 ;Accommodations Revenue Code 3 (SOURCE: FILE=9002274.25)     
  1.  D GET25
  1.  S ABM("RC#")=3
  1.  N I F I=1201:1:1207 D @(I-100) S ABMR(50,120)=$G(ABMR(50,120))_ABMR(50,I)
  1.  Q
  1. 130 ;Accommodations Revenue Code 4 (SOURCE: FILE=9002274.4025)
  1.  D GET25
  1.  S ABM("RC#")=4
  1.  N I F I=1301:1:1307 D @(I-200) S ABMR(50,130)=$G(ABMR(50,130))_ABMR(50,I)
  1.  Q
  1. 1101 ;Revenue Code    
  1.  S ABMR(50,I)=$P(ABM(25,ABM("RC#")),U)
  1.  S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"4NR")
  1.  Q
  1. 1102 ;Rate
  1.  S ABMR(50,I)=$P(ABM(25,ABM("RC#")),"^",3)
  1.  S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"9RNJ2")
  1.  Q
  1. 1103 ;Days
  1.  S ABMR(50,I)=$P(ABM(25,ABM("RC#")),"^",2)
  1.  S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"4NR")
  1.  Q
  1. 1104 ;Total Charges
  1.  S ABMR(50,I)=$P(ABM(25,ABM("RC#")),"^",4)
  1.  S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"10NRJ2")
  1.  Q
  1. 1105 ;Non-Covered Charges
  1.  S ABMR(50,I)=""
  1.  I $P(ABM(25,ABM("RC#")),U)="001" S ABMR(50,I)=ABMR(50,80)
  1.  S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),"10NR")
  1.  Q
  1. 1106 ;Form Locator 49
  1.  S ABMR(50,I)=""
  1.  S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),4)
  1.  Q
  1. 1107 ;Filler
  1.  S ABMR(50,I)=""
  1.  S ABMR(50,I)=$$FMT^ABMERUTL(ABMR(50,I),1)
  1.  Q
  1. GET25 ;GET INFO FOR ROOM AND BOARD CHARGES   
  1.  Q:$D(ABM(25))
  1.  N I K ABMP("FLAT") D FRATE^ABMDF11
  1.  S ABM("T2")=0,ABM("T4")=0
  1.  I '$D(ABMP("FLAT")) D
  1.  .N I S I=0,CNT=0 F  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,I)) Q:'I!(CNT>2)  D
  1.  ..S CNT=CNT+1
  1.  ..S ABM(25,CNT)=^ABMDBILL(DUZ(2),ABMP("BDFN"),25,I,0)
  1.  ..S $P(ABM(25,CNT),"^",4)=$P(ABM(25,CNT),"^",3)*$P(ABM(25,CNT),"^",2)
  1.  ..S ABM("T2")=ABM("T2")+$P(ABM(25,CNT),"^",2),ABM("T4")=ABM("T4")+$P(ABM(25,CNT),"^",4)
  1.  I $D(ABMP("FLAT")) D
  1.  .Q:$P(ABMP("FLAT"),"^",2)>219
  1.  .S CNT=1
  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))
  1.  .S ABM("T2")=ABM("T2")+$P(ABM(25,1),"^",2),ABM("T4")=ABM("T4")+$P(ABM(25,1),"^",4)
  1.  S ABMRT(90,130)=+$G(ABMRT(90,130))+ABM("T4")
  1.  S ABMRT(95,80)=+$G(ABMRT(95,80))+ABM("T4")
  1.  S ABMRT(99,60)=+$G(ABMRT(99,60))+ABM("T4")
  1.  S ABMR(50,80)="",ABM("NCDAYS")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),"^",6) I ABM("NCDAYS") D
  1.  .S ABMR(50,80)=ABM("NCDAYS")*$P(ABM(25,1),"^",3)
  1.  .S ABMRT(90,140)=ABMR(50,80)
  1.  .S ABMRT(95,90)=+$G(ABMRT(95,90))+ABMR(50,80)
  1.  .S ABMRT(99,70)=+$G(ABMRT(99,70))+ABMR(50,80)
  1.  I $$RCID^ABMERUTL(ABMP("INS"))'["MAD" D
  1.  . S CNT=CNT+1,ABM(25,CNT)="001^"_ABM("T2")_"^^"_ABM("T4")
  1.  F I=1:1:4 S:'$D(ABM(25,I)) ABM(25,I)=""
  1.  Q
  1. EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
  1.  ;X=data element, Y=bill internal entry number
  1.  S ABMP("BDFN")=ABMY D SET^ABMERUTL
  1.  I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
  1.  D @ABMX
  1.  S Y=ABMR(50,ABMX)
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  K ABMR(50,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
  1.  Q Y