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

ABME540A.m

Go to the documentation of this file. 
  1. ABME540A ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 40 (Claim Data) cont'd ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;DMJ;
  1.  ;
  1. LOOP ;LOOP HERE
  1.  F I=10:10:170 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),40,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(40,ABME("S#"))=$G(ABMREC(40,ABME("S#")))_ABMR(40,I)
  1.  Q
  1.  ;
  1. 10 ;Record type, 1-2
  1.  S ABMR(40,10)=40
  1.  Q
  1.  ;
  1. 20 ;Sequence, 3-4
  1.  S ABMR(40,20)=ABME("S#")
  1.  S ABMR(40,20)=$$FMT^ABMERUTL(ABMR(40,20),"2RN")
  1.  Q
  1.  ;
  1. 30 ;Patient Control Number, 5-24 (SOURCE: FILE=9000001.41,FIELD=.02)
  1.  S ABMR(40,30)=$$EX^ABMER20(30,ABMP("BDFN"))
  1.  S ABMR(40,30)=$$FMT^ABMERUTL(ABMR(40,30),20)
  1.  Q
  1.  ;
  1. 40 ;Type of Bill, 25-27 (SOURCE: FILE=9002274.4 FIELD=.02)
  1.  S ABME("FLD")=.02
  1.  D DIQ1
  1.  S ABMR(40,40)=ABM(9002274.4,ABMP("BDFN"),.02,"E")
  1.  S ABMR(40,40)=$$FMT^ABMERUTL(ABMR(40,40),3)
  1.  Q
  1.  ;
  1. 50 ;Treatment Authorization Code-A, 28-45 (SOURCE: FILE=9002274.4 FIELD=.58)
  1.  ; form locator #63a
  1.  S ABME("FLD")=.54
  1.  D DIQ1
  1.  S ABMR(40,50)=ABM(9002274.4,ABMP("BDFN"),.58,"E")
  1.  S ABMR(40,50)=$$FMT^ABMERUTL(ABMR(40,50),18)
  1.  Q
  1.  ;
  1. 60 ;Treatment Authorization Code-B, 46-63 (SOURCE: FILE=9002274.4, FIELD=)
  1.  ; form locator #63b
  1.  S ABMR(40,60)=""
  1.  S ABMR(40,60)=$$FMT^ABMERUTL(ABMR(40,60),18)
  1.  Q
  1.  ;
  1. 70 ;Treatment Authorization Code-C, 64-81 (SOURCE: FILE=9002274.4, FIELD=)
  1.  ; form locator #63c
  1.  S ABMR(40,70)=""
  1.  S ABMR(40,70)=$$FMT^ABMERUTL(ABMR(40,70),18)
  1.  Q
  1.  ;
  1. 80 ;Occurrence Code 1, 82-83 (SOURCE: FILE=9002274.4051, FIELD=.01)
  1.  ; form locator #32a
  1.  D GET51
  1.  S ABMR(40,80)=$P($G(ABM(51,1)),U)
  1.  S ABMR(40,80)=$$FMT^ABMERUTL(ABMR(40,80),"2")
  1.  Q
  1.  ;
  1. 90 ;Occurrence Date 1, 84-91 (SOURCE: FILE=9002274.4051, FIELD=.02)
  1.  ; form locator #32a
  1.  D GET51
  1.  S Y=$P($G(ABM(51,1)),"^",2)
  1.  S ABMR(40,90)=$$Y2KD2^ABMDUTL(Y)
  1.  S ABMR(40,90)=$$FMT^ABMERUTL(ABMR(40,90),8)
  1.  Q
  1.  ;
  1. 100 ;Occurrence Code 2, 92-93 (SOURCE: FILE=9002274.4051 FIELD=.01)
  1.  ; form locator #33a
  1.  D GET51
  1.  S ABMR(40,100)=$P($G(ABM(51,2)),U)
  1.  S ABMR(40,100)=$$FMT^ABMERUTL(ABMR(40,100),"2")
  1.  Q
  1.  ;
  1. 110 ;Occurrence Date 2, 94-101 (SOURCE: FILE=9002274.4051, FIELD=.02)
  1.  ; form locator #33a
  1.  D GET51
  1.  S Y=$P($G(ABM(51,2)),"^",2)
  1.  S ABMR(40,110)=$$Y2KD2^ABMDUTL(Y)
  1.  S ABMR(40,110)=$$FMT^ABMERUTL(ABMR(40,110),8)
  1.  Q
  1.  ;         
  1. 120 ;Occurrence Code 3, 102-103 (SOURCE: FILE=9002274.4051, FIELD=.01)
  1.  ; form locator #34a
  1.  D GET51
  1.  S ABMR(40,120)=$P($G(ABM(51,3)),U)
  1.  S ABMR(40,120)=$$FMT^ABMERUTL(ABMR(40,120),"2")
  1.  Q
  1.  ;
  1. 130 ;Occurrence Date 3, 104-111 (SOURCE: FILE=9002274.4051, FIELD=.02)
  1.  ; form locator #34a
  1.  D GET51
  1.  S Y=$P($G(ABM(51,3)),"^",2)
  1.  S ABMR(40,130)=$$Y2KD2^ABMDUTL(Y)
  1.  S ABMR(40,130)=$$FMT^ABMERUTL(ABMR(40,130),8)
  1.  Q
  1.  ;
  1. 140 ;Occurrence Code 4, 112-113 (SOURCE: FILE=9002274.4051, FIELD=.01)
  1.  ; form locator #35a
  1.  D GET51
  1.  S ABMR(40,140)=$P($G(ABM(51,4)),U)
  1.  S ABMR(40,140)=$$FMT^ABMERUTL(ABMR(40,140),"2")
  1.  Q
  1.  ;
  1. 150 ;Occurrence Date 4, 114-121 (SOURCE: FILE=9002274.4051, FIELD=.02)
  1.  ; form locator #35a
  1.  D GET51
  1.  S Y=$P($G(ABM(51,4)),"^",2)
  1.  S ABMR(40,150)=$$Y2KD2^ABMDUTL(Y)
  1.  S ABMR(40,150)=$$FMT^ABMERUTL(ABMR(40,150),8)
  1.  Q
  1.  ;
  1. 160 ;Occurrence Code 5, 122-123 (SOURCE: FILE=9002274.4051, FIELD=.01)
  1.  ; form locator #32b
  1.  D GET51 S ABMR(40,160)=$P($G(ABM(51,5)),U)
  1.  S ABMR(40,160)=$$FMT^ABMERUTL(ABMR(40,160),"2")
  1.  Q
  1. 170 ;Occurrence Date 5, 124-131 (SOURCE: FILE=9002274.4051, FIELD=.02)
  1.  ; form locator #32b
  1.  D GET51
  1.  S Y=$P($G(ABM(51,5)),"^",2)
  1.  S ABMR(40,170)=$$Y2KD2^ABMDUTL(Y)
  1.  S ABMR(40,170)=$$FMT^ABMERUTL(ABMR(40,170),8)
  1.  Q
  1.  ;
  1. DIQ1 ;PULL POLICY HOLDER DATA VIA DIQ1
  1.  Q:$D(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
  1.  N I
  1.  S DIQ="ABM("
  1.  S DIQ(0)="EI"
  1.  S DIC="^ABMDBILL(DUZ(2),"
  1.  S DA=ABMP("BDFN")
  1.  S DR=".02;.54;.55;.56;.58;.76;.77;.78;.79"
  1.  D EN^DIQ1
  1.  K DIQ
  1.  Q
  1.  ;
  1. GET51 ;GET OCCURANCE CODES
  1.  Q:$D(ABM(51))
  1.  N I
  1.  S I=0,CNT=0
  1.  F  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,I)) Q:'I  D
  1.  .S CNT=CNT+1
  1.  .S ABM(51,CNT)=^ABMDBILL(DUZ(2),ABMP("BDFN"),51,I,0)
  1.  .S $P(ABM(51,CNT),U)=$P($G(^ABMDCODE(+ABM(51,CNT),0)),U)
  1.  .S:$L($P(ABM(51,CNT),U))=1 ABM(51,CNT)="0"_ABM(51,CNT)
  1.  F I=1:1:10 I '$D(ABM(51,I)) S ABM(51,I)=""
  1.  Q
  1.  ;
  1. GET57 ;GET OCCURRENCE SPAN CODES
  1.  Q:$D(ABM(57))
  1.  N I
  1.  S I=0,CNT=0
  1.  F  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),57,I)) Q:'I  D
  1.  .S CNT=CNT+1
  1.  .S ABM(57,CNT)=^ABMDBILL(DUZ(2),ABMP("BDFN"),57,I,0)
  1.  .S $P(ABM(57,CNT),U)=$P($G(^ABMDCODE(+ABM(57,CNT),0)),U)
  1.  F I=1,2 I '$D(ABM(57,I)) S ABM(57,I)=""
  1.  Q
  1.  ;
  1. EX(ABMX,ABMY)      ;EXTRINSIC FUNCTION HERE
  1.  ;
  1.  ;  INPUT: ABM X = 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(40,ABMX)
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  K ABMR(40,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
  1.  Q Y