LREPI1A ;VA/DALOI/SED-EMERGING PATHOGENS HL7 BUILDER ; 17-Oct-2014 09:22 ; MKK
;;5.2;LAB SERVICE;**175,260,315,1031,1034**;NOV 1, 1997;Build 188
;
; Reference to ^ICD9 supported by IA #10082
; Reference to ^XLFSTR supported by IA #10104
;
EN(LRDFN,SS,IVDT,SEQ) ;Entry to build the HL7 Segment
;LRDFN=Patient ID
;SS=Subscripts in file 63 for results
;IVDT=Inverted Date and Time
;SEQ=Sequence Number
;S LRCS=$E(HL("ECH"))
K ^TMP("HL7",$J)
S:+$G(SEQ)'>0 SEQ=1
S CNT=1
Q:'$G(LRDFN)!('$G(IVDT))!('$L($G(SS)))
I $L($T(@SS)) D @SS
EXIT ;KILL THEN EXIT
K CNT,IND,LRAND,LRANT,LRDATA,LRES,LRINLT,LRNT,LRRDTE,LRREF,LRTST,LRUNIT
K ND,NLT,NLTP,ORGNB,ORGPT,SEQX,SITE,TYPE
Q SEQ
CY ;BUILD HL7 MSG FOR CY SUBSCRIPT
;TO BUILD OBR SEGMENT FOR CY
I '$D(^LR(LRDFN,SS,IVDT,0)) Q
;Look at ICD9 codes
I $O(^LR(LRDFN,SS,IVDT,3,0))>0 D
.K LRDATA
.S $P(LRDATA,HLFS,1)=$G(SEQ)
.S $P(LRDATA,HLFS,4)="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
.S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
.S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
.S LRSI=$O(^LR(LRDFN,SS,IVDT,.1,0)),SITE=""
.S:+LRSI>0 SITE=$P($G(^LR(LRDFN,SS,IVDT,.1,LRSI,0)),U,1)
.S $P(LRDATA,HLFS,15)=LRCS_LRCS_SITE
.S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQ=SEQ+1
.S LRIC=0 F S LRIC=$O(^LR(LRDFN,SS,IVDT,3,LRIC)) Q:+LRIC'>0 D
..Q:'$D(^LR(LRDFN,SS,IVDT,3,LRIC,0))
..S:'$D(DGCNT) DGCNT=1
..S ICD9=$P(^LR(LRDFN,SS,IVDT,3,LRIC,0),U,1)
..N LRTMP
..; S LRTMP=$$ICDDX^ICDCODE(ICD9,,,1)
.. S LRTMP=$$ICDDX^ICDEX(ICD9,,,"I",1) ; IHS/MSC/MKK - LR*5.2*1034
..K LRDATA
..S LRDATA="DG1"_HLFS_DGCNT_HLFS_HLFS_$P(LRTMP,U,2)
..S LRDATA=LRDATA_LRCS_$P(LRTMP,U,4)_LRCS_"I9"
..S ^TMP("HL7",$J,CNT)=$$UP^XLFSTR(LRDATA),DGCNT=DGCNT+1,CNT=CNT+1
K LRDATA,DGCNT
;Look to see in there is a workload code.
S LRWKI=0 F S LRWKI=$O(^LR(LRDFN,SS,IVDT,.1,LRWKI)) Q:+LRWKI'>0 D
.S LRWKDT=$G(^LR(LRDFN,SS,IVDT,.1,LRWKI,0))
.Q:+$P(LRWKDT,U,2)'>0
.Q:'$D(^LAB(60,$P(LRWKDT,U,2)))
.S LRTST=$P(LRWKDT,U,2)
.S LRNLT="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
.S LRINLT=+$G(^LAB(60,$P(LRWKDT,U,2),64))
.I LRINLT'="",$D(^LAM(LRINLT,0)) D
..S $P(LRNLT,LRCS,2)=$P(^LAM(LRINLT,0),U,1)
..S $P(LRNLT,LRCS,1)=$P(^LAM(LRINLT,0),U,2)
..S $P(LRNLT,LRCS,3)="VANLT"
.K LRDATA
.S $P(LRDATA,HLFS,1)=$G(SEQ)
.S $P(LRDATA,HLFS,4)=LRNLT_LRCS_LRTST_LRCS_$P(^LAB(60,LRTST,0),U)_LRCS_"VA60"
.S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
.S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
.S LRRDTE=$P($G(^LR(LRDFN,SS,IVDT,0)),U,3)
.S:+LRRDTE>0 LRRDTE=$$HLDATE^HLFNC(LRRDTE)
.S SITE=$P(LRWKDT,U,1)
.S $P(LRDATA,HLFS,15)=LRCS_LRCS_SITE
.S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQ=SEQ+1
K LRDATA,DGCNT,LRTST,LRWKDT,LRINLT,LRNLT
;Look into Multiple CYTOPATH ORGAN/TISSUE sub file
S LRTOP=0 F S LRTOP=$O(^LR(LRDFN,SS,IVDT,2,LRTOP)) Q:+LRTOP'>0 D
.K LRDATA
.S $P(LRDATA,HLFS,1)=$G(SEQ)
.S $P(LRDATA,HLFS,4)="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
.S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
.S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
.S LRRDTE=$P($G(^LR(LRDFN,SS,IVDT,0)),U,3)
.S:+LRRDTE>0 LRRDTE=$$HLDATE^HLFNC(LRRDTE)
.S SITE=$P(^LR(LRDFN,SS,IVDT,2,LRTOP,0),U,1)
.D SITECD^LREPI1
.S $P(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$P($G(^LAB(61,SITE,0)),U)
.S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQ=SEQ+1
.;NOW DO THE OBX(s) FOR TO SITE
.S ND="61.4,61.1,61.3,61.5"
.S SEQX=1
.F LRSUB=1,2,3,4 D
..Q:'$D(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,0))
..S LRNX=0
..F S LRNX=$O(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX)) Q:+LRNX'>0 D
...K LRDATA
...S LRI=$P(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX,0),U,1)
...Q:'$D(^LAB($P(ND,",",LRSUB),+LRI,0))
...S LRO=^LAB($P(ND,",",LRSUB),+LRI,0)
...S $P(LRDATA,HLFS,1)=$G(SEQX)
...S $P(LRDATA,HLFS,2)="ST"
...S $P(LRDATA,HLFS,3)=$P(LRO,U,2)_LRCS_$P(LRO,U,1)_LRCS_"SNM3"_LRCS_$P(LRO,U,2)_LRCS_$E($P(LRO,U,1),1,25)_LRCS_"SNM3"
...S $P(LRDATA,HLFS,14)=LRRDTE
...S LRRES=""
...S:LRSUB=4 LRRES=$P(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX,0),U,2)
...S:LRRES'="" $P(LRDATA,HLFS,5)=$S(LRRES:"Positive",1:"Negative")
...S ^TMP("HL7",$J,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQX=SEQX+1
Q
LREPI1A ;VA/DALOI/SED-EMERGING PATHOGENS HL7 BUILDER ; 17-Oct-2014 09:22 ; MKK
+1 ;;5.2;LAB SERVICE;**175,260,315,1031,1034**;NOV 1, 1997;Build 188
+2 ;
+3 ; Reference to ^ICD9 supported by IA #10082
+4 ; Reference to ^XLFSTR supported by IA #10104
+5 ;
EN(LRDFN,SS,IVDT,SEQ) ;Entry to build the HL7 Segment
+1 ;LRDFN=Patient ID
+2 ;SS=Subscripts in file 63 for results
+3 ;IVDT=Inverted Date and Time
+4 ;SEQ=Sequence Number
+5 ;S LRCS=$E(HL("ECH"))
+6 KILL ^TMP("HL7",$JOB)
+7 IF +$GET(SEQ)'>0
SET SEQ=1
+8 SET CNT=1
+9 IF '$GET(LRDFN)!('$GET(IVDT))!('$LENGTH($GET(SS)))
QUIT
+10 IF $LENGTH($TEXT(@SS))
DO @SS
EXIT ;KILL THEN EXIT
+1 KILL CNT,IND,LRAND,LRANT,LRDATA,LRES,LRINLT,LRNT,LRRDTE,LRREF,LRTST,LRUNIT
+2 KILL ND,NLT,NLTP,ORGNB,ORGPT,SEQX,SITE,TYPE
+3 QUIT SEQ
CY ;BUILD HL7 MSG FOR CY SUBSCRIPT
+1 ;TO BUILD OBR SEGMENT FOR CY
+2 IF '$DATA(^LR(LRDFN,SS,IVDT,0))
QUIT
+3 ;Look at ICD9 codes
+4 IF $ORDER(^LR(LRDFN,SS,IVDT,3,0))>0
Begin DoDot:1
+5 KILL LRDATA
+6 SET $PIECE(LRDATA,HLFS,1)=$GET(SEQ)
+7 SET $PIECE(LRDATA,HLFS,4)="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
+8 SET $PIECE(LRDATA,HLFS,18)=$PIECE(^LR(LRDFN,SS,IVDT,0),U,6)
+9 SET $PIECE(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
+10 SET LRSI=$ORDER(^LR(LRDFN,SS,IVDT,.1,0))
SET SITE=""
+11 IF +LRSI>0
SET SITE=$PIECE($GET(^LR(LRDFN,SS,IVDT,.1,LRSI,0)),U,1)
+12 SET $PIECE(LRDATA,HLFS,15)=LRCS_LRCS_SITE
+13 SET ^TMP("HL7",$JOB,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
SET CNT=CNT+1
SET SEQ=SEQ+1
+14 SET LRIC=0
FOR
SET LRIC=$ORDER(^LR(LRDFN,SS,IVDT,3,LRIC))
IF +LRIC'>0
QUIT
Begin DoDot:2
+15 IF '$DATA(^LR(LRDFN,SS,IVDT,3,LRIC,0))
QUIT
+16 IF '$DATA(DGCNT)
SET DGCNT=1
+17 SET ICD9=$PIECE(^LR(LRDFN,SS,IVDT,3,LRIC,0),U,1)
+18 NEW LRTMP
+19 ; S LRTMP=$$ICDDX^ICDCODE(ICD9,,,1)
+20 ; IHS/MSC/MKK - LR*5.2*1034
SET LRTMP=$$ICDDX^ICDEX(ICD9,,,"I",1)
+21 KILL LRDATA
+22 SET LRDATA="DG1"_HLFS_DGCNT_HLFS_HLFS_$PIECE(LRTMP,U,2)
+23 SET LRDATA=LRDATA_LRCS_$PIECE(LRTMP,U,4)_LRCS_"I9"
+24 SET ^TMP("HL7",$JOB,CNT)=$$UP^XLFSTR(LRDATA)
SET DGCNT=DGCNT+1
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+25 KILL LRDATA,DGCNT
+26 ;Look to see in there is a workload code.
+27 SET LRWKI=0
FOR
SET LRWKI=$ORDER(^LR(LRDFN,SS,IVDT,.1,LRWKI))
IF +LRWKI'>0
QUIT
Begin DoDot:1
+28 SET LRWKDT=$GET(^LR(LRDFN,SS,IVDT,.1,LRWKI,0))
+29 IF +$PIECE(LRWKDT,U,2)'>0
QUIT
+30 IF '$DATA(^LAB(60,$PIECE(LRWKDT,U,2)))
QUIT
+31 SET LRTST=$PIECE(LRWKDT,U,2)
+32 SET LRNLT="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
+33 SET LRINLT=+$GET(^LAB(60,$PIECE(LRWKDT,U,2),64))
+34 IF LRINLT'=""
IF $DATA(^LAM(LRINLT,0))
Begin DoDot:2
+35 SET $PIECE(LRNLT,LRCS,2)=$PIECE(^LAM(LRINLT,0),U,1)
+36 SET $PIECE(LRNLT,LRCS,1)=$PIECE(^LAM(LRINLT,0),U,2)
+37 SET $PIECE(LRNLT,LRCS,3)="VANLT"
End DoDot:2
+38 KILL LRDATA
+39 SET $PIECE(LRDATA,HLFS,1)=$GET(SEQ)
+40 SET $PIECE(LRDATA,HLFS,4)=LRNLT_LRCS_LRTST_LRCS_$PIECE(^LAB(60,LRTST,0),U)_LRCS_"VA60"
+41 SET $PIECE(LRDATA,HLFS,18)=$PIECE(^LR(LRDFN,SS,IVDT,0),U,6)
+42 SET $PIECE(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
+43 SET LRRDTE=$PIECE($GET(^LR(LRDFN,SS,IVDT,0)),U,3)
+44 IF +LRRDTE>0
SET LRRDTE=$$HLDATE^HLFNC(LRRDTE)
+45 SET SITE=$PIECE(LRWKDT,U,1)
+46 SET $PIECE(LRDATA,HLFS,15)=LRCS_LRCS_SITE
+47 SET ^TMP("HL7",$JOB,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
SET CNT=CNT+1
SET SEQ=SEQ+1
End DoDot:1
+48 KILL LRDATA,DGCNT,LRTST,LRWKDT,LRINLT,LRNLT
+49 ;Look into Multiple CYTOPATH ORGAN/TISSUE sub file
+50 SET LRTOP=0
FOR
SET LRTOP=$ORDER(^LR(LRDFN,SS,IVDT,2,LRTOP))
IF +LRTOP'>0
QUIT
Begin DoDot:1
+51 KILL LRDATA
+52 SET $PIECE(LRDATA,HLFS,1)=$GET(SEQ)
+53 SET $PIECE(LRDATA,HLFS,4)="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
+54 SET $PIECE(LRDATA,HLFS,18)=$PIECE(^LR(LRDFN,SS,IVDT,0),U,6)
+55 SET $PIECE(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
+56 SET LRRDTE=$PIECE($GET(^LR(LRDFN,SS,IVDT,0)),U,3)
+57 IF +LRRDTE>0
SET LRRDTE=$$HLDATE^HLFNC(LRRDTE)
+58 SET SITE=$PIECE(^LR(LRDFN,SS,IVDT,2,LRTOP,0),U,1)
+59 DO SITECD^LREPI1
+60 SET $PIECE(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$PIECE($GET(^LAB(61,SITE,0)),U)
+61 SET ^TMP("HL7",$JOB,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
SET CNT=CNT+1
SET SEQ=SEQ+1
+62 ;NOW DO THE OBX(s) FOR TO SITE
+63 SET ND="61.4,61.1,61.3,61.5"
+64 SET SEQX=1
+65 FOR LRSUB=1,2,3,4
Begin DoDot:2
+66 IF '$DATA(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,0))
QUIT
+67 SET LRNX=0
+68 FOR
SET LRNX=$ORDER(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX))
IF +LRNX'>0
QUIT
Begin DoDot:3
+69 KILL LRDATA
+70 SET LRI=$PIECE(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX,0),U,1)
+71 IF '$DATA(^LAB($PIECE(ND,",",LRSUB),+LRI,0))
QUIT
+72 SET LRO=^LAB($PIECE(ND,",",LRSUB),+LRI,0)
+73 SET $PIECE(LRDATA,HLFS,1)=$GET(SEQX)
+74 SET $PIECE(LRDATA,HLFS,2)="ST"
+75 SET $PIECE(LRDATA,HLFS,3)=$PIECE(LRO,U,2)_LRCS_$PIECE(LRO,U,1)_LRCS_"SNM3"_LRCS_$PIECE(LRO,U,2)_LRCS_$EXTRACT($PIECE(LRO,U,1),1,25)_LRCS_"SNM3"
+76 SET $PIECE(LRDATA,HLFS,14)=LRRDTE
+77 SET LRRES=""
+78 IF LRSUB=4
SET LRRES=$PIECE(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX,0),U,2)
+79 IF LRRES'=""
SET $PIECE(LRDATA,HLFS,5)=$SELECT(LRRES:"Positive",1:"Negative")
+80 SET ^TMP("HL7",$JOB,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
SET CNT=CNT+1
SET SEQX=SEQX+1
End DoDot:3
End DoDot:2
End DoDot:1
+81 QUIT
