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

ABMEH63.m

Go to the documentation of this file. 
  1. ABMEH63 ; IHS/FCS/DRS - HCFA-1500 EMC RECORD FB1 (Medical Segment) ;    
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/FCS/DRS - ABM*2.4*9 - New routine - V2.4 Patch 9 Part 1c
  1.  ;      In response to Envoy edit checks about line item provider.
  1.  ;      (waiting to hear from them what kind of place of service
  1.  ;      field is triggering the message about this record)
  1.  ;
  1.  ;      Rendering Provider info - Part 5c
  1.  ;
  1.  ;      $$TOS - Type of Service - Part 8
  1.  ;
  1.  ;      Rendering Provider Network ID - Part 19a
  1.  ;          Stub only for now - waiting more info from site
  1.  ;          regarding they insurer-specific requirements.
  1.  ;
  1.  ; FB1 line item data:  
  1.  ;   Place of Service Name
  1.  ;   Provider info for each of: 
  1.  ;      Ordering, Referring, Rendering, Supervising
  1.  ;
  1.  ;   $P(ABMRV(J,K),U,7) is the line-item provider
  1.  ;   If that's not present, we have ABMAPRV = the bill's attending prov
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20395
  1.  ;   Split out lines bundled by rev code
  1.  ;
  1. START ;START HERE
  1.  K ABMR(63),ABMREC(63)
  1.  D LOOP
  1.  S ABME("RTYPE")=63 D S90^ABMERUTL
  1.  S ABMEF("LINE")=ABMREC(63)
  1.  D WRITE^ABMEF19
  1.  Q
  1. LOOP ;LOOP HERE
  1.  N ABMEH63
  1.  D
  1.  .N X S X=$P(ABMRV(J,K,L),U,7) S:'X X=ABMAPRV
  1.  .I X S ABMEH63("RENDERING")=X
  1.  F I=10:10:250 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),63,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(63)=$G(ABMREC(63))_ABMR(63,I)
  1.  Q
  1. 10 ;1-3 Record type
  1.  S ABMR(63,10)="FB1"
  1.  Q
  1. 20 ;4-5 Sequence 
  1.  S ABMR(63,20)=ABME("S#")
  1.  S ABMR(63,20)=$$FMT^ABMERUTL(ABMR(63,20),"2NR")
  1.  Q
  1. 30 ;6-22 Patient Control Number
  1.  S ABMR(63,30)=ABMP("PCN")
  1.  S ABMR(63,30)=$$FMT^ABMERUTL(ABMR(63,30),17)
  1.  Q
  1. 40 ;23-39 Line Item Control #
  1.  S ABMR(63,40)=""
  1.  S ABMR(63,40)=$$FMT^ABMERUTL(ABMR(63,40),17)
  1.  Q
  1. 50 ;40^33^X^PLACE OF SVC NAME
  1.  S ABMR(63,50)=""
  1.  S ABMR(63,50)=$$FMT^ABMERUTL(ABMR(63,50),33)
  1.  Q
  1. 60 ;73^20^X^ORDERING PROVIDER LAST NAME
  1.  S ABMR(63,60)=""
  1.  S ABMR(63,60)=$$FMT^ABMERUTL(ABMR(63,60),20)
  1.  Q
  1. 70 ;93^12^X^ORDERING PROVIDER FIRST NAME
  1.  S ABMR(63,70)=""
  1.  S ABMR(63,70)=$$FMT^ABMERUTL(ABMR(63,70),12)
  1.  Q
  1. 80 ;105^1^X^ORDERING PROVIDER MI
  1.  S ABMR(63,80)=""
  1.  S ABMR(63,80)=$$FMT^ABMERUTL(ABMR(63,80),1)
  1.  Q
  1. 90 ;106^15^X^ORDERING PROVIDER UPIN
  1.  S ABMR(63,90)=""
  1.  S ABMR(63,90)=$$FMT^ABMERUTL(ABMR(63,90),15)
  1.  Q
  1. 100 ;121^20^X^REFERRING PROVIDER LAST NAME
  1.  S ABMR(63,100)=""
  1.  S ABMR(63,100)=$$FMT^ABMERUTL(ABMR(63,100),20)
  1.  Q
  1. 110 ;141^12^X^REFERRING PROVIDER FIRST NAME
  1.  S ABMR(63,110)=""
  1.  S ABMR(63,110)=$$FMT^ABMERUTL(ABMR(63,110),12)
  1.  Q
  1. 120 ;153^1^X^REFERRING PROVIDER MI
  1.  S ABMR(63,120)=""
  1.  S ABMR(63,120)=$$FMT^ABMERUTL(ABMR(63,120),1)
  1.  Q
  1. 130 ;154^15^X^REFERRING PROVIDER UPIN
  1.  S ABMR(63,130)=""
  1.  S ABMR(63,130)=$$FMT^ABMERUTL(ABMR(63,130),15)
  1.  Q
  1. 140 ;169^20^X^RENDERING PROVIDER LAST NAME
  1.  I $G(ABMEH63("RENDERING")) S ABMR(63,140)=$$LNM^ABMEEPRV(ABMEH63("RENDERING"))
  1.  E  S ABMR(63,140)=""
  1.  S ABMR(63,140)=$$FMT^ABMERUTL(ABMR(63,140),20)
  1.  Q
  1. 150 ;189^12^X^RENDERING PROVIDER FIRST NAME
  1.  I $G(ABMEH63("RENDERING")) S ABMR(63,150)=$$FNM^ABMEEPRV(ABMEH63("RENDERING"))
  1.  E  S ABMR(63,150)=""
  1.  S ABMR(63,150)=$$FMT^ABMERUTL(ABMR(63,150),12)
  1.  Q
  1. 160 ;201^1^X^RENDERING PROVIDER MI
  1.  I $G(ABMEH63("RENDERING")) S ABMR(63,160)=$$MI^ABMEEPRV(ABMEH63("RENDERING"))
  1.  E  S ABMR(63,160)=""
  1.  S ABMR(63,160)=$$FMT^ABMERUTL(ABMR(63,160),1)
  1.  Q
  1. 170 ;202^15^X^RENDERING PROVIDER UPIN
  1.  I $G(ABMEH63("RENDERING")) S ABMR(63,170)=$$UPIN^ABMEEPRV(ABMEH63("RENDERING"))
  1.  E  S ABMR(63,170)=""
  1.  S ABMR(63,170)=$$FMT^ABMERUTL(ABMR(63,170),15)
  1.  Q
  1. 180 ;217^20^X^SUPERVISING PROVIDER LAST NAME
  1.  S ABMR(63,180)=""
  1.  S ABMR(63,180)=$$FMT^ABMERUTL(ABMR(63,180),20)
  1.  Q
  1. 190 ;237^12^X^SUPERVISING PROVIDER FIRST NAME
  1.  S ABMR(63,190)=""
  1.  S ABMR(63,190)=$$FMT^ABMERUTL(ABMR(63,190),12)
  1.  Q
  1. 200 ;249^1^X^SUPERVISING PROVIDER MI
  1.  S ABMR(63,200)=""
  1.  S ABMR(63,200)=$$FMT^ABMERUTL(ABMR(63,200),1)
  1.  Q
  1. 210 ;250^15^X^SUPERVISING PROVIDER NPI
  1.  S ABMR(63,210)=""
  1.  S ABMR(63,210)=$$FMT^ABMERUTL(ABMR(63,210),15)
  1.  Q
  1. 220 ;265^15^X^SUPERVISING PROVIDER UPIN 
  1.  S ABMR(63,220)=""
  1.  S ABMR(63,220)=$$FMT^ABMERUTL(ABMR(63,220),15)
  1.  Q
  1. 230 ;280^20^X^FILLER-FB1-280
  1.  S ABMR(63,230)=""
  1.  S ABMR(63,230)=$$FMT^ABMERUTL(ABMR(63,230),20)
  1.  Q
  1. 240 ;300^15^X^RENDERING PROVIDER NETWORK ID (ENVOY SPECIAL)
  1.  S ABMR(63,240)="" ; 
  1.  S ABMR(63,240)=$$FMT^ABMERUTL(ABMR(63,240),15)
  1.  Q
  1. 250 ;315^6^X^FILLER-FB1-315
  1.  S ABMR(63,250)=""
  1.  S ABMR(63,250)=$$FMT^ABMERUTL(ABMR(63,250),6)
  1.  Q
  1. EX(ABMX,ABMY,ABMZ) ;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(63,ABMX)
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  K ABMR(63,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
  1.  Q Y
  1.  ;
  1. TOSTSTL ; Loop to test all
  1.  D TOSTST("")
  1.  N X S X=""
  1.  F  S X=$O(^ICPT("B",X)) Q:X=""  D TOSTST(X)
  1.  Q
  1.  ;
  1. TOSTST(CPT,J) ; devel - test $$TOS logic
  1.  W "CPT=",CPT
  1.  W " " D
  1.  . I CPT]"" D
  1.  . . N X S X=$O(^ICPT("B",CPT,0)) Q:'X
  1.  . . W $$GET1^DIQ(81,X_",","SHORT NAME")
  1.  . . W " ",$$GET1^DIQ(81,X_",","CPT CATEGORY")
  1.  . W " -> TOS="
  1.  . S:'$D(J) J=21
  1.  N K,ABMRV S K=1,ABMRV(J,K,L)=U_CPT
  1.  W $$TOS,! Q
  1.  ;
  1. TOS() ;EP - type of service (where x=multiple from 3P Bill File)
  1.  ; Called from ABMEH61 and put here because we have $S well <10000
  1.  ; Modified from TOS^ABMERUTL - some added precision
  1.  ; We have J, K, and ABMRV(J,K)
  1.  N CPT,TOS S CPT=$P(ABMRV(J,K,L),U,2)
  1.  I CPT]"" D  Q:$D(TOS) TOS
  1.  . I CPT="A9220" S TOS=10 Q  ; Blood
  1.  . S CPTD0=$O(^ICPT("B",CPT,0)) Q:'CPTD0
  1.  . N X S X=$G(^ICPT(CPTD0,0)) Q:X=""
  1.  . I X["RADIATION THERAPY" S TOS="06" Q  ; Radiation Therapy
  1.  . I X["CONSULTATION" S TOS="03" Q  ; Consultation
  1.  . I X["OPINION" D  Q:$D(TOS)
  1.  . . I X["2ND" S TOS="20" Q  ; Second Surgical Opinion
  1.  . . I X["3RD" S TOS="21" Q  ; Third Surgical Opinion
  1.  . I X["DIAGNOSTIC RADIOLOGY" S TOS="04" Q
  1.  . N CAT S CAT=$P(X,U,3) Q:'CAT
  1.  . S X=$G(^DIC(81.1,CAT,0)) Q:X=""
  1.  . I $P(X,U,2)'="m" D  Q:X=""  ; replace X w/corr "major" node
  1.  . . N MAJ S MAJ=$P(X,U,3) I MAJ="" S X="" Q
  1.  . . S X=$G(^DIC(81.1,MAJ,0))
  1.  . I X["MEDICINE" S TOS="01" Q
  1.  . I X["SURGERY" S TOS="02" Q
  1.  . I X["RADIOLOGY" S TOS="04" Q
  1.  . I X["LABORATORY" S TOS="05" Q
  1.  . I X["ANESTHESIA" S TOS="07" Q
  1.  ; and if we didn't find it, set it based on J subscript
  1.  Q:J=21 "02"
  1.  Q:J=35 "04"
  1.  Q:J=37 "05"
  1.  Q:J=39 "07"
  1.  Q:J=23 99
  1.  Q "01"