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

ABME650.m

Go to the documentation of this file. 
  1. ABME650 ; 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. 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,20,30,35,40:10:90,110,120,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 ;1-2 Record type
  1.  S ABMR(50,10)=50
  1.  Q
  1. 20 ;3-5 Sequence 
  1.  S ABMR(50,20)=ABME("S#")
  1.  S ABMR(50,20)=$$FMT^ABMERUTL(ABMR(50,20),"3NR")
  1.  Q
  1. 30 ;6-25 Patient Control Number
  1.  S ABMR(50,30)=$$EX^ABMER20(30,ABMP("BDFN"))
  1.  S ABMR(50,30)=$$FMT^ABMERUTL(ABMR(50,30),20)
  1.  Q
  1. 35 ;26-28, Filler (National Use)
  1.  S ABMR(50,35)=""
  1.  S ABMR(50,35)=$$FMT^ABMERUTL(ABMR(50,35),3)
  1.  Q
  1. 40 ;29-32 Accommodations Revenue Code 1
  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 ;33-41 Accommodations Rate 1
  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 ;42-45 Accommodation Days 1
  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 ;46-55 Accommodation Total Charges 1
  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 ;56-65 Accommodations Non-Covered Charges 1
  1.  D GET25
  1.  S ABMR(50,80)=$$FMT^ABMERUTL(ABMR(50,80),"10NRJ2")
  1.  Q
  1. 90 ;66-69 Form Locator 49 1
  1.  S ABMR(50,90)=""
  1.  S ABMR(50,90)=$$FMT^ABMERUTL(ABMR(50,90),4)
  1.  Q
  1. 110 ;70-110 Accommodations Revenue Code 2
  1.  D GET25
  1.  S ABM("RC#")=2
  1.  N I F I=1101:1:1106 D @I S ABMR(50,110)=$G(ABMR(50,110))_ABMR(50,I)
  1.  Q
  1. 120 ;111-151 Accommodations Revenue Code 3
  1.  D GET25
  1.  S ABM("RC#")=3
  1.  N I F I=1201:1:1206 D @(I-100) S ABMR(50,120)=$G(ABMR(50,120))_ABMR(50,I)
  1.  Q
  1. 130 ;152-192 Accommodations Revenue Code 4
  1.  D GET25
  1.  S ABM("RC#")=4
  1.  N I F I=1301:1:1306 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. 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.  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