source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LREPI1A.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1LREPI1A ;DALOI/SED-EMERGING PATHOGENS HL7 BUILDER ;5/1/98
2 ;;5.2;LAB SERVICE;**175,260**;Sep 27, 1994
3 ; Reference to ^ICD9 supported by IA #10082
4 ; Reference to ^XLFSTR supported by IA #10104
5 ;
6EN(LRDFN,SS,IVDT,SEQ) ;Entry to build the HL7 Segment
7 ;LRDFN=Patient ID
8 ;SS=Subscripts in file 63 for results
9 ;IVDT=Inverted Date and Time
10 ;SEQ=Sequence Number
11 ;S LRCS=$E(HL("ECH"))
12 K ^TMP("HL7",$J)
13 S:+$G(SEQ)'>0 SEQ=1
14 S CNT=1
15 Q:'$G(LRDFN)!('$G(IVDT))!('$L($G(SS)))
16 I $L($T(@SS)) D @SS
17EXIT ;KILL THEN EXIT
18 K CNT,IND,LRAND,LRANT,LRDATA,LRES,LRINLT,LRNT,LRRDTE,LRREF,LRTST,LRUNIT
19 K ND,NLT,NLTP,ORGNB,ORGPT,SEQX,SITE,TYPE
20 Q SEQ
21CY ;BUILD HL7 MSG FOR CY SUBSCRIPT
22 ;TO BUILD OBR SEGMENT FOR CY
23 I '$D(^LR(LRDFN,SS,IVDT,0)) Q
24 ;Look at ICD9 codes
25 I $O(^LR(LRDFN,SS,IVDT,3,0))>0 D
26 .K LRDATA
27 .S $P(LRDATA,HLFS,1)=$G(SEQ)
28 .S $P(LRDATA,HLFS,4)="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
29 .S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
30 .S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
31 .S LRSI=$O(^LR(LRDFN,SS,IVDT,.1,0)),SITE=""
32 .S:+LRSI>0 SITE=$P($G(^LR(LRDFN,SS,IVDT,.1,LRSI,0)),U,1)
33 .S $P(LRDATA,HLFS,15)=LRCS_LRCS_SITE
34 .S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQ=SEQ+1
35 .S LRIC=0 F S LRIC=$O(^LR(LRDFN,SS,IVDT,3,LRIC)) Q:+LRIC'>0 D
36 ..Q:'$D(^LR(LRDFN,SS,IVDT,3,LRIC,0))
37 ..S:'$D(DGCNT) DGCNT=1
38 ..S ICD9=$P(^LR(LRDFN,SS,IVDT,3,LRIC,0),U,1)
39 ..K LRDATA
40 ..S LRDATA="DG1"_HLFS_DGCNT_HLFS_HLFS_$P(^ICD9(ICD9,0),U,1)
41 ..S LRDATA=LRDATA_LRCS_$P(^ICD9(ICD9,0),U,3)_LRCS_"I9"
42 ..S ^TMP("HL7",$J,CNT)=$$UP^XLFSTR(LRDATA),DGCNT=DGCNT+1,CNT=CNT+1
43 K LRDATA,DGCNT
44 ;Look to see in there is a workload code.
45 S LRWKI=0 F S LRWKI=$O(^LR(LRDFN,SS,IVDT,.1,LRWKI)) Q:+LRWKI'>0 D
46 .S LRWKDT=$G(^LR(LRDFN,SS,IVDT,.1,LRWKI,0))
47 .Q:+$P(LRWKDT,U,2)'>0
48 .Q:'$D(^LAB(60,$P(LRWKDT,U,2)))
49 .S LRTST=$P(LRWKDT,U,2)
50 .S LRNLT="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
51 .S LRINLT=+$G(^LAB(60,$P(LRWKDT,U,2),64))
52 .I LRINLT'="",$D(^LAM(LRINLT,0)) D
53 ..S $P(LRNLT,LRCS,2)=$P(^LAM(LRINLT,0),U,1)
54 ..S $P(LRNLT,LRCS,1)=$P(^LAM(LRINLT,0),U,2)
55 ..S $P(LRNLT,LRCS,3)="VANLT"
56 .K LRDATA
57 .S $P(LRDATA,HLFS,1)=$G(SEQ)
58 .S $P(LRDATA,HLFS,4)=LRNLT_LRCS_LRTST_LRCS_$P(^LAB(60,LRTST,0),U)_LRCS_"VA60"
59 .S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
60 .S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
61 .S LRRDTE=$P($G(^LR(LRDFN,SS,IVDT,0)),U,3)
62 .S:+LRRDTE>0 LRRDTE=$$HLDATE^HLFNC(LRRDTE)
63 .S SITE=$P(LRWKDT,U,1)
64 .S $P(LRDATA,HLFS,15)=LRCS_LRCS_SITE
65 .S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQ=SEQ+1
66 K LRDATA,DGCNT,LRTST,LRWKDT,LRINLT,LRNLT
67 ;Look into Multiple CYTOPATH ORGAN/TISSUE sub file
68 S LRTOP=0 F S LRTOP=$O(^LR(LRDFN,SS,IVDT,2,LRTOP)) Q:+LRTOP'>0 D
69 .K LRDATA
70 .S $P(LRDATA,HLFS,1)=$G(SEQ)
71 .S $P(LRDATA,HLFS,4)="88056.0000"_LRCS_"CY SPECIMEN"_LRCS_"VANLT"
72 .S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
73 .S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
74 .S LRRDTE=$P($G(^LR(LRDFN,SS,IVDT,0)),U,3)
75 .S:+LRRDTE>0 LRRDTE=$$HLDATE^HLFNC(LRRDTE)
76 .S SITE=$P(^LR(LRDFN,SS,IVDT,2,LRTOP,0),U,1)
77 .D SITECD^LREPI1
78 .S $P(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$P($G(^LAB(61,SITE,0)),U)
79 .S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQ=SEQ+1
80 .;NOW DO THE OBX(s) FOR TO SITE
81 .S ND="61.4,61.1,61.3,61.5"
82 .S SEQX=1
83 .F LRSUB=1,2,3,4 D
84 ..Q:'$D(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,0))
85 ..S LRNX=0
86 ..F S LRNX=$O(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX)) Q:+LRNX'>0 D
87 ...K LRDATA
88 ...S LRI=$P(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX,0),U,1)
89 ...Q:'$D(^LAB($P(ND,",",LRSUB),+LRI,0))
90 ...S LRO=^LAB($P(ND,",",LRSUB),+LRI,0)
91 ...S $P(LRDATA,HLFS,1)=$G(SEQX)
92 ...S $P(LRDATA,HLFS,2)="ST"
93 ...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"
94 ...S $P(LRDATA,HLFS,14)=LRRDTE
95 ...S LRRES=""
96 ...S:LRSUB=4 LRRES=$P(^LR(LRDFN,SS,IVDT,2,LRTOP,LRSUB,LRNX,0),U,2)
97 ...S:LRRES'="" $P(LRDATA,HLFS,5)=$S(LRRES:"Positive",1:"Negative")
98 ...S ^TMP("HL7",$J,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA),CNT=CNT+1,SEQX=SEQX+1
99 Q
Note: See TracBrowser for help on using the repository browser.