LREPI1A ;DALOI/SED-EMERGING PATHOGENS HL7 BUILDER ;5/1/98
;;5.2;LAB SERVICE;**175,260,315**;Sep 27, 1994;Build 25
; 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)
..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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPI1A 4167 printed Apr 09, 2024@21:16:45 Page 2
LREPI1A ;DALOI/SED-EMERGING PATHOGENS HL7 BUILDER ;5/1/98
+1 ;;5.2;LAB SERVICE;**175,260,315**;Sep 27, 1994;Build 25
+2 ; Reference to ^ICD9 supported by IA #10082
+3 ; Reference to ^XLFSTR supported by IA #10104
+4 ;
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 SET LRTMP=$$ICDDX^ICDCODE(ICD9,,,1)
+20 KILL LRDATA
+21 SET LRDATA="DG1"_HLFS_DGCNT_HLFS_HLFS_$PIECE(LRTMP,U,2)
+22 SET LRDATA=LRDATA_LRCS_$PIECE(LRTMP,U,4)_LRCS_"I9"
+23 SET ^TMP("HL7",$JOB,CNT)=$$UP^XLFSTR(LRDATA)
SET DGCNT=DGCNT+1
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+24 KILL LRDATA,DGCNT
+25 ;Look to see in there is a workload code.
+26 SET LRWKI=0
FOR
SET LRWKI=$ORDER(^LR(LRDFN,SS,IVDT,.1,LRWKI))
if +LRWKI'>0
QUIT
Begin DoDot:1
+27 SET LRWKDT=$GET(^LR(LRDFN,SS,IVDT,.1,LRWKI,0))
+28 if +$PIECE(LRWKDT,U,2)'>0
QUIT
+29 if '$DATA(^LAB(60,$PIECE(LRWKDT,U,2)))
QUIT
+30 SET LRTST=$PIECE(LRWKDT,U,2)
+31 SET LRNLT="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
+32 SET LRINLT=+$GET(^LAB(60,$PIECE(LRWKDT,U,2),64))
+33 IF LRINLT'=""
IF $DATA(^LAM(LRINLT,0))
Begin DoDot:2
+34 SET $PIECE(LRNLT,LRCS,2)=$PIECE(^LAM(LRINLT,0),U,1)
+35 SET $PIECE(LRNLT,LRCS,1)=$PIECE(^LAM(LRINLT,0),U,2)
+36 SET $PIECE(LRNLT,LRCS,3)="VANLT"
End DoDot:2
+37 KILL LRDATA
+38 SET $PIECE(LRDATA,HLFS,1)=$GET(SEQ)
+39 SET $PIECE(LRDATA,HLFS,4)=LRNLT_LRCS_LRTST_LRCS_$PIECE(^LAB(60,LRTST,0),U)_LRCS_"VA60"
+40 SET $PIECE(LRDATA,HLFS,18)=$PIECE(^LR(LRDFN,SS,IVDT,0),U,6)
+41 SET $PIECE(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
+42 SET LRRDTE=$PIECE($GET(^LR(LRDFN,SS,IVDT,0)),U,3)
+43 if +LRRDTE>0
SET LRRDTE=$$HLDATE^HLFNC(LRRDTE)
+44 SET SITE=$PIECE(LRWKDT,U,1)
+45 SET $PIECE(LRDATA,HLFS,15)=LRCS_LRCS_SITE
+46 SET ^TMP("HL7",$JOB,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
SET CNT=CNT+1
SET SEQ=SEQ+1
End DoDot:1
+47 KILL LRDATA,DGCNT,LRTST,LRWKDT,LRINLT,LRNLT
+48 ;Look into Multiple CYTOPATH ORGAN/TISSUE sub file
+49 SET LRTOP=0
FOR
SET LRTOP=$ORDER(^LR(LRDFN,SS,IVDT,2,LRTOP))
if +LRTOP'>0
QUIT
Begin DoDot:1
+50 KILL LRDATA
+51 SET $PIECE(LRDATA,HLFS,1)=$GET(SEQ)
+52 SET $PIECE(LRDATA,HLFS,4)="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
+53 SET $PIECE(LRDATA,HLFS,18)=$PIECE(^LR(LRDFN,SS,IVDT,0),U,6)
+54 SET $PIECE(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
+55 SET LRRDTE=$PIECE($GET(^LR(LRDFN,SS,IVDT,0)),U,3)
+56 if +LRRDTE>0
SET LRRDTE=$$HLDATE^HLFNC(LRRDTE)
+57 SET SITE=$PIECE(^LR(LRDFN,SS,IVDT,2,LRTOP,0),U,1)
+58 DO SITECD^LREPI1
+59 SET $PIECE(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$PIECE($GET(^LAB(61,SITE,0)),U)
+60 SET ^TMP("HL7",$JOB,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
SET CNT=CNT+1
SET SEQ=SEQ+1
+61 ;NOW DO THE OBX(s) FOR TO SITE
+62 SET ND="61.4,61.1,61.3,61.5"
+63 SET SEQX=1
+64 FOR LRSUB=1,2,3,4
Begin DoDot:2
+65 if '$DATA(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,0))
QUIT
+66 SET LRNX=0
+67 FOR
SET LRNX=$ORDER(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX))
if +LRNX'>0
QUIT
Begin DoDot:3
+68 KILL LRDATA
+69 SET LRI=$PIECE(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX,0),U,1)
+70 if '$DATA(^LAB($PIECE(ND,",",LRSUB),+LRI,0))
QUIT
+71 SET LRO=^LAB($PIECE(ND,",",LRSUB),+LRI,0)
+72 SET $PIECE(LRDATA,HLFS,1)=$GET(SEQX)
+73 SET $PIECE(LRDATA,HLFS,2)="ST"
+74 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"
+75 SET $PIECE(LRDATA,HLFS,14)=LRRDTE
+76 SET LRRES=""
+77 if LRSUB=4
SET LRRES=$PIECE(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX,0),U,2)
+78 if LRRES'=""
SET $PIECE(LRDATA,HLFS,5)=$SELECT(LRRES:"Positive",1:"Negative")
+79 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
+80 QUIT
