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

LREPI1A.m

Go to the documentation of this file.
  1. LREPI1A ;DALOI/SED-EMERGING PATHOGENS HL7 BUILDER ;5/1/98
  1. ;;5.2;LAB SERVICE;**175,260,315**;Sep 27, 1994;Build 25
  1. ; Reference to ^ICD9 supported by IA #10082
  1. ; Reference to ^XLFSTR supported by IA #10104
  1. ;
  1. EN(LRDFN,SS,IVDT,SEQ) ;Entry to build the HL7 Segment
  1. ;LRDFN=Patient ID
  1. ;SS=Subscripts in file 63 for results
  1. ;IVDT=Inverted Date and Time
  1. ;SEQ=Sequence Number
  1. ;S LRCS=$E(HL("ECH"))
  1. K ^TMP("HL7",$J)
  1. S:+$G(SEQ)'>0 SEQ=1
  1. S CNT=1
  1. Q:'$G(LRDFN)!('$G(IVDT))!('$L($G(SS)))
  1. I $L($T(@SS)) D @SS
  1. EXIT ;KILL THEN EXIT
  1. K CNT,IND,LRAND,LRANT,LRDATA,LRES,LRINLT,LRNT,LRRDTE,LRREF,LRTST,LRUNIT
  1. K ND,NLT,NLTP,ORGNB,ORGPT,SEQX,SITE,TYPE
  1. Q SEQ
  1. CY ;BUILD HL7 MSG FOR CY SUBSCRIPT
  1. ;TO BUILD OBR SEGMENT FOR CY
  1. I '$D(^LR(LRDFN,SS,IVDT,0)) Q
  1. ;Look at ICD9 codes
  1. I $O(^LR(LRDFN,SS,IVDT,3,0))>0 D
  1. .K LRDATA
  1. .S $P(LRDATA,HLFS,1)=$G(SEQ)
  1. .S $P(LRDATA,HLFS,4)="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
  1. .S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
  1. .S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
  1. .S LRSI=$O(^LR(LRDFN,SS,IVDT,.1,0)),SITE=""
  1. .S:+LRSI>0 SITE=$P($G(^LR(LRDFN,SS,IVDT,.1,LRSI,0)),U,1)
  1. .S $P(LRDATA,HLFS,15)=LRCS_LRCS_SITE
  1. .S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQ=SEQ+1
  1. .S LRIC=0 F S LRIC=$O(^LR(LRDFN,SS,IVDT,3,LRIC)) Q:+LRIC'>0 D
  1. ..Q:'$D(^LR(LRDFN,SS,IVDT,3,LRIC,0))
  1. ..S:'$D(DGCNT) DGCNT=1
  1. ..S ICD9=$P(^LR(LRDFN,SS,IVDT,3,LRIC,0),U,1)
  1. ..N LRTMP
  1. ..S LRTMP=$$ICDDX^ICDCODE(ICD9,,,1)
  1. ..K LRDATA
  1. ..S LRDATA="DG1"_HLFS_DGCNT_HLFS_HLFS_$P(LRTMP,U,2)
  1. ..S LRDATA=LRDATA_LRCS_$P(LRTMP,U,4)_LRCS_"I9"
  1. ..S ^TMP("HL7",$J,CNT)=$$UP^XLFSTR(LRDATA),DGCNT=DGCNT+1,CNT=CNT+1
  1. K LRDATA,DGCNT
  1. ;Look to see in there is a workload code.
  1. S LRWKI=0 F S LRWKI=$O(^LR(LRDFN,SS,IVDT,.1,LRWKI)) Q:+LRWKI'>0 D
  1. .S LRWKDT=$G(^LR(LRDFN,SS,IVDT,.1,LRWKI,0))
  1. .Q:+$P(LRWKDT,U,2)'>0
  1. .Q:'$D(^LAB(60,$P(LRWKDT,U,2)))
  1. .S LRTST=$P(LRWKDT,U,2)
  1. .S LRNLT="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
  1. .S LRINLT=+$G(^LAB(60,$P(LRWKDT,U,2),64))
  1. .I LRINLT'="",$D(^LAM(LRINLT,0)) D
  1. ..S $P(LRNLT,LRCS,2)=$P(^LAM(LRINLT,0),U,1)
  1. ..S $P(LRNLT,LRCS,1)=$P(^LAM(LRINLT,0),U,2)
  1. ..S $P(LRNLT,LRCS,3)="VANLT"
  1. .K LRDATA
  1. .S $P(LRDATA,HLFS,1)=$G(SEQ)
  1. .S $P(LRDATA,HLFS,4)=LRNLT_LRCS_LRTST_LRCS_$P(^LAB(60,LRTST,0),U)_LRCS_"VA60"
  1. .S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
  1. .S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
  1. .S LRRDTE=$P($G(^LR(LRDFN,SS,IVDT,0)),U,3)
  1. .S:+LRRDTE>0 LRRDTE=$$HLDATE^HLFNC(LRRDTE)
  1. .S SITE=$P(LRWKDT,U,1)
  1. .S $P(LRDATA,HLFS,15)=LRCS_LRCS_SITE
  1. .S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQ=SEQ+1
  1. K LRDATA,DGCNT,LRTST,LRWKDT,LRINLT,LRNLT
  1. ;Look into Multiple CYTOPATH ORGAN/TISSUE sub file
  1. S LRTOP=0 F S LRTOP=$O(^LR(LRDFN,SS,IVDT,2,LRTOP)) Q:+LRTOP'>0 D
  1. .K LRDATA
  1. .S $P(LRDATA,HLFS,1)=$G(SEQ)
  1. .S $P(LRDATA,HLFS,4)="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
  1. .S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
  1. .S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
  1. .S LRRDTE=$P($G(^LR(LRDFN,SS,IVDT,0)),U,3)
  1. .S:+LRRDTE>0 LRRDTE=$$HLDATE^HLFNC(LRRDTE)
  1. .S SITE=$P(^LR(LRDFN,SS,IVDT,2,LRTOP,0),U,1)
  1. .D SITECD^LREPI1
  1. .S $P(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$P($G(^LAB(61,SITE,0)),U)
  1. .S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQ=SEQ+1
  1. .;NOW DO THE OBX(s) FOR TO SITE
  1. .S ND="61.4,61.1,61.3,61.5"
  1. .S SEQX=1
  1. .F LRSUB=1,2,3,4 D
  1. ..Q:'$D(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,0))
  1. ..S LRNX=0
  1. ..F S LRNX=$O(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX)) Q:+LRNX'>0 D
  1. ...K LRDATA
  1. ...S LRI=$P(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX,0),U,1)
  1. ...Q:'$D(^LAB($P(ND,",",LRSUB),+LRI,0))
  1. ...S LRO=^LAB($P(ND,",",LRSUB),+LRI,0)
  1. ...S $P(LRDATA,HLFS,1)=$G(SEQX)
  1. ...S $P(LRDATA,HLFS,2)="ST"
  1. ...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"
  1. ...S $P(LRDATA,HLFS,14)=LRRDTE
  1. ...S LRRES=""
  1. ...S:LRSUB=4 LRRES=$P(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX,0),U,2)
  1. ...S:LRRES'="" $P(LRDATA,HLFS,5)=$S(LRRES:"Positive",1:"Negative")
  1. ...S ^TMP("HL7",$J,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQX=SEQX+1
  1. Q