- 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 Jan 18, 2025@03:14:53 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