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

ABMER41A.m

Go to the documentation of this file. 
  1. ABMER41A ; IHS/ASDST/DMJ - UB92 EMC RECORD 41 (Claim Data Condition-Value) cont'd ; 
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;DMJ;
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - IM13324/IM15558
  1.  ;   Format change to 0.00
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p11 - NPI
  1.  ;
  1. LOOP ;LOOP HERE
  1.  F I=10:10:210 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. 10 ;Record type
  1.  S ABMR(41,10)=41
  1.  Q
  1.  ;
  1. 20 ;Sequence
  1.  S ABMR(41,20)=ABME("S#")
  1.  S ABMR(41,20)=$$FMT^ABMERUTL(ABMR(41,20),"2RN")
  1.  Q
  1.  ;
  1. 30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
  1.  S ABMR(41,30)=$$EX^ABMER20(30,ABMP("BDFN"))
  1.  S ABMR(41,30)=$$FMT^ABMERUTL(ABMR(41,30),20)
  1.  Q
  1.  ;
  1. 40 ;Condition Code - 1 (SOURCE: FILE=9002274.4053 FIELD=.01)
  1.  ; form locator #24
  1.  D GET53
  1.  S ABMR(41,40)=ABM(53,1)
  1.  S ABMR(41,40)=$$FMT^ABMERUTL(ABMR(41,40),"2")
  1.  Q
  1.  ;
  1. 50 ;Condition Code - 2 (SOURCE: FILE=9002274.4053 FIELD=.01)
  1.  ; form locator #25
  1.  D GET53
  1.  S ABMR(41,50)=ABM(53,2)
  1.  S ABMR(41,50)=$$FMT^ABMERUTL(ABMR(41,50),"2")
  1.  Q
  1.  ;
  1. 60 ;Condition Code - 3 (SOURCE: FILE=9002274.4053, FIELD=.01)
  1.  ; form locator #26
  1.  D GET53
  1.  S ABMR(41,60)=ABM(53,3)
  1.  S ABMR(41,60)=$$FMT^ABMERUTL(ABMR(41,60),"2")
  1.  Q
  1.  ;
  1. 70 ;Condition Code - 4 (SOURCE: FILE=9002274.4053, FIELD=.01)
  1.  ; form locator #27
  1.  D GET53
  1.  S ABMR(41,70)=ABM(53,4)
  1.  S ABMR(41,70)=$$FMT^ABMERUTL(ABMR(41,70),"2")
  1.  Q
  1.  ;
  1. 80 ;Condition Code - 5 (SOURCE: FILE=9002274.4053, FIELD=.01)
  1.  ; form locator #28
  1.  D GET53
  1.  S ABMR(41,80)=ABM(53,5)
  1.  S ABMR(41,80)=$$FMT^ABMERUTL(ABMR(41,80),"2")
  1.  Q
  1.  ;
  1. 90 ;Condition Code - 6 (SOURCE: FILE=9002274.4053, FIELD=.01)
  1.  ; form locator #29
  1.  D GET53
  1.  S ABMR(41,90)=ABM(53,6)
  1.  S ABMR(41,90)=$$FMT^ABMERUTL(ABMR(41,90),"2")
  1.  Q
  1. 100 ;Condition Code - 7 (SOURCE: FILE=9002274.4053, FIELD=.01)
  1.  ; form locator #30
  1.  D GET53 S ABMR(41,100)=ABM(53,7)
  1.  S ABMR(41,100)=$$FMT^ABMERUTL(ABMR(41,100),"2")
  1.  Q
  1.  ;
  1. 110 ;Condition Code - 8 (SOURCE: FILE=9002274.4053, FIELD=.01)
  1.  D GET53
  1.  S ABMR(41,110)=ABM(53,8)
  1.  S ABMR(41,110)=$$FMT^ABMERUTL(ABMR(41,110),"2")
  1.  Q
  1.  ;
  1. 120 ;Condition Code - 9 (SOURCE: FILE=9002274.4053, FIELD=.01)
  1.  D GET53
  1.  S ABMR(41,120)=ABM(53,9)
  1.  S ABMR(41,120)=$$FMT^ABMERUTL(ABMR(41,120),"2")
  1.  Q
  1.  ;
  1. 130 ;Condition Code - 10 (SOURCE: FILE=9002274.4053, FIELD=.01)
  1.  D GET53
  1.  S ABMR(41,130)=ABM(53,10)
  1.  S ABMR(41,130)=$$FMT^ABMERUTL(ABMR(41,130),"2")
  1.  Q
  1.  ;
  1. 140 ;Form Locator 31 (Upper) (SOURCE: FILE=, FIELD=)
  1.  S ABMR(41,140)=""
  1.  S ABMR(41,140)=$$FMT^ABMERUTL(ABMR(41,140),5)
  1.  Q
  1.  ;
  1. 150 ;Form Locator 31 (Lower) (SOURCE: FILE= FIELD=)
  1.  S ABMR(41,150)=""
  1.  S ABMR(41,150)=$$FMT^ABMERUTL(ABMR(41,150),6)
  1.  Q
  1.  ;
  1. 160 ;Value Code - 1 (SOURCE: FILE=9002274.4055, FIELD=.01)
  1.  ; form locator #39a
  1.  D GET55
  1.  S ABMR(41,160)=$P(ABM(55,1),U)
  1.  S ABMR(41,160)=$$FMT^ABMERUTL(ABMR(41,160),"2RN")
  1.  Q
  1.  ;
  1. 170 ;Value Amount - 1 (SOURCE: FILE=9002274.4055, FIELD=.02)
  1.  ; form locator #39a
  1.  D GET55
  1.  S ABMR(41,170)=$P(ABM(55,1),"^",2)
  1.  I $TR($G(ABMR(41,160))," ")="" S ABMR(41,170)=ABM("9SP") Q
  1.  S ABMR(41,170)=$$FMT^ABMERUTL(ABMR(41,170),"9RN2")
  1.  Q
  1.  ;
  1. 180 ;Value Code - 2 (SOURCE: FIlE=9002274.4055, FIELD=.01)
  1.  ; form locator #40a
  1.  D GET55
  1.  S ABMR(41,180)=$P(ABM(55,2),U)
  1.  S ABMR(41,180)=$$FMT^ABMERUTL(ABMR(41,180),"2RN")
  1.  Q
  1.  ;
  1. 190 ;Value Amount - 2 (SOURCE: FILE=9002274.4055, FIELD=.02)
  1.  ; form locator #40a
  1.  D GET55
  1.  S ABMR(41,190)=$P(ABM(55,2),"^",2)
  1.  I $TR($G(ABMR(41,180))," ")="" S ABMR(41,190)=ABM("9SP") Q
  1.  S ABMR(41,190)=$$FMT^ABMERUTL(ABMR(41,190),"9RN2")
  1.  Q
  1.  ;
  1. 200 ;Value Code - 3 (SOURCE: FILE=9002274.4055, FIELD=.01) D GET55
  1.  ; form locator #40a
  1.  D GET55
  1.  S ABMR(41,200)=$P(ABM(55,3),U)
  1.  S ABMR(41,200)=$$FMT^ABMERUTL(ABMR(41,200),"2RN")
  1.  Q
  1.  ;
  1. 210 ;Condition Code - 11 (SOURCE: FILE=9002274.4053, FIELD=.01)
  1.  D GET53
  1.  S ABMR(41,210)=$G(ABM(53,11))
  1.  S ABMR(41,210)=$$FMT^ABMERUTL(ABMR(41,210),"2")
  1.  Q
  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
  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