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

ABMUTL8.m

Go to the documentation of this file. 
  1. ABMUTL8 ; IHS/ASDST/DMJ - 837 UTILITIES ;      
  1.  ;;2.6;IHS Third Party Billing;**1,4,6,8,9,10,11,13,14,16,18**;NOV 12, 2009;Build 289
  1.  ;Original;DMJ;09/21/95 12:47 PM
  1.  ;V2.5 P5-837 mod. Use HRN in following priority order-visit loc/parent/loop satellites
  1.  ;v2.5 p5-put POS, TOS by line item
  1.  ;v2.5 p6-Make OVER works correctly
  1.  ;v2.5 p8-IM13324/IM15558-Format 0 to 0.00
  1.  ;v2.5 p8-IM12628-Remove special delimiter for CA
  1.  ;v2.5 p8-task 6-Check value cd before formatting; can be dollar amt or zip
  1.  ;v2.5 p9-IM14702/IM17968-Correct HRN lookup for satellites
  1.  ;v2.5 p9-IM17270-Changed "~" to "-" to avoid delimiter issues
  1.  ;v2.5 p9-IM16962-If BCBS/OK add CR/LF to delimiter; they can't do streamed data
  1.  ;
  1.  ;IHS/SD/SDR-v2.6 CSV
  1.  ;IHS/SD/SDR-2.6*1 -HEAT2836 -Remove Dxs when inpt Medicare/RR
  1.  ;IHS/SD/SDR-2.6*6 -5010 -added code to pull anesthesia charges
  1.  ;IHS/SD/SDR-2.6*13 -Added check for new export mode 35
  1.  ;IHS/SD/SDR-2.6*14 -ICD10 002F Changes for 837 qualifier ICD9 vs ICD10
  1.  ;IHS/SD/SDR-2.6*14 -Updated DX^ABMCVAPI calls to be numeric
  1.  ;IHS/SD/SDR-2.6*14 -split routine to ABMUTL8A due to size
  1.  ;IHS/SD/SDR-2.6*14 -CR4072 -made correction to ICD10 check to be '=30 instead of =1
  1.  ;IHS/SD/SDR-2.6*16 -HEAT217211 -Made change so it won't do the E-code change in DXSET2 if ICD code is an ICD-10 code.
  1.  ;IHS/SD/SDR-2.6*16 -HEAT231506 -Updated so 837D will print DX codes.
  1.  ;IHS/SD/SDR-2.6*18 -HEAT239392 -Made changes so E-code will be included appropriately. Was being dropped from file.
  1.  ;
  1. HRN(X) ;PEP - HRN
  1.  ; First look at Visit Loc for HRN
  1.  ; If not then look at Parent Loc for HRN
  1.  ; If not, loop Satellite Locs for said parent until one is found.
  1.  I $G(ABMP("LDFN")) S HRN=$P($G(^AUPNPAT(+X,41,ABMP("LDFN"),0)),"^",2)
  1.  ;Q:HRN HRN  ;abm*2.6*10 HEAT61426
  1.  Q:($G(HRN)'="") HRN  ;abm*2.6*10 HEAT61426
  1.  S ABMPAR=""
  1.  F  S ABMPAR=$O(^BAR(90052.05,ABMPAR)) Q:ABMPAR=""!$D(^BAR(90052.05,ABMPAR,ABMP("LDFN")))
  1.  S ABMPAR=$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),"^",3)
  1.  I $G(ABMPAR)'="" S HRN=$P($G(^AUPNPAT(X,41,ABMPAR,0)),"^",2)
  1.  Q:HRN HRN
  1.  I $G(ABMPAR)'="" D
  1.  .S ABMSAT=0
  1.  .F  S ABMSAT=$O(^BAR(90052.05,ABMPAR,ABMSAT)) Q:ABMSAT=""  D  Q:HRN
  1.  ..S HRN=$P($G(^AUPNPAT(X,41,ABMSAT,0)),"^",2)
  1.  Q HRN
  1. DXP(X) ;EP - Primary DX
  1.  ;x=bill ien
  1.  D DXSET(X)
  1.  S ABMDXP=$G(ABMDX(1))
  1.  Q ABMDXP
  1. DXA(X) ;EP - Admitting DX
  1.  ;x=bill ien
  1.  N ABMBTYP S ABMBTYP=$P(^ABMDBILL(DUZ(2),X,0),U,2)
  1.  S ABMDXA=$P($G(^ABMDBILL(DUZ(2),X,5)),U,9)
  1.  I ABMDXA="" Q ABMDXA  ;abm*2.6*4 HEAT19688
  1.  S ABMDXA=$P($$DX^ABMCVAPI(+ABMDXA,ABMP("VDT")),U,2)  ;CSV-c
  1.  I ABMDXA="" Q ABMDXA
  1.  S ABMDXA=$TR(ABMDXA,".")
  1.  ;S:$E(ABMBTYP,2)<3 ABMDXA="BJ:"_ABMDXA  ;abm*2.6*14 ICD10 002F
  1.  S:$E(ABMBTYP,2)<3 ABMDXA=$S(+$P($G(^ABMDBILL(DUZ(2),X,17,J,0)),U,6)=1:"ABJ",1:"BJ")_":"_ABMDXA  ;abm*2.6*14 ICD10 002F
  1.  S:$E(ABMBTYP,2)>2 ABMDXA="ZZ:"_ABMDXA
  1.  Q ABMDXA
  1. DXE(X) ;EP - E-Code
  1.  ;x=bill ien
  1.  S ABMDXE=$P($G(^ABMDBILL(DUZ(2),X,8)),U,12)
  1.  I ABMDXE="" Q ABMDXE
  1.  ;S ABMDXE="BN:"_$TR($P($$DX^ABMCVAPI(ABMDXE,ABMP("VDT")),U,2),".")  ;CSV-c  ;abm*2.6*14 update API call
  1.  S ABMDXE="BN:"_$TR($P($$DX^ABMCVAPI(+ABMDXE,ABMP("VDT")),U,2),".")  ;CSV-c  ;abm*2.6*14 update API call
  1.  Q ABMDXE
  1. DXSET(X) ;EP - set dx array
  1.  ;x=bill ien
  1.  ;I +$G(ABMP("EXP"))=31!(+$G(ABMP("EXP"))=32) D DXSET2(X) Q  ;abm*2.6*8 5010  ;abm*2.6*16 HEAT231506
  1.  I +$G(ABMP("EXP"))=31!(+$G(ABMP("EXP"))=32)!(+$G(ABMP("EXP"))=33) D DXSET2(X) Q  ;abm*2.6*8 5010  ;abm*2.6*16 HEAT231506
  1.  K ABMDX
  1.  N I,J
  1.  S ABMCNT=0
  1.  S I=0
  1.  F  S I=$O(^ABMDBILL(DUZ(2),X,17,"C",I)) Q:'I  D
  1.  .S J=0
  1.  .F  S J=$O(^ABMDBILL(DUZ(2),X,17,"C",I,J)) Q:'J  D
  1.  ..S ABMCNT=ABMCNT+1
  1.  ..S:ABMCNT=1 ABMDX(ABMCNT)="BK"
  1.  ..S:ABMCNT'=1 ABMDX(ABMCNT)="BF"
  1.  ..;S $P(ABMDX(ABMCNT),":",2)=$TR($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,2),".")  ;CSV-c  ;abm*2.6*14 update API
  1.  ..S $P(ABMDX(ABMCNT),":",2)=$TR($P($$DX^ABMCVAPI(+J,ABMP("VDT")),U,2),".")  ;CSV-c  ;abm*2.6*14 update API
  1.  ;I $P($G(^ABMDBILL(DUZ(2),X,5)),U,9)'="" S ABMDX("ADM")=$TR($P($$DX^ABMCVAPI($P($G(^ABMDBILL(DUZ(2),X,5)),U,9),ABMP("VDT")),U,2),".")   ;abm*2.6*8 5010  ;abm*2.6*14 update API
  1.  I +$P($G(^ABMDBILL(DUZ(2),X,5)),U,9)'=0 S ABMDX("ADM")=$TR($P($$DX^ABMCVAPI(+$P($G(^ABMDBILL(DUZ(2),X,5)),U,9),ABMP("VDT")),U,2),".")   ;abm*2.6*14 update API
  1.  Q
  1.  ;start new abm*2.6*8 5010
  1. DXSET2(X) ;EP - set dx array
  1.  ;x=bill ien
  1.  K ABMDX
  1.  K ABMDXE  ;abm*2.6*10 HEAT67774
  1.  N I,J
  1.  S ABMCNT=0
  1.  S I=0
  1.  F  S I=$O(^ABMDBILL(DUZ(2),X,17,"C",I)) Q:'I  D
  1.  .S J=0
  1.  .F  S J=$O(^ABMDBILL(DUZ(2),X,17,"C",I,J)) Q:'J  D
  1.  ..;Q:$E($P($$DX^ABMCVAPI($P($G(^ABMDBILL(DUZ(2),X,5)),U,9),ABMP("VDT")),U,2),1)="E"  ;skip E-codes  ;abm*2.6*14 ICD10 002F
  1.  ..;I $E($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,2),1)="E"&($P($$DX^ABMCVAPI(+J,ABMP("VDT")),U,20)'=30) Q  ;skip E-codes  ;abm*2.6*14 ICD10 002F and update API; CR4072  ;abm*2.6*18 HEAT239392
  1.  ..;for next line skip E-codes ;abm*2.6*14 ICD10 002F; Update API; CR4072 ;abm*2.6*18 HEAT239392
  1.  ..;I (+$P($G(^ABMDBILL(DUZ(2),X,5)),U,9)'=0)&(+$P($$DX^ABMCVAPI($P($G(^ABMDBILL(DUZ(2),X,5)),U,9),ABMP("VDT")),U,20)<30) Q  ;skip admit DX if ICD9 Ecode  ;removed line abm*2.6*18 HEAT239392
  1.  ..;I ($E($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,2),1)="E")&($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,20)<30) Q  ;skip DX if ICD9 Ecode  ;removed abm*2.6*18 HEAT239392
  1.  ..;skip admit DX if ICD10 accident cd
  1.  ..;abm*2.6*18 HEAT239392 removed next 2 lines in a2.  ICD shouldn't be skipped here.
  1.  ..;I (+$P($$DX^ABMCVAPI($P($G(^ABMDBILL(DUZ(2),X,5)),U,9),ABMP("VDT")),U,20)=30)&("^V^W^X^Y^"[("^"_$E($P($$DX^ABMCVAPI($P($G(^ABMDBILL(DUZ(2),X,5)),U,9),ABMP("VDT")),U,2),1)_"^")) Q  ;abm*2.6*18 HEAT239392
  1.  ..;I (+$P($$DX^ABMCVAPI(J,ABMP("VDT")),U,20)=30)&("^V^W^X^Y^"[("^"_$E($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,2),1)_"^")) Q  ;skip DX if ICD10 accident code  ;abm*2.6*18 HEAT239392
  1.  ..S ABMCNT=ABMCNT+1
  1.  ..;S:ABMCNT=1 ABMDX(ABMCNT)="BK"  ;abm*2.6*14 ICD10 002F
  1.  ..S:ABMCNT=1 ABMDX(ABMCNT)=$S(+$P($G(^ABMDBILL(DUZ(2),X,17,J,0)),U,6)=1:"ABK",1:"BK")  ;abm*2.6*14 ICD10 002F
  1.  ..;S:ABMCNT'=1 ABMDX(ABMCNT)="BF"  ;abm*2.6*14 ICD10 OO2F
  1.  ..S:ABMCNT'=1 ABMDX(ABMCNT)=$S(+$P($G(^ABMDBILL(DUZ(2),X,17,J,0)),U,6)=1:"ABF",1:"BF")  ;abm*2.6*14 ICD10 002F
  1.  ..;S $P(ABMDX(ABMCNT),":",2)=$TR($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,2),".")  ;CSV-c   ;abm*2.6*14 update API
  1.  ..S $P(ABMDX(ABMCNT),":",2)=$TR($P($$DX^ABMCVAPI(+J,ABMP("VDT")),U,2),".")  ;CSV-c   ;abm*2.6*14 update API
  1.  ..I ABMP("EXP")=31,($P($G(^ABMDBILL(DUZ(2),X,17,J,0)),U,5)'="") S $P(ABMDX(ABMCNT),":",9)=$P($G(^ABMDBILL(DUZ(2),X,17,J,0)),U,5)  ;abm*2.6*9 HEAT57041
  1.  ;
  1.  S ABMCNT=0
  1.  S I=0
  1.  F  S I=$O(^ABMDBILL(DUZ(2),X,17,"C",I)) Q:'I  D
  1.  .S J=0
  1.  .F  S J=$O(^ABMDBILL(DUZ(2),X,17,"C",I,J)) Q:'J  D
  1.  ..;Q:$E($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,2),1)'="E"  ;skip E-codes  ;abm*2.6*14 ICD10 002F
  1.  ..;I $E($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,2),1)'="E"&($P($$DX^ABMCVAPI(+J,ABMP("VDT")),U,20)'=30) Q  ;skip E-codes  ;abm*2.6*14 ICD10 002F, update API; CR4072
  1.  ..;I ($P($$DX^ABMCVAPI(+J,ABMP("VDT")),U,20)=30) Q  ;abm*2.6*16 HEAT217211  ;abm*2.6*18 HEAT239392
  1.  ..;I $E($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,2),1)'="E" Q  ;abm*2.6*16 HEAT217211  ;abm*2.6*18 HEAT239392
  1.  ..I ($E($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,2),1)'="E")&(+$P($$DX^ABMCVAPI(J,ABMP("VDT")),U,20)<30) Q  ;skip E-codes  ;abm*2.6*18 HEAT239392
  1.  ..I (+$P($$DX^ABMCVAPI(J,ABMP("VDT")),U,20)=30)&("^V^W^X^Y^"'[("^"_$E($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,2),1)_"^")) Q  ;abm*2.6*18 HEAT239392
  1.  ..S ABMCNT=ABMCNT+1
  1.  ..;S ABMDXE(ABMCNT)="BN:"_$TR($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,2),".")  ;CSV-c  ;abm*2.6*14 ICD10 002F
  1.  ..S ABMDXE(ABMCNT)=$S((+$P($G(^ABMDBILL(DUZ(2),X,17,J,0)),U,6)=1):"ABN:",1:"BN:")_$TR($P($$DX^ABMCVAPI(+J,ABMP("VDT")),U,2),".")  ;CSV-c  ;abm*2.6*14 ICD10 002F, updated API
  1.  ..I $P($G(^ABMDBILL(DUZ(2),X,17,J,0)),U,5)'="" S $P(ABMDXE(ABMCNT),":",9)=$P($G(^ABMDBILL(DUZ(2),X,17,J,0)),U,5)
  1.  ..I ABMP("EXP")=31,($P($G(^ABMDBILL(DUZ(2),X,17,J,0)),U,5)'="") S $P(ABMDX(ABMCNT),":",9)=$P($G(^ABMDBILL(DUZ(2),X,17,J,0)),U,5)  ;abm*2.6*9 HEAT57041
  1.  ;I $P($G(^ABMDBILL(DUZ(2),X,5)),U,9)'="" S ABMDX("ADM")=$TR($P($$DX^ABMCVAPI($P($G(^ABMDBILL(DUZ(2),X,5)),U,9),ABMP("VDT")),U,2),".")   ;abm*2.6*8 5010  ;abm*2.6*14 ICD10 002F
  1.  ;start new abm*2.6*14 ICD10 002F, update APIs
  1.  I $P($G(^ABMDBILL(DUZ(2),X,5)),U,9)'="" D
  1.  .S ABMDX("ADM")=$TR($P($$DX^ABMCVAPI(+$P($G(^ABMDBILL(DUZ(2),X,5)),U,9),ABMP("VDT")),U,2),".")
  1.  .S ABMDX("ADMTYP")=$P($$DX^ABMCVAPI(+$P($G(^ABMDBILL(DUZ(2),X,5)),U,9),ABMP("VDT")),U,20)
  1.  ;end new ICD10 002F
  1.  Q
  1.  ;end new abm*2.6*8
  1. PXSET(X) ;EP -set px array
  1.  ;x=bill ien
  1.  D PXSET^ABMUTL8A(X)
  1.  Q
  1. OSSET(X) ;EP -occurrence span set
  1.  ;x=bill ien
  1.  D OSSET^ABMUTL8A(X)
  1.  Q
  1. OCSET(X) ;EP -occurrence set
  1.  ;x=bill ien
  1.  D OCSET^ABMUTL8A(X)
  1.  Q
  1. VASET(X) ;EP -value code set
  1.  ;x=bill ien
  1.  K ABMVA
  1.  S ABMCNT=0
  1.  N I
  1.  S I=0
  1.  F  S I=$O(^ABMDBILL(DUZ(2),X,55,I)) Q:'I  D
  1.  .S ABMLINE=^ABMDBILL(DUZ(2),X,55,I,0)
  1.  .S ABMCNT=ABMCNT+1
  1.  .S ABMVA(ABMCNT)="BE"
  1.  .S $P(ABMVA(ABMCNT),":",2)=$P($G(^ABMDCODE(+$P(ABMLINE,U),0)),U)
  1.  .;start old abm*2.6*11 IHS/SD/AML HEAT89676
  1.  .;I $P(ABMVA(ABMCNT),":",2)'="A0" S $P(ABMVA(ABMCNT),":",5)=$FN($P(ABMLINE,U,2),"",2)
  1.  .;E  S $P(ABMVA(ABMCNT),":",5)=$P(ABMLINE,U,2)
  1.  .;end old heat89676
  1.  .S $P(ABMVA(ABMCNT),":",5)=$P(ABMLINE,U,2)  ;abm*2.6*11 IHS/SD/AML HEAT89676
  1.  Q
  1. CDSET(X) ;EP - condition code set
  1.  ;x=bill ien
  1.  D CDSET^ABMUTL8A(X)
  1.  Q
  1.  ;start new abm*2.6*6 5010
  1. ANES(X) ;EP - anesthesia charges set
  1.  D ANES^ABMUTL8A(X)
  1.  Q
  1.  ;end new 5010
  1. WR(X) ;EP - write to file
  1.  S ABMDELI="~"
  1.  S:$$RCID^ABMUTLP(ABMP("INS"))=730266607 ABMDELI="~"_$C(13)_$C(10)
  1.  S ABMSTRNG=$$STRIP(ABMREC(X))
  1.  Q:$L(ABMSTRNG,"*")<2
  1.  U IO
  1.  U:$G(ABMDEBUG) IO(0)
  1.  S ABMSTRNG=$TR(ABMSTRNG,"~","-")
  1.  W ABMSTRNG
  1.  W ABMDELI
  1.  W:$G(ABMDEBUG) !
  1.  S ABMSTOT=ABMSTOT+1
  1.  U IO(0)
  1.  K ABMR,ABMREC
  1.  Q
  1. STRIP(X) ;EP - strip trailing null data elements
  1.  I $E(X,1,3)="ISA" Q X
  1.  N I
  1.  F I=$L(X,"*"):-1:1 Q:$P(X,"*",I)'=""
  1.  S Y=$P(X,"*",1,I)
  1.  Q Y
  1. AN(X) ;EP - alpha numeric only
  1.  N I
  1.  F I=1:1:$L(X) D
  1.  .S ABMCHAR=$E(X,I)
  1.  .S ABMCHAR($A(ABMCHAR))=""
  1.  S I=0
  1.  F  S I=$O(ABMCHAR(I)) Q:'I  D
  1.  .I I>31&(I<34) Q
  1.  .I I>37&(I<59) Q
  1.  .I I=61!(I=63) Q
  1.  .I I>64&(I<91) Q
  1.  .I I>96&(I<123) Q
  1.  .S X=$TR(X,$C(I))
  1.  K ABMCHAR
  1.  Q X
  1. PTAX(X) ;EP - provider taxonomy
  1.  ;x=location ien
  1.  S X="261QP0904X"
  1.  Q X
  1. OVER(ABMLN,ABMPCE) ;EP - get override values from 3P Insurer file
  1.  S ABMVALUE=""
  1.  N ABMOVTYP
  1.  ;start old abm*2.6*10 HEAT53137
  1.  ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMLN,ABMPCE,0)) S ABMOVTYP=0
  1.  ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMLN,ABMPCE,ABMP("VTYP"))) S ABMOVTYP=ABMP("VTYP")
  1.  ;end old start new HEAT53137,HEAT67605
  1.  ;S ABMT("EXP")=$S(ABMP("EXP")=32:27,1:14)  ;abm*2.6*13 export mode 35
  1.  S ABMT("EXP")=$S(ABMP("EXP")=32:35,1:14)  ;abm*2.6*13 export mode 35
  1.  I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMT("EXP"),ABMLN,ABMPCE,0)) S ABMOVTYP=0
  1.  I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMT("EXP"),ABMLN,ABMPCE,ABMP("VTYP"))) S ABMOVTYP=ABMP("VTYP")
  1.  ;end new HEAT53137
  1.  I $G(ABMOVTYP)="" Q ABMVALUE
  1.  ;S ABMVALUE=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMLN,ABMPCE,ABMOVTYP)  ;abm*2.6*10 HEAT53137
  1.  S ABMVALUE=^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMT("EXP"),ABMLN,ABMPCE,ABMOVTYP)  ;abm*2.6*10 HEAT53137, HEAT67605
  1.  Q ABMVALUE
  1.  ;start new abm*2.6*6 5010
  1. 837 ;EP - override for 837 5010 formats
  1.  K ABME("VTYP")
  1.  ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2.5,"ASEND",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),"N")) D  ;do not send seg  ;abm*2.6*10 HEAT53137
  1.  I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),"N")) D  ;do not send seg  ;abm*2.6*10 HEAT53137
  1.  .S ABMREC(ABME("RTYPE"))=ABME("RTYPE")
  1.  .K ABMR(ABME("RTYPE"))
  1.  .S ABMR(ABME("RTYPE"),10)=ABME("RTYPE")
  1.  S ABMELE=""
  1.  ;F  S ABMELE=$O(^ABMNINS(DUZ(2),ABMP("INS"),2.5,"ASEND",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),ABMELE)) Q:($G(ABMELE)="")  D  ;abm*2.6*10 HEAT53137
  1.  F  S ABMELE=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),ABMELE)) Q:($G(ABMELE)="")  D  ;abm*2.6*10 HEAT53137
  1.  .;I $O(^ABMNINS(DUZ(2),ABMP("INS"),2.5,"ASEND",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),ABMELE,""))="S" Q  ;abm*2.6*10 HEAT53137
  1.  .I $O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),ABMELE,""))="S" Q  ;abm*2.6*10 HEAT53137
  1.  .I ABMELE["01" S ABMELEM=2
  1.  .I ABMELE["02" S ABMELEM=3
  1.  .I ABMELE["03" S ABMELEM=4
  1.  .I ABMELE["04" S ABMELEM=5
  1.  .I ABMELE["05" S ABMELEM=6
  1.  .I ABMELE["06" S ABMELEM=7
  1.  .I ABMELE["07" S ABMELEM=8
  1.  .I ABMELE["08" S ABMELEM=9
  1.  .;I ABMELE["09" S ABMELEM=10  ;abm*2.6*9 HEAT59090
  1.  .I ABMELE["09" S ABMELEM=100  ;abm*2.6*9 HEAT59090
  1.  .I ABMELE["14" S ABMELEM=15  ;abm*2.6*10 HEAT74624
  1.  .I ABMELE["15" S ABMELEM=16  ;abm*2.6*9 HEAT58133
  1.  .S ABMR(ABME("RTYPE"),ABMELEM)=""
  1.  .S $P(ABMREC(ABME("RTYPE")),"*",$E(ABMELEM,1,$L(ABMELEM)-1))=""
  1.  ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2.5,"A837",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"))) D  ;seg override  ;abm*2.6*10 HEAT53137
  1.  I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"A837",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"))) D  ;seg override  ;abm*2.6*10 HEAT53137
  1.  .S ABMELE=""
  1.  .;F  S ABMELE=$O(^ABMNINS(DUZ(2),ABMP("INS"),2.5,"A837",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),ABMELE)) Q:($G(ABMELE)="")  D  ;abm*2.6*10 HEAT53137
  1.  .F  S ABMELE=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"A837",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),ABMELE)) Q:($G(ABMELE)="")  D  ;abm*2.6*10 HEAT53137
  1.  ..;start old abm*2.6*10 HEAT53137
  1.  ..;S ABMVALUE=$G(^ABMNINS(DUZ(2),ABMP("INS"),2.5,"A837",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),ABMELE,0))
  1.  ..;S:($G(ABMVALUE)="") ABMVALUE=$G(^ABMNINS(DUZ(2),ABMP("INS"),2.5,"A837",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),ABMELE,ABMP("VTYP")))
  1.  ..;end old start new HEAT53137
  1.  ..S ABMVALUE=$G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"A837",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),ABMELE,0))
  1.  ..S:($G(ABMVALUE)="") ABMVALUE=$G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"A837",+ABMP("EXP"),ABMLOOP,ABME("RTYPE"),ABMELE,ABMP("VTYP")))
  1.  ..;end new HEAT53137
  1.  ..I ABMVALUE'="" D
  1.  ...I ABMELE["01" S ABMELEM=2
  1.  ...I ABMELE["02" S ABMELEM=3
  1.  ...I ABMELE["03" S ABMELEM=4
  1.  ...I ABMELE["04" S ABMELEM=5
  1.  ...I ABMELE["05" S ABMELEM=6
  1.  ...I ABMELE["06" S ABMELEM=7
  1.  ...I ABMELE["07" S ABMELEM=8
  1.  ...I ABMELE["08" S ABMELEM=9
  1.  ...;I ABMELE["09" S ABMELEM=10  ;abm*2.6*9 HEAT59090
  1.  ...I ABMELE["09" S ABMELEM=100  ;abm*2.6*9 HEAT59090
  1.  ...I ABMELE["14" S ABMELEM=15  ;abm*2.6*10 HEAT74624
  1.  ...;I ABMELE["15" S ABMELEM=160  ;abm*2.6*9 HEAT58133  ;abm*2.6*11 HEAT97792
  1.  ...I ABMELE["15" S ABMELEM=16  ;abm*2.6*11 HEAT97792
  1.  ...S ABMR(ABME("RTYPE"),ABMELEM)=ABMVALUE
  1.  ...I ABME("RTYPE")="ISA",ABMELEM=7 S ABMVALUE=$$FMT^ABMERUTL((ABMVALUE),15)  ;abm*2.6*10 IHS/SD/AML 03/23/2012 - If ISA06, ensure 15 chars for element
  1.  ...I ABME("RTYPE")="ISA",ABMELEM=9 S ABMVALUE=$$FMT^ABMERUTL((ABMVALUE),15)  ;abm*2.6*9 NOHEAT - ensure ISA08 15 chars
  1.  ...S $P(ABMREC(ABME("RTYPE")),"*",$E(ABMELEM,1,$L(ABMELEM-1)))=ABMVALUE  ;abm*2.6*10 HEAT74624
  1.  Q
  1.  ;end new 5010