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

ABMER41.m

Go to the documentation of this file.
  1. ABMER41 ; IHS/ASDST/DMJ - UB92 EMC RECORD 41 (Claim Data Condition-Value) ;
  1. ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1. ;Original;DMJ;08/18/95 10:39 AM
  1. ;
  1. START ;START HERE
  1. K ABMR(41),ABMREC(41)
  1. S ABM("9SP")=" "
  1. S ABME("RTYPE")=41
  1. D SET^ABMERUTL
  1. S ABME("S#")=1
  1. D LOOP
  1. D S90^ABMERUTL
  1. K ABM
  1. Q
  1. ;
  1. LOOP ;LOOP HERE
  1. D ^ABMER41A
  1. F I=210:10:400 D
  1. .D @I
  1. .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),41,I)) D @(^(I))
  1. .I '$G(ABMP("NOFMT")) S ABMREC(41,ABME("S#"))=$G(ABMREC(41,ABME("S#")))_ABMR(41,I)
  1. Q
  1. ;
  1. 210 ;Value Amount - 3 (SOURCE: FILE=9002274.4055, FIELD=.02)
  1. ; form locator #41a
  1. D GET55
  1. S ABMR(41,210)=$P(ABM(55,3),"^",2)
  1. I $TR($G(ABMR(41,200))," ")="" S ABMR(41,210)=ABM("9SP") Q
  1. S ABMR(41,210)=$$FMT^ABMERUTL(ABMR(41,210),"9RNJ2")
  1. Q
  1. ;
  1. 220 ;Value Code - 4 (SOURCE: FILE=9002274.4055, FIELD=.01)
  1. ; form locator #39b
  1. D GET55
  1. S ABMR(41,220)=$P(ABM(55,4),U)
  1. S ABMR(41,220)=$$FMT^ABMERUTL(ABMR(41,220),"2RN")
  1. Q
  1. ;
  1. 230 ;Value Amount - 4 (SOURCE: FILE=9002274.4055, FIELD=.02)
  1. ; form locator #39b
  1. D GET55
  1. S ABMR(41,230)=$P(ABM(55,4),"^",2)
  1. I $TR($G(ABMR(41,220))," ")="" S ABMR(41,230)=ABM("9SP") Q
  1. S ABMR(41,230)=$$FMT^ABMERUTL(ABMR(41,230),"9RNJ2")
  1. Q
  1. ;
  1. 240 ;Value Code - 5 (SOURCE: FILE=9002274.4055, FIELD=.01)
  1. ; form locator #40b
  1. D GET55
  1. S ABMR(41,240)=$P(ABM(55,5),U)
  1. S ABMR(41,240)=$$FMT^ABMERUTL(ABMR(41,240),"2NR")
  1. Q
  1. ;
  1. 250 ;Value Amount - 5 (SOURCE: FILE=9002274.4055, FIELD=.02)
  1. ; form locator #40b
  1. D GET55
  1. S ABMR(41,250)=$P(ABM(55,5),"^",2)
  1. I $TR($G(ABMR(41,240))," ")="" S ABMR(41,250)=ABM("9SP") Q
  1. S ABMR(41,250)=$$FMT^ABMERUTL(ABMR(41,250),"9RNJ2")
  1. Q
  1. ;
  1. 260 ;Value Code - 6 (SOURCE: FILE=9002274.4055, FIELD=.01)
  1. ; form locator #41b
  1. D GET55
  1. S ABMR(41,260)=$P(ABM(55,6),U)
  1. S ABMR(41,260)=$$FMT^ABMERUTL(ABMR(41,260),"2NR")
  1. Q
  1. ;
  1. 270 ;Value Amount - 6 (SOURCE FILE=9002274.4055, FIELD=.02)
  1. ; form locator #41b
  1. D GET55
  1. S ABMR(41,270)=$P(ABM(55,6),"^",2)
  1. I $TR($G(ABMR(41,260))," ")="" S ABMR(41,270)=ABM("9SP") Q
  1. S ABMR(41,270)=$$FMT^ABMERUTL(ABMR(41,270),"9RNJ2")
  1. Q
  1. ;
  1. 280 ;Value Code - 7 (SOURCE: FILE=9002274.4055, FIELD=.01)
  1. ; form locator #39c
  1. D GET55
  1. S ABMR(41,280)=$P(ABM(55,7),U)
  1. S ABMR(41,280)=$$FMT^ABMERUTL(ABMR(41,280),"2NR")
  1. Q
  1. ;
  1. 290 ;Value Amount - 7 (SOURCE: FILE=9002274.4055, FIELD=.02)
  1. ; form locator #39c
  1. D GET55
  1. S ABMR(41,290)=$P(ABM(55,7),"^",2)
  1. I $TR($G(ABMR(41,280))," ")="" S ABMR(41,290)=ABM("9SP") Q
  1. S ABMR(41,290)=$$FMT^ABMERUTL(ABMR(41,290),"9RNJ2")
  1. Q
  1. ;
  1. 300 ;Value Code - 8 (SOURCE: FILE=9002274.4055, FIELD=.01)
  1. ; form locator #40c
  1. D GET55
  1. S ABMR(41,300)=$P(ABM(55,8),U)
  1. S ABMR(41,300)=$$FMT^ABMERUTL(ABMR(41,300),"2RN")
  1. Q
  1. ;
  1. 310 ;Value Amount - 8 (SOURCE: FILE=9002274.4055, FIELD=.02)
  1. ; form locator #40c
  1. D GET55
  1. S ABMR(41,310)=$P(ABM(55,8),"^",2)
  1. I $TR($G(ABMR(41,300))," ")="" S ABMR(41,310)=ABM("9SP") Q
  1. S ABMR(41,310)=$$FMT^ABMERUTL(ABMR(41,310),"9NRJ2")
  1. Q
  1. ;
  1. 320 ;Value Code - 9 (SOURCE: FILE=9002274.4055, FIELD=.01)
  1. ; form locator #41c
  1. D GET55
  1. S ABMR(41,320)=$P(ABM(55,9),U)
  1. S ABMR(41,320)=$$FMT^ABMERUTL(ABMR(41,320),"2RN")
  1. Q
  1. ;
  1. 330 ;Value Amount - 9 (SOURCE: FILE=9002274.4055, FIELD=.02)
  1. ; form locator #41c
  1. D GET55
  1. S ABMR(41,330)=$P(ABM(55,9),"^",2)
  1. I $TR($G(ABMR(41,320))," ")="" S ABMR(41,330)=ABM("9SP") Q
  1. S ABMR(41,330)=$$FMT^ABMERUTL(ABMR(41,330),"9RNJ2")
  1. Q
  1. ;
  1. 340 ;Value Code - 10 (SOURCE: FILE=9002274.4055, FIELD=.01)
  1. ; form locator #39d
  1. D GET55
  1. S ABMR(41,340)=$P(ABM(55,10),U)
  1. S ABMR(41,340)=$$FMT^ABMERUTL(ABMR(41,340),"2NR")
  1. Q
  1. ;
  1. 350 ;Value Amount - 10 (SOURCE: FILE=9002274.4055, FIELD=.02)
  1. ; form locator #39d
  1. D GET55
  1. S ABMR(41,350)=$P(ABM(55,10),"^",2)
  1. I $TR($G(ABMR(41,340))," ")="" S ABMR(41,350)=ABM("9SP") Q
  1. S ABMR(41,350)=$$FMT^ABMERUTL(ABMR(41,350),"9NRJ2")
  1. Q
  1. ;
  1. 360 ;Value Code - 11 (SOURCE: FILE=900274.4055, FIELD=.01)
  1. ; form locator #40d
  1. D GET55
  1. S ABMR(41,360)=$P(ABM(55,11),U)
  1. S ABMR(41,360)=$$FMT^ABMERUTL(ABMR(41,360),"2NR")
  1. Q
  1. ;
  1. 370 ;Value Amount - 11 (SOURCE: FILE=9002274.4055, FIELD=.02)
  1. ; form locator #40d
  1. D GET55
  1. S ABMR(41,370)=$P(ABM(55,11),"^",2)
  1. I $TR($G(ABMR(41,360))," ")="" S ABMR(41,370)=ABM("9SP") Q
  1. S ABMR(41,370)=$$FMT^ABMERUTL(ABMR(41,370),"9NRJ2")
  1. Q
  1. ;
  1. 380 ;Value Code - 12 (SOURCE: FILE=9002274.4055, FIELD=.01)
  1. ; form locator #41d
  1. D GET55
  1. S ABMR(41,380)=$P(ABM(55,12),U)
  1. S ABMR(41,380)=$$FMT^ABMERUTL(ABMR(41,380),"2NR")
  1. Q
  1. ;
  1. 390 ;Value Amount - 12 (SOURCE: FILE=9002274.4055, FIELD=.02)
  1. ; form locator #41d
  1. D GET55
  1. S ABMR(41,390)=$P(ABM(55,12),"^",2)
  1. I $TR($G(ABMR(41,380))," ")="" S ABMR(41,390)=ABM("9SP") Q
  1. S ABMR(41,390)=$$FMT^ABMERUTL(ABMR(41,390),"9NRJ2")
  1. Q
  1. ;
  1. 400 ;Filler (National Use)
  1. S ABMR(41,400)=""
  1. S ABMR(41,400)=$$FMT^ABMERUTL(ABMR(41,400),5)
  1. Q
  1. ;
  1. EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
  1. ;
  1. ; INPUT: ABMX = data element
  1. ; Y = bill internal entry number
  1. ;
  1. ; OUTPUT: Y = bill internal entry number
  1. ;
  1. S ABMP("BDFN")=ABMY
  1. D SET^ABMERUTL
  1. I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
  1. D @ABMX
  1. S Y=ABMR(41,ABMX)
  1. I $D(ABMP("FMT")) S ABMP("FMT")=1
  1. K ABMR(41,ABMX),ABMX,ABMY,ABMZ
  1. Q Y
  1. ;
  1. GET53 ;GET CONDITION CODES
  1. Q:$D(ABM(55))
  1. N I
  1. S I=0,CNT=0
  1. F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),53,I)) Q:'I D
  1. .S CNT=CNT+1
  1. .S ABM(53,CNT)=^ABMDBILL(DUZ(2),ABMP("BDFN"),53,I,0)
  1. .S ABM(53,CNT)=$P($G(^ABMDCODE(+ABM(53,CNT),0)),U)
  1. .S:$L(ABM(53,CNT))=1 ABM(53,CNT)="0"_ABM(53,CNT)
  1. F I=1:1:10 I '$D(ABM(53,I)) S ABM(53,I)=""
  1. Q
  1. ;
  1. GET55 ;GET VALUE CODES
  1. Q:$D(ABM(55))
  1. N I
  1. S I=0,CNT=0
  1. F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),55,I)) Q:'I D
  1. .S CNT=CNT+1
  1. .S ABM(55,CNT)=^ABMDBILL(DUZ(2),ABMP("BDFN"),55,I,0)
  1. .S $P(ABM(55,CNT),U)=$P($G(^ABMDCODE(+ABM(55,CNT),0)),U)
  1. F I=1:1:12 I '$D(ABM(55,I)) S ABM(55,I)=" "
  1. Q