IBTRHLO1 ;ALB/YMG - Create and send 278 inquiry cont. ;30 Apr 2015 12:29 PM
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
AUT ; create AUT segment
N AUT,Z
S Z=""
I $P(NODE17,U)'="" S Z="REF 2000E"_HLECH_$P(NODE17,U),$P(Z,HLECH,5)="BB"
I Z="",$P(NODE17,U,2)'="" S Z="REF 2000E"_HLECH_$P(NODE17,U,2),$P(Z,HLECH,5)="NT"
I Z="" Q
S AUT="AUT"_HLFS_HLFS_Z
S HCT=HCT+1,^TMP("HLS",$J,HCT)=AUT
Q
;
G2ORXA ; create G2O.RXA segment (G2O segment group)
N RXA,SUBLSTR,TXNUM,TXCNT,Z
S TXNUM=$P(NODE7,U,5) I TXNUM="" Q ; missing treatment series number
S TXCNT=$P(NODE7,U,6) I TXCNT="" Q ; missing treatment count
S TXNUM=+TXNUM,TXCNT=+TXCNT,SUBLSTR=""
S Z=+$P(NODE7,U,7) I Z>0 S SUBLSTR=$$GET1^DIQ(356.012,Z_",",.01)
S Z=+$P(NODE7,U,8) I Z>0 S SUBLSTR=SUBLSTR_HLREP_$$GET1^DIQ(356.012,Z_",",.01)
S RXA="RXA"_HLFS_$$ENCHL7^IBCNEHLQ(TXNUM)_HLFS_$$ENCHL7^IBCNEHLQ(TXCNT)_HLFS_$$HLDATE^HLFNC(NOWDT)_HLFS_$$HLDATE^HLFNC(NOWDT)
S RXA=RXA_HLFS_"1"_HLFS_"0"_HLFS_HLFS_HLFS_SUBLSTR
S Z=$P(NODE7,U,10),$P(RXA,HLFS,20)=$P(NODE7,U,9)_$S(Z'="":HLREP_Z,1:"")
S $P(RXA,HLFS,21)=$P(NODE7,U,13)
S HCT=HCT+1,^TMP("HLS",$J,HCT)=RXA
D G2ONTE
Q
;
G2ONTE ; create G2O.NTE segments (G2O segment group)
N CMT,NTE,Z
F Z=11:1:12 S CMT=$P(NODE7,U,Z) I CMT'="" D
.S NTE="NTE"_HLFS_HLFS_HLFS_$$ENCHL7^IBCNEHLQ(CMT)_HLFS_"CR2 2000E"
.S HCT=HCT+1,^TMP("HLS",$J,HCT)=NTE
.Q
Q
;
RXE ; create RXE segment
N BGAS,RXE,OXYTST,Z
S BGAS=+$P(NODE9,U) I 'BGAS Q ; missing arterial blood gas quantity
S Z=$$ENCHL7^IBCNEHLQ($P(NODE8,U,7)),$P(Z,HLECH,8)=$$ENCHL7^IBCNEHLQ($P(NODE8,U,8))
S RXE="RXE"_HLFS_Z_HLFS_"1"_HLFS_$$ENCHL7^IBCNEHLQ(BGAS)_HLFS_HLFS_"1"_HLFS_HLFS_HLECH_$$ENCHL7^IBCNEHLQ($P(NODE8,U,4))
S $P(RXE,HLFS,11)=$$ENCHL7^IBCNEHLQ($P(NODE9,U,2))
S $P(RXE,HLFS,15)=$$GET1^DIQ(356.013,+$P(NODE8,U)_",",.01)_HLREP_$$GET1^DIQ(356.013,+$P(NODE8,U,2)_",",.01)
S $P(RXE,HLFS,17)=$$ENCHL7^IBCNEHLQ($P(NODE9,U,7))
S $P(RXE,HLFS,20)=$$ENCHL7^IBCNEHLQ($P(NODE8,U,6))
S $P(RXE,HLFS,24)=$$ENCHL7^IBCNEHLQ($P(NODE8,U,5))
S Z=+$P(NODE9,U,4) I Z>0 S OXYTST=$$GET1^DIQ(356.015,Z_",",.01)
S Z=+$P(NODE9,U,5) I Z>0 S OXYTST=$G(OXYTST)_HLREP_HLECH_HLECH_HLECH_$$GET1^DIQ(356.015,Z_",",.01)
S Z=+$P(NODE9,U,6) I Z>0 S OXYTST=$G(OXYTST)_HLREP_HLECH_HLECH_HLECH_$$GET1^DIQ(356.015,Z_",",.01)
S Z=$$GET1^DIQ(356.014,+$P(NODE9,U,3)_",",.01) I $G(OXYTST)'="" S $P(Z,HLECH,4)=OXYTST
S $P(RXE,HLFS,28)=Z
S $P(RXE,HLFS,30)=$$GET1^DIQ(356.016,+$P(NODE9,U,8)_",",.01)
S $P(RXE,HLFS,32)=$$GET1^DIQ(356.013,+$P(NODE8,U,3)_",",.01)
S HCT=HCT+1,^TMP("HLS",$J,HCT)=RXE
Q
;
PRB ; create PRB segment
N DATESTR,PRB,PROCSTR,Z
I $TR(NODE10,U)=""!(CERT="") Q
S PROCSTR=CERT
S Z=$P(NODE10,U,6) I Z'="" S $P(PROCSTR,HLECH,3)=Z
S Z=$P(NODE10,U,7) I Z'="" S $P(PROCSTR,HLECH,4)=$$EXTERNAL^DILFD(356.22,10.07,,Z)
S PRB="PRB"_HLFS_"UC"_HLFS_$$HLDATE^HLFNC(DT)_HLFS_PROCSTR_HLFS_"1"_HLFS_"CR6 2000E"_HLFS_HLFS_$$HLDATE^HLFNC($P(NODE10,U,8))
S PRB=PRB_HLFS_$$HLDATE^HLFNC($P(NODE10,U,5))_HLFS_$$HLDATE^HLFNC($P(NODE10,U,9))_HLFS_$$GET1^DIQ(356.017,+$P(NODE10,U,13)_",",.01)
S DATESTR="",Z=$P(NODE10,U,11) I Z'="" S DATESTR=HLECH_$$HLDATE^HLFNC(Z)
I DATESTR'="" S Z=$P(NODE10,U,12) S:Z'="" DATESTR=DATESTR_"-"_$$HLDATE^HLFNC(Z) S $P(PRB,HLFS,15)=DATESTR ; last admission date range
S $P(PRB,HLFS,16)=$$HLDATE^HLFNC($P(NODE10,U,10))
S $P(PRB,HLFS,17)=$$HLDATE^HLFNC($P(NODE10,U))
S DATESTR="",Z=$P(NODE10,U,2) I Z'="" S DATESTR=$$HLDATE^HLFNC(Z)
I DATESTR'="" S Z=$P(NODE10,U,3) S:Z'="" DATESTR=DATESTR_"-"_$$HLDATE^HLFNC(Z) S $P(PRB,HLFS,18)=DATESTR ; home health cert. date range
S $P(PRB,HLFS,23)=$$GET1^DIQ(356.004,+$P(NODE2,U,15)_",",.01)
S HCT=HCT+1,^TMP("HLS",$J,HCT)=PRB
Q
;
PSL ; create PSL segments
N NODE0,PSL,SEQ,Z,Z1
S SEQ=0,Z="" F S Z=$O(^IBT(356.22,IBTRIEN,11,"B",Z)) Q:Z="" D
.S Z1=+$O(^IBT(356.22,IBTRIEN,11,"B",Z,"")) I 'Z1 Q
.S NODE0=$G(^IBT(356.22,IBTRIEN,11,Z1,0)) I NODE0="" Q ; 0-node of sub-file 356.2211
.S SEQ=SEQ+1 I SEQ>10 Q
.S PSL="PSL"_HLFS_"PWK 2000E"_HLFS_HLFS_SEQ_HLFS_HLFS_HLFS_"1"_HLFS_"1"
.S $P(PSL,HLFS,20)=$$GET1^DIQ(356.018,+$P(NODE0,U)_",",.01)_HLECH_$$ENCHL7^IBCNEHLQ($P(NODE0,U,3))_HLECH_$$ENCHL7^IBCNEHLQ($P(NODE0,U,4))
.S $P(PSL,HLFS,21)=$P(NODE0,U,2)
.S $P(PSL,HLFS,22)="NA"
.S HCT=HCT+1,^TMP("HLS",$J,HCT)=PSL
.Q
Q
;
G3OPRD ; create G3O.PRD segments (G3O segment group)
N ADDR1,ADDR2,NODE0,PCODEPRV,PERSON,PRD,PRVDATA,PRVPTR,SEQ,TMP,Z
; create PRD segments for patient event providers
S (SEQ,Z)=0 F S Z=$O(^IBT(356.22,IBTRIEN,13,Z)) Q:Z=""!(Z?1.A) D
.S NODE0=$G(^IBT(356.22,IBTRIEN,13,Z,0)) I NODE0="" Q ; 0-node of sub-file 356.2213
.S SEQ=SEQ+1 I SEQ>14 Q ; only allow up to 14 providers
.S PRVPTR=$P(NODE0,U,3) I PRVPTR="" Q ; missing provider pointer
.S PERSON=$P(NODE0,U,2) I 'PERSON Q ; missing person / non-person indicator
.S PRVDATA=$$PRVDATA^IBTRHLO2(+$P(PRVPTR,";"),$P($P(PRVPTR,"(",2),","))
.S TMP=$$GET1^DIQ(365.022,+$P(NODE0,U)_",",.01)_HLECH_PERSON_HLECH_HLECH_"NM1 2010EA"
.S ADDR1=$P(PRVDATA,U,2,3),ADDR2=$P(PRVDATA,U,4,6)
.S PRD="PRD"_HLFS_TMP_HLFS_$$HLNAME^HLFNC($P(PRVDATA,U))_HLFS_$$ENCHL7^IBCNEHLQ($P($$HLADDR^HLFNC(ADDR1,ADDR2),HLECH,1,5))
.S $P(PRD,HLFS,8)=$P(PRVDATA,U,7)
.S HCT=HCT+1,^TMP("HLS",$J,HCT)=PRD
.; create PRD segment for X12 PRV segment
.S PCODEPRV=$$PCODECNV^IBTRHLO2($P(TMP,HLECH)) I PCODEPRV'="" D
..N XTAX
..S XTAX=$P($$GTXNMY^IBTRH3(PRVPTR),"^") ;11/24/15 only code, not description
..I XTAX="" Q
..S TMP=PCODEPRV_HLECH_HLECH_HLECH_"PRV 2010EA"
..S PRD="PRD"_HLFS_TMP
..S $P(PRD,HLFS,8)=XTAX
..S HCT=HCT+1,^TMP("HLS",$J,HCT)=PRD
..Q
.Q
; create PRD segments for patient event transport
I 'MSGTYPE S (SEQ,Z)=0 F S Z=$O(^IBT(356.22,IBTRIEN,14,Z)) Q:Z=""!(Z?1.A) D
.S NODE0=$G(^IBT(356.22,IBTRIEN,14,Z,0)) I NODE0="" Q ; 0-node of sub-file 356.2214
.S SEQ=SEQ+1 I SEQ>5 Q ; only allow up to 5 transports
.S TMP=$P(NODE0,U)_HLECH_HLECH_HLECH_"NM1 2010EB"
.S (ADDR1,ADDR2)=""
.I $P(NODE0,U,3)'="",$P(NODE0,U,5)'="" S ADDR1=$P(NODE0,U,3,4),ADDR2=$P(NODE0,U,5,7)
.S PRD="PRD"_HLFS_TMP_HLFS_$$ENCHL7^IBCNEHLQ($P(NODE0,U,2))_HLFS_$$ENCHL7^IBCNEHLQ($P($$HLADDR^HLFNC(ADDR1,ADDR2),HLECH,1,5))
.S HCT=HCT+1,^TMP("HLS",$J,HCT)=PRD
.Q
; create PRD segments for other UMO
I 'MSGTYPE S (SEQ,Z)=0 F S Z=$O(^IBT(356.22,IBTRIEN,15,Z)) Q:Z=""!(Z?1.A) D
.S NODE0=$G(^IBT(356.22,IBTRIEN,15,Z,0)) I NODE0="" Q ; 0-node of sub-file 356.2215
.S SEQ=SEQ+1 I SEQ>3 Q ; only allow up to 3 other UMOs
.S TMP=$P(NODE0,U)_HLECH_HLECH_HLECH_"NM1 2010EC"
.S PRD="PRD"_HLFS_TMP_HLFS_$$EXTERNAL^DILFD(356.2215,.02,,+$P(NODE0,U,2))
.S HCT=HCT+1,^TMP("HLS",$J,HCT)=PRD
.D G3OAUT
.Q
Q
;
G3OAUT ; create G3O.AUT segment (G3O segment group)
N AUT,R1,R2,R3,R4,Z
S R1=$P(NODE0,U,3),R2=$P(NODE0,U,4),R3=$P(NODE0,U,5),R4=$P(NODE0,U,6)
I R1="",R2="",R3="",R4="" Q ; no UMO denial reasons to send
S Z="" I R3'=""!(R4'="") S $P(Z,HLECH,2)=$$ENCHL7^IBCNEHLQ(R3),$P(Z,HLECH,5)=$$ENCHL7^IBCNEHLQ(R4)
S AUT="AUT"_HLFS_Z_HLFS_"REF 2010EC"_HLECH_$$ENCHL7^IBCNEHLQ(R1)_HLECH_HLECH_HLECH_$$ENCHL7^IBCNEHLQ(R2)
S HCT=HCT+1,^TMP("HLS",$J,HCT)=AUT
D G3OZTP
Q
;
G3OZTP ; create G3O.ZTP segment (G3O segment group)
N DATE,ZTP
S DATE=$P($P(NODE0,U,7),".") I DATE="" Q ; no date to send, date only 4/6/16
S ZTP="ZTP"_HLFS_HLFS_"598"_HLFS_$$HLDATE^HLFNC(DATE)_HLFS_"DTP 2010EC"
S HCT=HCT+1,^TMP("HLS",$J,HCT)=ZTP
Q
;
G5OPRB ; create G5O.PRB segments (G5O segment group)
N FQUAL,FTYPE,NODE160,PRB,REQCAT,Z1
S Z1="" F S Z1=$O(^IBT(356.22,IBTRIEN,16,Z1)) Q:Z1=""!(Z1?1.A) D
.S NODE160=$G(^IBT(356.22,IBTRIEN,16,Z1,0)) I NODE160="" Q ; 0-node of sub-file 356.2216
.S REQCAT=$$GET1^DIQ(356.001,+$P(NODE160,U,15)_",",.01)
.I REQCAT'="" D
..S REQCAT=$S(REQCAT="HS":"CO",REQCAT="SC":"AD",1:REQCAT)
..S PRB="PRB"_HLFS_REQCAT_HLFS_$$HLDATE^HLFNC(DT)
..S PRB=PRB_HLFS_$$GET1^DIQ(356.002,+$P(NODE160,U,2)_",",.01)_HLECH_$$GET1^DIQ(365.013,+$P(NODE160,U,3)_",",.01)
..S PRB=PRB_HLFS_"1"_HLFS_"UM 2000F"
..S FQUAL=$P(NODE160,U,4) I FQUAL'="" D
...S FTYPE=$S(FQUAL="A":$P(NODE160,U,6)_$P(NODE160,U,7),1:$$EXTERNAL^DILFD(356.2216,.05,,+$P(NODE160,U,5)))
...I FTYPE'="" S $P(PRB,HLFS,11)=$$ENCHL7^IBCNEHLQ(FTYPE)_HLECH_$P(NODE160,U,4)
...Q
..S HCT=HCT+1,^TMP("HLS",$J,HCT)=PRB
..Q
.D G5OAUT,G5OZTP,G5OPSL
.I 'MSGTYPE D G5OZHS,G5OPSL2,G5ONTE
.D G5OPRD
.Q
Q
;
G5OAUT ; create G5O.AUT segment (G5O segment group)
N AUT,NODE169,Z
S NODE169=$G(^IBT(356.22,IBTRIEN,16,Z1,9)) ; 9-node of sub-file 356.2216
S Z=""
I $P(NODE169,U)'="" S Z="REF 2000F"_HLECH_$P(NODE169,U),$P(Z,HLECH,5)="BB"
I Z="",$P(NODE169,U,2)'="" S Z="REF 2000F"_HLECH_$P(NODE169,U,2),$P(Z,HLECH,5)="NT"
I Z="" Q
S AUT="AUT"_HLFS_HLFS_Z
S HCT=HCT+1,^TMP("HLS",$J,HCT)=AUT
Q
;
G5OZTP ; create G5O.ZTP segment (G5O segment group)
N SRVDATE,ZTP
S SRVDATE=$P(NODE160,U,11) I SRVDATE="" Q
S ZTP="ZTP"_HLFS_HLFS_"472"_HLFS_$$HLDATE^HLFNC($P(SRVDATE,"."))_HLFS_"DTP 2000F"
S HCT=HCT+1,^TMP("HLS",$J,HCT)=ZTP
Q
;
G5OPSL ; create G5O.PSL segments (G5O segment group)
N NODE161,NODE162,NODE163,NODE1640,NODE1612,PSL,SEQ,SRVTYPE,TMP,Z2
S NODE161=$G(^IBT(356.22,IBTRIEN,16,Z1,1)) I NODE161="" Q ; 1-node of sub-file 356.2216
S NODE162=$G(^IBT(356.22,IBTRIEN,16,Z1,2)) ; 2-node of sub-file 356.2216
S NODE163=$G(^IBT(356.22,IBTRIEN,16,Z1,3)) ; 3-node of sub-file 356.2216
S NODE1612=$G(^IBT(356.22,IBTRIEN,16,Z1,12)) ; 12-node of sub-file 356.2216
S SRVTYPE=$P(NODE161,U,12),SEQ=1
S PSL="PSL"_HLFS_HLFS_HLFS_SEQ
S $P(PSL,HLFS,7)="P"
S TMP=$S(SRVTYPE="D":"AD",1:$P(NODE161,U))
S $P(TMP,HLECH,2)=$$ENCHL7^IBCNEHLQ($S(TMP="N4":$P(NODE1612,U),1:$$EXTERNAL^DILFD(356.2216,1.02,,$P(NODE161,U,2))))
S $P(TMP,HLECH,5)=$$ENCHL7^IBCNEHLQ($S(TMP="N4":$P(NODE1612,U,2),1:$$EXTERNAL^DILFD(356.2216,1.03,,$P(NODE161,U,3))))
S $P(PSL,HLFS,8)=TMP
I 'MSGTYPE D
.S TMP=$$ENCHL7^IBCNEHLQ($$EXTERNAL^DILFD(356.2216,1.04,,$P(NODE161,U,4)))_HLECH
.S TMP=TMP_$$ENCHL7^IBCNEHLQ($$EXTERNAL^DILFD(356.2216,1.05,,$P(NODE161,U,5)))_HLECH_HLECH
.S TMP=TMP_$$ENCHL7^IBCNEHLQ($$EXTERNAL^DILFD(356.2216,1.06,,$P(NODE161,U,6)))_HLECH
.S TMP=TMP_$$ENCHL7^IBCNEHLQ($$EXTERNAL^DILFD(356.2216,1.07,,$P(NODE161,U,7)))
.S $P(PSL,HLFS,9)=TMP
.S $P(PSL,HLFS,10)=$$ENCHL7^IBCNEHLQ($P(NODE161,U,8))
.Q
S $P(PSL,HLFS,13)=$$ENCHL7^IBCNEHLQ($P(NODE161,U,11))_HLECH_$P(NODE161,U,10)
I 'MSGTYPE S $P(PSL,HLFS,16)=$$ENCHL7^IBCNEHLQ($P(NODE161,U,9))
I SRVTYPE="I" D
.S $P(PSL,HLFS,2)="SV2 2000F"
.S $P(PSL,HLFS,14)=$$ENCHL7^IBCNEHLQ($P(NODE162,U,7))
.S $P(PSL,HLFS,18)=$$ENCHL7^IBCNEHLQ($$GET1^DIQ(399.2,+$P(NODE162,U,6)_",",.01))
.I 'MSGTYPE S $P(PSL,HLFS,47)=$$GET1^DIQ(356.011,+$P(NODE162,U,8)_",",.01)
.Q
S $P(PSL,HLFS,22)="NA"
I SRVTYPE="P" D
.S $P(PSL,HLFS,2)="SV1 2000F"
.I 'MSGTYPE D
..S TMP=$$ENCHL7^IBCNEHLQ($P(NODE162,U))_HLECH_$$ENCHL7^IBCNEHLQ($P(NODE162,U,2))_HLECH_HLECH
..S TMP=TMP_$$ENCHL7^IBCNEHLQ($P(NODE162,U,3))_HLECH_$$ENCHL7^IBCNEHLQ($P(NODE162,U,4))
..S $P(PSL,HLFS,23)=TMP
..S $P(PSL,HLFS,48)=$P(NODE162,U,5)
..Q
.Q
I SRVTYPE="I"!(SRVTYPE="P") S $P(PSL,HLFS,49)=$$GET1^DIQ(356.019,+$P(NODE162,U,9)_",",.01)
I SRVTYPE="D",$TR(NODE163,U)'="" D
.S $P(PSL,HLFS,2)="SV3 2000F"
.S $P(PSL,HLFS,18)=$$ENCHL7^IBCNEHLQ($P(NODE163,U,6))
.I 'MSGTYPE D
..S TMP="",$P(TMP,HLECH,9)=$$ENCHL7^IBCNEHLQ($P(NODE163,U,7))
..S $P(PSL,HLFS,23)=TMP
..Q
.S TMP=$P(NODE163,U)_HLECH_$P(NODE163,U,2)_HLECH_HLECH_$P(NODE163,U,3)_HLECH_$P(NODE163,U,4)
.S $P(TMP,HLECH,9)=$P(NODE163,U,5)
.S $P(PSL,HLFS,34)=TMP
.Q
S HCT=HCT+1,^TMP("HLS",$J,HCT)=PSL
; additional PSL segments for tooth information
I SRVTYPE="D" S Z2="" F S Z2=$O(^IBT(356.22,IBTRIEN,16,Z1,4,Z2)) Q:Z2=""!(Z2?1.A) D
.S NODE1640=$G(^IBT(356.22,IBTRIEN,16,Z1,4,Z2,0)) I NODE1640="" Q ; 0-node of sub-file 356.22164
.S PSL="PSL"_HLFS_"TOO 2000F"
.S SEQ=SEQ+1,$P(PSL,HLFS,4)=SEQ
.S $P(PSL,HLFS,7)="P"
.S $P(PSL,HLFS,8)="JP"_HLECH_$$ENCHL7^IBCNEHLQ($$GET1^DIQ(356.022,+$P(NODE1640,U)_",",.01))
.S $P(PSL,HLFS,22)="NA"
.S TMP=$P(NODE1640,U,2)
.I 'MSGTYPE D
..S TMP=TMP_HLECH_$P(NODE1640,U,3)_HLECH_HLECH_$P(NODE1640,U,4)_HLECH_$P(NODE1640,U,5)
..S $P(TMP,HLECH,9)=$P(NODE1640,U,6)
..Q
.S $P(PSL,HLFS,34)=TMP
.S HCT=HCT+1,^TMP("HLS",$J,HCT)=PSL
.Q
Q
;
G5OZHS ; create G5O.ZHS segment (G5O segment group)
N NODE165,ZHS
S NODE165=$G(^IBT(356.22,IBTRIEN,16,Z1,5)) I NODE165="" Q ; 5-node of sub-file 356.2216
S ZHS="ZHS"_HLFS_"HSD 2000F"_HLFS_$$GET1^DIQ(365.016,+$P(NODE165,U)_",",.01)_HLFS
S ZHS=ZHS_$$ENCHL7^IBCNEHLQ($P(NODE165,U,2))_HLFS_$P(NODE165,U,3)_HLFS_$$ENCHL7^IBCNEHLQ($P(NODE165,U,4))_HLFS
S ZHS=ZHS_$$GET1^DIQ(365.015,+$P(NODE165,U,5)_",",.01)_HLFS_$$ENCHL7^IBCNEHLQ($P(NODE165,U,6))_HLFS
S ZHS=ZHS_$$GET1^DIQ(365.025,+$P(NODE165,U,7)_",",.01)_HLFS_$$GET1^DIQ(356.007,+$P(NODE165,U,8)_",",.01)
I $TR($P(ZHS,HLFS,3,99),HLFS)="" Q
S HCT=HCT+1,^TMP("HLS",$J,HCT)=ZHS
Q
;
G5OPSL2 ; create 2nd group of G5O.PSL segments (G5O segment group)
N NODE1660,PSL,SEQ,Z2,Z3
S SEQ=0,Z2="" F S Z2=$O(^IBT(356.22,IBTRIEN,16,Z1,6,"B",Z2)) Q:Z2="" D
.S Z3=+$O(^IBT(356.22,IBTRIEN,16,Z1,6,"B",Z2,"")) I 'Z3 Q
.S NODE1660=$G(^IBT(356.22,IBTRIEN,16,Z1,6,Z3,0)) I NODE1660="" Q ; 0-node of sub-file 356.22166
.S SEQ=SEQ+1 I SEQ>10 Q
.S PSL="PSL"_HLFS_"PWK 2000F"_HLFS_HLFS_SEQ_HLFS_HLFS_HLFS_"P"_HLFS_"1"
.S $P(PSL,HLFS,20)=$$GET1^DIQ(356.018,+$P(NODE1660,U)_",",.01)_HLECH_$$ENCHL7^IBCNEHLQ($P(NODE1660,U,3))_HLECH_$$ENCHL7^IBCNEHLQ($P(NODE1660,U,4))
.S $P(PSL,HLFS,21)=$P(NODE1660,U,2)
.S $P(PSL,HLFS,22)="NA"
.S HCT=HCT+1,^TMP("HLS",$J,HCT)=PSL
.Q
Q
;
G5ONTE ; create G5O.NTE segment (G5O segment group)
N MSG,NTE
S MSG=$$WP2STR^IBTRHLO2(356.2216,7,Z1_","_IBTRIEN_",",264)
I MSG="" Q
S NTE="NTE"_HLFS_HLFS_HLFS_$$ENCHL7^IBCNEHLQ(MSG)_HLFS_"MSG 2000F"
S HCT=HCT+1,^TMP("HLS",$J,HCT)=NTE
Q
;
G5OPRD ; create G5O.PRD segments (G5O segment group)
N ADDR1,ADDR2,NODE1680,PCODEPRV,PERSON,PRD,PRVDATA,PRVPTR,SEQ,TMP,Z2,Z3
S SEQ=0,Z2="" F S Z2=$O(^IBT(356.22,IBTRIEN,16,Z1,8,"B",Z2)) Q:Z2="" D
.S Z3=+$O(^IBT(356.22,IBTRIEN,16,Z1,8,"B",Z2,"")) I 'Z3 Q
.S NODE1680=$G(^IBT(356.22,IBTRIEN,16,Z1,8,Z3,0)) I NODE1680="" Q ; 0-node of sub-file 356.22168
.S SEQ=SEQ+1 I SEQ>14 Q ; only allow up to 14 providers
.S PRVPTR=$P(NODE1680,U,3) I PRVPTR="" Q ; missing provider pointer
.S PERSON=$P(NODE1680,U,2) I 'PERSON Q ; missing person / non-person indicator
.S PRVDATA=$$PRVDATA^IBTRHLO2(+$P(PRVPTR,";"),$P($P(PRVPTR,"(",2),","))
.S TMP=$$GET1^DIQ(365.022,+$P(NODE1680,U)_",",.01)_HLECH_PERSON_HLECH_HLECH_"NM1 2010F"
.S ADDR1=$P(PRVDATA,U,2,3),ADDR2=$P(PRVDATA,U,4,6)
.S PRD="PRD"_HLFS_TMP_HLFS_$$HLNAME^HLFNC($P(PRVDATA,U))_HLFS_$$ENCHL7^IBCNEHLQ($P($$HLADDR^HLFNC(ADDR1,ADDR2),HLECH,1,5))
.S $P(PRD,HLFS,8)=$P(PRVDATA,U,7)
.S HCT=HCT+1,^TMP("HLS",$J,HCT)=PRD
.; create PRD segment for X12 PRV segment
.S PCODEPRV=$$PCODECNV^IBTRHLO2($P(TMP,HLECH)) I PCODEPRV'="" D
..I '$F(",AS,OP,OR,OT,PC,PE",","_PCODEPRV) Q
..N XTAX
..S XTAX=$P($$GTXNMY^IBTRH3(PRVPTR),"^") ;11/24/15 only code, not description
..I XTAX="" Q
..S TMP=PCODEPRV_HLECH_HLECH_HLECH_"PRV 2010F"
..S PRD="PRD"_HLFS_TMP
..S $P(PRD,HLFS,8)=XTAX_HLECH_"PXC"
..S HCT=HCT+1,^TMP("HLS",$J,HCT)=PRD
..Q
.Q
Q
;
OBR ; create OBR segment
N OBR,Z,Z1
I $TR(NODE18,U)="" Q
S OBR="OBR"
S $P(OBR,HLFS,5)="CR1 2000E"
S $P(OBR,HLFS,14)=$P(NODE18,U,4)
S $P(OBR,HLFS,19)=$$ENCHL7^IBCNEHLQ($P(NODE18,U,9))
S $P(OBR,HLFS,20)=$$ENCHL7^IBCNEHLQ($P(NODE18,U,10))
S Z1=""
S Z=$P(NODE18,U,2) I Z'="" S Z1=$$ENCHL7^IBCNEHLQ(Z)_HLECH_$P(NODE18,U)
S Z=$P(NODE18,U,6) I Z'="" S Z1=$G(Z1)_HLREP_$$ENCHL7^IBCNEHLQ(Z)_HLECH_$P(NODE18,U,5)
I Z1'="" S $P(OBR,HLFS,28)=Z1
S $P(OBR,HLFS,47)=$P(NODE18,U,3)
S HCT=HCT+1,^TMP("HLS",$J,HCT)=OBR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRHLO1 15987 printed Oct 16, 2024@18:29:06 Page 2
IBTRHLO1 ;ALB/YMG - Create and send 278 inquiry cont. ;30 Apr 2015 12:29 PM
+1 ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
AUT ; create AUT segment
+1 NEW AUT,Z
+2 SET Z=""
+3 IF $PIECE(NODE17,U)'=""
SET Z="REF 2000E"_HLECH_$PIECE(NODE17,U)
SET $PIECE(Z,HLECH,5)="BB"
+4 IF Z=""
IF $PIECE(NODE17,U,2)'=""
SET Z="REF 2000E"_HLECH_$PIECE(NODE17,U,2)
SET $PIECE(Z,HLECH,5)="NT"
+5 IF Z=""
QUIT
+6 SET AUT="AUT"_HLFS_HLFS_Z
+7 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=AUT
+8 QUIT
+9 ;
G2ORXA ; create G2O.RXA segment (G2O segment group)
+1 NEW RXA,SUBLSTR,TXNUM,TXCNT,Z
+2 ; missing treatment series number
SET TXNUM=$PIECE(NODE7,U,5)
IF TXNUM=""
QUIT
+3 ; missing treatment count
SET TXCNT=$PIECE(NODE7,U,6)
IF TXCNT=""
QUIT
+4 SET TXNUM=+TXNUM
SET TXCNT=+TXCNT
SET SUBLSTR=""
+5 SET Z=+$PIECE(NODE7,U,7)
IF Z>0
SET SUBLSTR=$$GET1^DIQ(356.012,Z_",",.01)
+6 SET Z=+$PIECE(NODE7,U,8)
IF Z>0
SET SUBLSTR=SUBLSTR_HLREP_$$GET1^DIQ(356.012,Z_",",.01)
+7 SET RXA="RXA"_HLFS_$$ENCHL7^IBCNEHLQ(TXNUM)_HLFS_$$ENCHL7^IBCNEHLQ(TXCNT)_HLFS_$$HLDATE^HLFNC(NOWDT)_HLFS_$$HLDATE^HLFNC(NOWDT)
+8 SET RXA=RXA_HLFS_"1"_HLFS_"0"_HLFS_HLFS_HLFS_SUBLSTR
+9 SET Z=$PIECE(NODE7,U,10)
SET $PIECE(RXA,HLFS,20)=$PIECE(NODE7,U,9)_$SELECT(Z'="":HLREP_Z,1:"")
+10 SET $PIECE(RXA,HLFS,21)=$PIECE(NODE7,U,13)
+11 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=RXA
+12 DO G2ONTE
+13 QUIT
+14 ;
G2ONTE ; create G2O.NTE segments (G2O segment group)
+1 NEW CMT,NTE,Z
+2 FOR Z=11:1:12
SET CMT=$PIECE(NODE7,U,Z)
IF CMT'=""
Begin DoDot:1
+3 SET NTE="NTE"_HLFS_HLFS_HLFS_$$ENCHL7^IBCNEHLQ(CMT)_HLFS_"CR2 2000E"
+4 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=NTE
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
RXE ; create RXE segment
+1 NEW BGAS,RXE,OXYTST,Z
+2 ; missing arterial blood gas quantity
SET BGAS=+$PIECE(NODE9,U)
IF 'BGAS
QUIT
+3 SET Z=$$ENCHL7^IBCNEHLQ($PIECE(NODE8,U,7))
SET $PIECE(Z,HLECH,8)=$$ENCHL7^IBCNEHLQ($PIECE(NODE8,U,8))
+4 SET RXE="RXE"_HLFS_Z_HLFS_"1"_HLFS_$$ENCHL7^IBCNEHLQ(BGAS)_HLFS_HLFS_"1"_HLFS_HLFS_HLECH_$$ENCHL7^IBCNEHLQ($PIECE(NODE8,U,4))
+5 SET $PIECE(RXE,HLFS,11)=$$ENCHL7^IBCNEHLQ($PIECE(NODE9,U,2))
+6 SET $PIECE(RXE,HLFS,15)=$$GET1^DIQ(356.013,+$PIECE(NODE8,U)_",",.01)_HLREP_$$GET1^DIQ(356.013,+$PIECE(NODE8,U,2)_",",.01)
+7 SET $PIECE(RXE,HLFS,17)=$$ENCHL7^IBCNEHLQ($PIECE(NODE9,U,7))
+8 SET $PIECE(RXE,HLFS,20)=$$ENCHL7^IBCNEHLQ($PIECE(NODE8,U,6))
+9 SET $PIECE(RXE,HLFS,24)=$$ENCHL7^IBCNEHLQ($PIECE(NODE8,U,5))
+10 SET Z=+$PIECE(NODE9,U,4)
IF Z>0
SET OXYTST=$$GET1^DIQ(356.015,Z_",",.01)
+11 SET Z=+$PIECE(NODE9,U,5)
IF Z>0
SET OXYTST=$GET(OXYTST)_HLREP_HLECH_HLECH_HLECH_$$GET1^DIQ(356.015,Z_",",.01)
+12 SET Z=+$PIECE(NODE9,U,6)
IF Z>0
SET OXYTST=$GET(OXYTST)_HLREP_HLECH_HLECH_HLECH_$$GET1^DIQ(356.015,Z_",",.01)
+13 SET Z=$$GET1^DIQ(356.014,+$PIECE(NODE9,U,3)_",",.01)
IF $GET(OXYTST)'=""
SET $PIECE(Z,HLECH,4)=OXYTST
+14 SET $PIECE(RXE,HLFS,28)=Z
+15 SET $PIECE(RXE,HLFS,30)=$$GET1^DIQ(356.016,+$PIECE(NODE9,U,8)_",",.01)
+16 SET $PIECE(RXE,HLFS,32)=$$GET1^DIQ(356.013,+$PIECE(NODE8,U,3)_",",.01)
+17 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=RXE
+18 QUIT
+19 ;
PRB ; create PRB segment
+1 NEW DATESTR,PRB,PROCSTR,Z
+2 IF $TRANSLATE(NODE10,U)=""!(CERT="")
QUIT
+3 SET PROCSTR=CERT
+4 SET Z=$PIECE(NODE10,U,6)
IF Z'=""
SET $PIECE(PROCSTR,HLECH,3)=Z
+5 SET Z=$PIECE(NODE10,U,7)
IF Z'=""
SET $PIECE(PROCSTR,HLECH,4)=$$EXTERNAL^DILFD(356.22,10.07,,Z)
+6 SET PRB="PRB"_HLFS_"UC"_HLFS_$$HLDATE^HLFNC(DT)_HLFS_PROCSTR_HLFS_"1"_HLFS_"CR6 2000E"_HLFS_HLFS_$$HLDATE^HLFNC($PIECE(NODE10,U,8))
+7 SET PRB=PRB_HLFS_$$HLDATE^HLFNC($PIECE(NODE10,U,5))_HLFS_$$HLDATE^HLFNC($PIECE(NODE10,U,9))_HLFS_$$GET1^DIQ(356.017,+$PIECE(NODE10,U,13)_",",.01)
+8 SET DATESTR=""
SET Z=$PIECE(NODE10,U,11)
IF Z'=""
SET DATESTR=HLECH_$$HLDATE^HLFNC(Z)
+9 ; last admission date range
IF DATESTR'=""
SET Z=$PIECE(NODE10,U,12)
if Z'=""
SET DATESTR=DATESTR_"-"_$$HLDATE^HLFNC(Z)
SET $PIECE(PRB,HLFS,15)=DATESTR
+10 SET $PIECE(PRB,HLFS,16)=$$HLDATE^HLFNC($PIECE(NODE10,U,10))
+11 SET $PIECE(PRB,HLFS,17)=$$HLDATE^HLFNC($PIECE(NODE10,U))
+12 SET DATESTR=""
SET Z=$PIECE(NODE10,U,2)
IF Z'=""
SET DATESTR=$$HLDATE^HLFNC(Z)
+13 ; home health cert. date range
IF DATESTR'=""
SET Z=$PIECE(NODE10,U,3)
if Z'=""
SET DATESTR=DATESTR_"-"_$$HLDATE^HLFNC(Z)
SET $PIECE(PRB,HLFS,18)=DATESTR
+14 SET $PIECE(PRB,HLFS,23)=$$GET1^DIQ(356.004,+$PIECE(NODE2,U,15)_",",.01)
+15 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PRB
+16 QUIT
+17 ;
PSL ; create PSL segments
+1 NEW NODE0,PSL,SEQ,Z,Z1
+2 SET SEQ=0
SET Z=""
FOR
SET Z=$ORDER(^IBT(356.22,IBTRIEN,11,"B",Z))
if Z=""
QUIT
Begin DoDot:1
+3 SET Z1=+$ORDER(^IBT(356.22,IBTRIEN,11,"B",Z,""))
IF 'Z1
QUIT
+4 ; 0-node of sub-file 356.2211
SET NODE0=$GET(^IBT(356.22,IBTRIEN,11,Z1,0))
IF NODE0=""
QUIT
+5 SET SEQ=SEQ+1
IF SEQ>10
QUIT
+6 SET PSL="PSL"_HLFS_"PWK 2000E"_HLFS_HLFS_SEQ_HLFS_HLFS_HLFS_"1"_HLFS_"1"
+7 SET $PIECE(PSL,HLFS,20)=$$GET1^DIQ(356.018,+$PIECE(NODE0,U)_",",.01)_HLECH_$$ENCHL7^IBCNEHLQ($PIECE(NODE0,U,3))_HLECH_$$ENCHL7^IBCNEHLQ($PIECE(NODE0,U,4))
+8 SET $PIECE(PSL,HLFS,21)=$PIECE(NODE0,U,2)
+9 SET $PIECE(PSL,HLFS,22)="NA"
+10 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PSL
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
G3OPRD ; create G3O.PRD segments (G3O segment group)
+1 NEW ADDR1,ADDR2,NODE0,PCODEPRV,PERSON,PRD,PRVDATA,PRVPTR,SEQ,TMP,Z
+2 ; create PRD segments for patient event providers
+3 SET (SEQ,Z)=0
FOR
SET Z=$ORDER(^IBT(356.22,IBTRIEN,13,Z))
if Z=""!(Z?1.A)
QUIT
Begin DoDot:1
+4 ; 0-node of sub-file 356.2213
SET NODE0=$GET(^IBT(356.22,IBTRIEN,13,Z,0))
IF NODE0=""
QUIT
+5 ; only allow up to 14 providers
SET SEQ=SEQ+1
IF SEQ>14
QUIT
+6 ; missing provider pointer
SET PRVPTR=$PIECE(NODE0,U,3)
IF PRVPTR=""
QUIT
+7 ; missing person / non-person indicator
SET PERSON=$PIECE(NODE0,U,2)
IF 'PERSON
QUIT
+8 SET PRVDATA=$$PRVDATA^IBTRHLO2(+$PIECE(PRVPTR,";"),$PIECE($PIECE(PRVPTR,"(",2),","))
+9 SET TMP=$$GET1^DIQ(365.022,+$PIECE(NODE0,U)_",",.01)_HLECH_PERSON_HLECH_HLECH_"NM1 2010EA"
+10 SET ADDR1=$PIECE(PRVDATA,U,2,3)
SET ADDR2=$PIECE(PRVDATA,U,4,6)
+11 SET PRD="PRD"_HLFS_TMP_HLFS_$$HLNAME^HLFNC($PIECE(PRVDATA,U))_HLFS_$$ENCHL7^IBCNEHLQ($PIECE($$HLADDR^HLFNC(ADDR1,ADDR2),HLECH,1,5))
+12 SET $PIECE(PRD,HLFS,8)=$PIECE(PRVDATA,U,7)
+13 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PRD
+14 ; create PRD segment for X12 PRV segment
+15 SET PCODEPRV=$$PCODECNV^IBTRHLO2($PIECE(TMP,HLECH))
IF PCODEPRV'=""
Begin DoDot:2
+16 NEW XTAX
+17 ;11/24/15 only code, not description
SET XTAX=$PIECE($$GTXNMY^IBTRH3(PRVPTR),"^")
+18 IF XTAX=""
QUIT
+19 SET TMP=PCODEPRV_HLECH_HLECH_HLECH_"PRV 2010EA"
+20 SET PRD="PRD"_HLFS_TMP
+21 SET $PIECE(PRD,HLFS,8)=XTAX
+22 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PRD
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 ; create PRD segments for patient event transport
+26 IF 'MSGTYPE
SET (SEQ,Z)=0
FOR
SET Z=$ORDER(^IBT(356.22,IBTRIEN,14,Z))
if Z=""!(Z?1.A)
QUIT
Begin DoDot:1
+27 ; 0-node of sub-file 356.2214
SET NODE0=$GET(^IBT(356.22,IBTRIEN,14,Z,0))
IF NODE0=""
QUIT
+28 ; only allow up to 5 transports
SET SEQ=SEQ+1
IF SEQ>5
QUIT
+29 SET TMP=$PIECE(NODE0,U)_HLECH_HLECH_HLECH_"NM1 2010EB"
+30 SET (ADDR1,ADDR2)=""
+31 IF $PIECE(NODE0,U,3)'=""
IF $PIECE(NODE0,U,5)'=""
SET ADDR1=$PIECE(NODE0,U,3,4)
SET ADDR2=$PIECE(NODE0,U,5,7)
+32 SET PRD="PRD"_HLFS_TMP_HLFS_$$ENCHL7^IBCNEHLQ($PIECE(NODE0,U,2))_HLFS_$$ENCHL7^IBCNEHLQ($PIECE($$HLADDR^HLFNC(ADDR1,ADDR2),HLECH,1,5))
+33 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PRD
+34 QUIT
End DoDot:1
+35 ; create PRD segments for other UMO
+36 IF 'MSGTYPE
SET (SEQ,Z)=0
FOR
SET Z=$ORDER(^IBT(356.22,IBTRIEN,15,Z))
if Z=""!(Z?1.A)
QUIT
Begin DoDot:1
+37 ; 0-node of sub-file 356.2215
SET NODE0=$GET(^IBT(356.22,IBTRIEN,15,Z,0))
IF NODE0=""
QUIT
+38 ; only allow up to 3 other UMOs
SET SEQ=SEQ+1
IF SEQ>3
QUIT
+39 SET TMP=$PIECE(NODE0,U)_HLECH_HLECH_HLECH_"NM1 2010EC"
+40 SET PRD="PRD"_HLFS_TMP_HLFS_$$EXTERNAL^DILFD(356.2215,.02,,+$PIECE(NODE0,U,2))
+41 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PRD
+42 DO G3OAUT
+43 QUIT
End DoDot:1
+44 QUIT
+45 ;
G3OAUT ; create G3O.AUT segment (G3O segment group)
+1 NEW AUT,R1,R2,R3,R4,Z
+2 SET R1=$PIECE(NODE0,U,3)
SET R2=$PIECE(NODE0,U,4)
SET R3=$PIECE(NODE0,U,5)
SET R4=$PIECE(NODE0,U,6)
+3 ; no UMO denial reasons to send
IF R1=""
IF R2=""
IF R3=""
IF R4=""
QUIT
+4 SET Z=""
IF R3'=""!(R4'="")
SET $PIECE(Z,HLECH,2)=$$ENCHL7^IBCNEHLQ(R3)
SET $PIECE(Z,HLECH,5)=$$ENCHL7^IBCNEHLQ(R4)
+5 SET AUT="AUT"_HLFS_Z_HLFS_"REF 2010EC"_HLECH_$$ENCHL7^IBCNEHLQ(R1)_HLECH_HLECH_HLECH_$$ENCHL7^IBCNEHLQ(R2)
+6 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=AUT
+7 DO G3OZTP
+8 QUIT
+9 ;
G3OZTP ; create G3O.ZTP segment (G3O segment group)
+1 NEW DATE,ZTP
+2 ; no date to send, date only 4/6/16
SET DATE=$PIECE($PIECE(NODE0,U,7),".")
IF DATE=""
QUIT
+3 SET ZTP="ZTP"_HLFS_HLFS_"598"_HLFS_$$HLDATE^HLFNC(DATE)_HLFS_"DTP 2010EC"
+4 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=ZTP
+5 QUIT
+6 ;
G5OPRB ; create G5O.PRB segments (G5O segment group)
+1 NEW FQUAL,FTYPE,NODE160,PRB,REQCAT,Z1
+2 SET Z1=""
FOR
SET Z1=$ORDER(^IBT(356.22,IBTRIEN,16,Z1))
if Z1=""!(Z1?1.A)
QUIT
Begin DoDot:1
+3 ; 0-node of sub-file 356.2216
SET NODE160=$GET(^IBT(356.22,IBTRIEN,16,Z1,0))
IF NODE160=""
QUIT
+4 SET REQCAT=$$GET1^DIQ(356.001,+$PIECE(NODE160,U,15)_",",.01)
+5 IF REQCAT'=""
Begin DoDot:2
+6 SET REQCAT=$SELECT(REQCAT="HS":"CO",REQCAT="SC":"AD",1:REQCAT)
+7 SET PRB="PRB"_HLFS_REQCAT_HLFS_$$HLDATE^HLFNC(DT)
+8 SET PRB=PRB_HLFS_$$GET1^DIQ(356.002,+$PIECE(NODE160,U,2)_",",.01)_HLECH_$$GET1^DIQ(365.013,+$PIECE(NODE160,U,3)_",",.01)
+9 SET PRB=PRB_HLFS_"1"_HLFS_"UM 2000F"
+10 SET FQUAL=$PIECE(NODE160,U,4)
IF FQUAL'=""
Begin DoDot:3
+11 SET FTYPE=$SELECT(FQUAL="A":$PIECE(NODE160,U,6)_$PIECE(NODE160,U,7),1:$$EXTERNAL^DILFD(356.2216,.05,,+$PIECE(NODE160,U,5)))
+12 IF FTYPE'=""
SET $PIECE(PRB,HLFS,11)=$$ENCHL7^IBCNEHLQ(FTYPE)_HLECH_$PIECE(NODE160,U,4)
+13 QUIT
End DoDot:3
+14 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PRB
+15 QUIT
End DoDot:2
+16 DO G5OAUT
DO G5OZTP
DO G5OPSL
+17 IF 'MSGTYPE
DO G5OZHS
DO G5OPSL2
DO G5ONTE
+18 DO G5OPRD
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
G5OAUT ; create G5O.AUT segment (G5O segment group)
+1 NEW AUT,NODE169,Z
+2 ; 9-node of sub-file 356.2216
SET NODE169=$GET(^IBT(356.22,IBTRIEN,16,Z1,9))
+3 SET Z=""
+4 IF $PIECE(NODE169,U)'=""
SET Z="REF 2000F"_HLECH_$PIECE(NODE169,U)
SET $PIECE(Z,HLECH,5)="BB"
+5 IF Z=""
IF $PIECE(NODE169,U,2)'=""
SET Z="REF 2000F"_HLECH_$PIECE(NODE169,U,2)
SET $PIECE(Z,HLECH,5)="NT"
+6 IF Z=""
QUIT
+7 SET AUT="AUT"_HLFS_HLFS_Z
+8 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=AUT
+9 QUIT
+10 ;
G5OZTP ; create G5O.ZTP segment (G5O segment group)
+1 NEW SRVDATE,ZTP
+2 SET SRVDATE=$PIECE(NODE160,U,11)
IF SRVDATE=""
QUIT
+3 SET ZTP="ZTP"_HLFS_HLFS_"472"_HLFS_$$HLDATE^HLFNC($PIECE(SRVDATE,"."))_HLFS_"DTP 2000F"
+4 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=ZTP
+5 QUIT
+6 ;
G5OPSL ; create G5O.PSL segments (G5O segment group)
+1 NEW NODE161,NODE162,NODE163,NODE1640,NODE1612,PSL,SEQ,SRVTYPE,TMP,Z2
+2 ; 1-node of sub-file 356.2216
SET NODE161=$GET(^IBT(356.22,IBTRIEN,16,Z1,1))
IF NODE161=""
QUIT
+3 ; 2-node of sub-file 356.2216
SET NODE162=$GET(^IBT(356.22,IBTRIEN,16,Z1,2))
+4 ; 3-node of sub-file 356.2216
SET NODE163=$GET(^IBT(356.22,IBTRIEN,16,Z1,3))
+5 ; 12-node of sub-file 356.2216
SET NODE1612=$GET(^IBT(356.22,IBTRIEN,16,Z1,12))
+6 SET SRVTYPE=$PIECE(NODE161,U,12)
SET SEQ=1
+7 SET PSL="PSL"_HLFS_HLFS_HLFS_SEQ
+8 SET $PIECE(PSL,HLFS,7)="P"
+9 SET TMP=$SELECT(SRVTYPE="D":"AD",1:$PIECE(NODE161,U))
+10 SET $PIECE(TMP,HLECH,2)=$$ENCHL7^IBCNEHLQ($SELECT(TMP="N4":$PIECE(NODE1612,U),1:$$EXTERNAL^DILFD(356.2216,1.02,,$PIECE(NODE161,U,2))))
+11 SET $PIECE(TMP,HLECH,5)=$$ENCHL7^IBCNEHLQ($SELECT(TMP="N4":$PIECE(NODE1612,U,2),1:$$EXTERNAL^DILFD(356.2216,1.03,,$PIECE(NODE161,U,3))))
+12 SET $PIECE(PSL,HLFS,8)=TMP
+13 IF 'MSGTYPE
Begin DoDot:1
+14 SET TMP=$$ENCHL7^IBCNEHLQ($$EXTERNAL^DILFD(356.2216,1.04,,$PIECE(NODE161,U,4)))_HLECH
+15 SET TMP=TMP_$$ENCHL7^IBCNEHLQ($$EXTERNAL^DILFD(356.2216,1.05,,$PIECE(NODE161,U,5)))_HLECH_HLECH
+16 SET TMP=TMP_$$ENCHL7^IBCNEHLQ($$EXTERNAL^DILFD(356.2216,1.06,,$PIECE(NODE161,U,6)))_HLECH
+17 SET TMP=TMP_$$ENCHL7^IBCNEHLQ($$EXTERNAL^DILFD(356.2216,1.07,,$PIECE(NODE161,U,7)))
+18 SET $PIECE(PSL,HLFS,9)=TMP
+19 SET $PIECE(PSL,HLFS,10)=$$ENCHL7^IBCNEHLQ($PIECE(NODE161,U,8))
+20 QUIT
End DoDot:1
+21 SET $PIECE(PSL,HLFS,13)=$$ENCHL7^IBCNEHLQ($PIECE(NODE161,U,11))_HLECH_$PIECE(NODE161,U,10)
+22 IF 'MSGTYPE
SET $PIECE(PSL,HLFS,16)=$$ENCHL7^IBCNEHLQ($PIECE(NODE161,U,9))
+23 IF SRVTYPE="I"
Begin DoDot:1
+24 SET $PIECE(PSL,HLFS,2)="SV2 2000F"
+25 SET $PIECE(PSL,HLFS,14)=$$ENCHL7^IBCNEHLQ($PIECE(NODE162,U,7))
+26 SET $PIECE(PSL,HLFS,18)=$$ENCHL7^IBCNEHLQ($$GET1^DIQ(399.2,+$PIECE(NODE162,U,6)_",",.01))
+27 IF 'MSGTYPE
SET $PIECE(PSL,HLFS,47)=$$GET1^DIQ(356.011,+$PIECE(NODE162,U,8)_",",.01)
+28 QUIT
End DoDot:1
+29 SET $PIECE(PSL,HLFS,22)="NA"
+30 IF SRVTYPE="P"
Begin DoDot:1
+31 SET $PIECE(PSL,HLFS,2)="SV1 2000F"
+32 IF 'MSGTYPE
Begin DoDot:2
+33 SET TMP=$$ENCHL7^IBCNEHLQ($PIECE(NODE162,U))_HLECH_$$ENCHL7^IBCNEHLQ($PIECE(NODE162,U,2))_HLECH_HLECH
+34 SET TMP=TMP_$$ENCHL7^IBCNEHLQ($PIECE(NODE162,U,3))_HLECH_$$ENCHL7^IBCNEHLQ($PIECE(NODE162,U,4))
+35 SET $PIECE(PSL,HLFS,23)=TMP
+36 SET $PIECE(PSL,HLFS,48)=$PIECE(NODE162,U,5)
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
+39 IF SRVTYPE="I"!(SRVTYPE="P")
SET $PIECE(PSL,HLFS,49)=$$GET1^DIQ(356.019,+$PIECE(NODE162,U,9)_",",.01)
+40 IF SRVTYPE="D"
IF $TRANSLATE(NODE163,U)'=""
Begin DoDot:1
+41 SET $PIECE(PSL,HLFS,2)="SV3 2000F"
+42 SET $PIECE(PSL,HLFS,18)=$$ENCHL7^IBCNEHLQ($PIECE(NODE163,U,6))
+43 IF 'MSGTYPE
Begin DoDot:2
+44 SET TMP=""
SET $PIECE(TMP,HLECH,9)=$$ENCHL7^IBCNEHLQ($PIECE(NODE163,U,7))
+45 SET $PIECE(PSL,HLFS,23)=TMP
+46 QUIT
End DoDot:2
+47 SET TMP=$PIECE(NODE163,U)_HLECH_$PIECE(NODE163,U,2)_HLECH_HLECH_$PIECE(NODE163,U,3)_HLECH_$PIECE(NODE163,U,4)
+48 SET $PIECE(TMP,HLECH,9)=$PIECE(NODE163,U,5)
+49 SET $PIECE(PSL,HLFS,34)=TMP
+50 QUIT
End DoDot:1
+51 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PSL
+52 ; additional PSL segments for tooth information
+53 IF SRVTYPE="D"
SET Z2=""
FOR
SET Z2=$ORDER(^IBT(356.22,IBTRIEN,16,Z1,4,Z2))
if Z2=""!(Z2?1.A)
QUIT
Begin DoDot:1
+54 ; 0-node of sub-file 356.22164
SET NODE1640=$GET(^IBT(356.22,IBTRIEN,16,Z1,4,Z2,0))
IF NODE1640=""
QUIT
+55 SET PSL="PSL"_HLFS_"TOO 2000F"
+56 SET SEQ=SEQ+1
SET $PIECE(PSL,HLFS,4)=SEQ
+57 SET $PIECE(PSL,HLFS,7)="P"
+58 SET $PIECE(PSL,HLFS,8)="JP"_HLECH_$$ENCHL7^IBCNEHLQ($$GET1^DIQ(356.022,+$PIECE(NODE1640,U)_",",.01))
+59 SET $PIECE(PSL,HLFS,22)="NA"
+60 SET TMP=$PIECE(NODE1640,U,2)
+61 IF 'MSGTYPE
Begin DoDot:2
+62 SET TMP=TMP_HLECH_$PIECE(NODE1640,U,3)_HLECH_HLECH_$PIECE(NODE1640,U,4)_HLECH_$PIECE(NODE1640,U,5)
+63 SET $PIECE(TMP,HLECH,9)=$PIECE(NODE1640,U,6)
+64 QUIT
End DoDot:2
+65 SET $PIECE(PSL,HLFS,34)=TMP
+66 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PSL
+67 QUIT
End DoDot:1
+68 QUIT
+69 ;
G5OZHS ; create G5O.ZHS segment (G5O segment group)
+1 NEW NODE165,ZHS
+2 ; 5-node of sub-file 356.2216
SET NODE165=$GET(^IBT(356.22,IBTRIEN,16,Z1,5))
IF NODE165=""
QUIT
+3 SET ZHS="ZHS"_HLFS_"HSD 2000F"_HLFS_$$GET1^DIQ(365.016,+$PIECE(NODE165,U)_",",.01)_HLFS
+4 SET ZHS=ZHS_$$ENCHL7^IBCNEHLQ($PIECE(NODE165,U,2))_HLFS_$PIECE(NODE165,U,3)_HLFS_$$ENCHL7^IBCNEHLQ($PIECE(NODE165,U,4))_HLFS
+5 SET ZHS=ZHS_$$GET1^DIQ(365.015,+$PIECE(NODE165,U,5)_",",.01)_HLFS_$$ENCHL7^IBCNEHLQ($PIECE(NODE165,U,6))_HLFS
+6 SET ZHS=ZHS_$$GET1^DIQ(365.025,+$PIECE(NODE165,U,7)_",",.01)_HLFS_$$GET1^DIQ(356.007,+$PIECE(NODE165,U,8)_",",.01)
+7 IF $TRANSLATE($PIECE(ZHS,HLFS,3,99),HLFS)=""
QUIT
+8 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=ZHS
+9 QUIT
+10 ;
G5OPSL2 ; create 2nd group of G5O.PSL segments (G5O segment group)
+1 NEW NODE1660,PSL,SEQ,Z2,Z3
+2 SET SEQ=0
SET Z2=""
FOR
SET Z2=$ORDER(^IBT(356.22,IBTRIEN,16,Z1,6,"B",Z2))
if Z2=""
QUIT
Begin DoDot:1
+3 SET Z3=+$ORDER(^IBT(356.22,IBTRIEN,16,Z1,6,"B",Z2,""))
IF 'Z3
QUIT
+4 ; 0-node of sub-file 356.22166
SET NODE1660=$GET(^IBT(356.22,IBTRIEN,16,Z1,6,Z3,0))
IF NODE1660=""
QUIT
+5 SET SEQ=SEQ+1
IF SEQ>10
QUIT
+6 SET PSL="PSL"_HLFS_"PWK 2000F"_HLFS_HLFS_SEQ_HLFS_HLFS_HLFS_"P"_HLFS_"1"
+7 SET $PIECE(PSL,HLFS,20)=$$GET1^DIQ(356.018,+$PIECE(NODE1660,U)_",",.01)_HLECH_$$ENCHL7^IBCNEHLQ($PIECE(NODE1660,U,3))_HLECH_$$ENCHL7^IBCNEHLQ($PIECE(NODE1660,U,4))
+8 SET $PIECE(PSL,HLFS,21)=$PIECE(NODE1660,U,2)
+9 SET $PIECE(PSL,HLFS,22)="NA"
+10 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PSL
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
G5ONTE ; create G5O.NTE segment (G5O segment group)
+1 NEW MSG,NTE
+2 SET MSG=$$WP2STR^IBTRHLO2(356.2216,7,Z1_","_IBTRIEN_",",264)
+3 IF MSG=""
QUIT
+4 SET NTE="NTE"_HLFS_HLFS_HLFS_$$ENCHL7^IBCNEHLQ(MSG)_HLFS_"MSG 2000F"
+5 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=NTE
+6 QUIT
+7 ;
G5OPRD ; create G5O.PRD segments (G5O segment group)
+1 NEW ADDR1,ADDR2,NODE1680,PCODEPRV,PERSON,PRD,PRVDATA,PRVPTR,SEQ,TMP,Z2,Z3
+2 SET SEQ=0
SET Z2=""
FOR
SET Z2=$ORDER(^IBT(356.22,IBTRIEN,16,Z1,8,"B",Z2))
if Z2=""
QUIT
Begin DoDot:1
+3 SET Z3=+$ORDER(^IBT(356.22,IBTRIEN,16,Z1,8,"B",Z2,""))
IF 'Z3
QUIT
+4 ; 0-node of sub-file 356.22168
SET NODE1680=$GET(^IBT(356.22,IBTRIEN,16,Z1,8,Z3,0))
IF NODE1680=""
QUIT
+5 ; only allow up to 14 providers
SET SEQ=SEQ+1
IF SEQ>14
QUIT
+6 ; missing provider pointer
SET PRVPTR=$PIECE(NODE1680,U,3)
IF PRVPTR=""
QUIT
+7 ; missing person / non-person indicator
SET PERSON=$PIECE(NODE1680,U,2)
IF 'PERSON
QUIT
+8 SET PRVDATA=$$PRVDATA^IBTRHLO2(+$PIECE(PRVPTR,";"),$PIECE($PIECE(PRVPTR,"(",2),","))
+9 SET TMP=$$GET1^DIQ(365.022,+$PIECE(NODE1680,U)_",",.01)_HLECH_PERSON_HLECH_HLECH_"NM1 2010F"
+10 SET ADDR1=$PIECE(PRVDATA,U,2,3)
SET ADDR2=$PIECE(PRVDATA,U,4,6)
+11 SET PRD="PRD"_HLFS_TMP_HLFS_$$HLNAME^HLFNC($PIECE(PRVDATA,U))_HLFS_$$ENCHL7^IBCNEHLQ($PIECE($$HLADDR^HLFNC(ADDR1,ADDR2),HLECH,1,5))
+12 SET $PIECE(PRD,HLFS,8)=$PIECE(PRVDATA,U,7)
+13 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PRD
+14 ; create PRD segment for X12 PRV segment
+15 SET PCODEPRV=$$PCODECNV^IBTRHLO2($PIECE(TMP,HLECH))
IF PCODEPRV'=""
Begin DoDot:2
+16 IF '$FIND(",AS,OP,OR,OT,PC,PE",","_PCODEPRV)
QUIT
+17 NEW XTAX
+18 ;11/24/15 only code, not description
SET XTAX=$PIECE($$GTXNMY^IBTRH3(PRVPTR),"^")
+19 IF XTAX=""
QUIT
+20 SET TMP=PCODEPRV_HLECH_HLECH_HLECH_"PRV 2010F"
+21 SET PRD="PRD"_HLFS_TMP
+22 SET $PIECE(PRD,HLFS,8)=XTAX_HLECH_"PXC"
+23 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=PRD
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;
OBR ; create OBR segment
+1 NEW OBR,Z,Z1
+2 IF $TRANSLATE(NODE18,U)=""
QUIT
+3 SET OBR="OBR"
+4 SET $PIECE(OBR,HLFS,5)="CR1 2000E"
+5 SET $PIECE(OBR,HLFS,14)=$PIECE(NODE18,U,4)
+6 SET $PIECE(OBR,HLFS,19)=$$ENCHL7^IBCNEHLQ($PIECE(NODE18,U,9))
+7 SET $PIECE(OBR,HLFS,20)=$$ENCHL7^IBCNEHLQ($PIECE(NODE18,U,10))
+8 SET Z1=""
+9 SET Z=$PIECE(NODE18,U,2)
IF Z'=""
SET Z1=$$ENCHL7^IBCNEHLQ(Z)_HLECH_$PIECE(NODE18,U)
+10 SET Z=$PIECE(NODE18,U,6)
IF Z'=""
SET Z1=$GET(Z1)_HLREP_$$ENCHL7^IBCNEHLQ(Z)_HLECH_$PIECE(NODE18,U,5)
+11 IF Z1'=""
SET $PIECE(OBR,HLFS,28)=Z1
+12 SET $PIECE(OBR,HLFS,47)=$PIECE(NODE18,U,3)
+13 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=OBR
+14 QUIT
