source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OU0.m@ 1528

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1LR7OU0 ;slc/dcm - HL7 Utilities/Conversions ;8/11/97
2 ;;5.2;LAB SERVICE;**121,187,265,299**;Sep 27, 1994
3 ; Reference to ^DIC(9.4 supported by IA #2058
4 ; Reference to ^SC( supported by IA #908
5 ; Reference to ^VA(200 supported by SUPPORTED REFERENCE #10060
6 ; Reference to ^XLFDT supported by IA #10103
7 ;
8EN ;
9 Q
10MSH(TYPE) ;Build MSH segment
11 ;TYPE=Message type (ORM)
12 N MSH
13 S MSH="MSH|^~\&|LABORATORY|"_$G(DUZ(2))_"|||||"_TYPE
14 Q MSH
15PID(LRDPF) ; PID segment
16 N PID
17 S PID="PID|||"_$S($P(LRDPF,"^",2)="DPT(":+DFN,1:"")_"|"_+DFN_";"_$P(LRDPF,"^",2)_"|"_$P($G(@("^"_$P(LRDPF,"^",2)_+DFN_",0)")),"^")
18 Q PID
19PV1(LOC,ROOMBED,VISIT) ; PV1 segment
20 ;TYPE = Patient Class (table 4)
21 ;ROOMBED = Patient Room/Bed
22 ;LOC = Patient Location
23 ;VISIT = Visit Number
24 N PV1,TYPE
25 S TYPE=$S($P($G(^SC(+LOC,0)),"^",3)="W":"I",1:"O")
26 S PV1="PV1||"_TYPE_"|"_LOC_"^"_ROOMBED_"||||||||||||||||"_$G(VISIT)
27 Q PV1
28HL7DT(DATE) ; FM -> HL7 format
29 Q $$FMTHL7^XLFDT(DATE)
30 ;N X
31 ;S X="" I DATE S X=(1700+$E(DATE,1,3))_$E(DATE,4,7)_$E(DATE,9,14)
32 ;Q X
33FMDATE(DATE) ; HL7 -> FM format
34 Q $$HL7TFM^XLFDT(DATE)
35 ;N X
36 ;S X="" I DATE S X=$E(DATE,1,4)-1700_$E(DATE,5,8)_$S($L($E(DATE,9)):"."_$E(DATE,9,14),1:"")
37 ;Q X
38NMSPACE(PKG) ; Returns pkg namespace
39 N X S X=$P($G(^DIC(9.4,PKG,0)),"^",2)
40 Q X
41UVID(X,SPEC,NID,NSEC,NNAME,MSG,SS) ; Set Universal ID
42 ;X=Test ptr to 60
43 ;NID=National ID
44 ;NNAME=National Name
45 ;NSEC=National coding system
46 ;SPEC=specimen ptr to file 61
47 ;MSG=Message array to store data in
48 ;SS=test subscript override, set when ORC is setup otherwise ""
49 N X1,X3,X4,X6,XX
50 S X3="LRT",X4=$P($G(^LAB(60,+$G(X),0)),"^"),X1=$P($G(^(0)),"^",4)
51 S MSG=$S($L(MSG):MSG,X1="":"^TMP(""LRCH"",$J)","CYEMSPAU"[X1:"^TMP(""LRAP"",$J)",X1="BB":"^TMP(""LRBB"",$J)",X1="MI":"^TMP(""LRCH"",$J)",1:"^TMP(""LRCH"",$J)"),X3="LRT" ;$S(X1="BB":"LRB",1:"LRT")
52 I '$D(@MSG@(1))#2 F I=1:1:4 I $D(MSG(I)) S @MSG@(I)=MSG(I)
53 S XX=$S($L($G(SS)):$S(SS="BB":"LRBB",SS="CH":"LRCH",SS="MI":"LRMI",1:"LRAP"),1:"LRCH") I $D(ORCMSG),$L($G(MSG(ORCMSG))),$E(MSG(ORCMSG),1,3)="ORC" S X6=$P($P(MSG(ORCMSG),"|",4),"^"),$P(@MSG@(ORCMSG),"|",4)=X6_"^"_XX
54 S X=NID_"^"_NNAME_"^"_NSEC_"^"_X_"^"_X4_"^99"_X3
55 Q X
56SAMP(SAMPLE,SPECIMEN) ; File 62,61 -> HL7 Source of Specimen code
57 ;Sample=ptr to file 62
58 ;Specimen=ptr to file 61
59 N X
60 S X=$G(^LAB(61,+SPECIMEN,0))
61 S X=$P(X,"^",2)_";"_$P(X,"^")_";SNM;"_SAMPLE_";"_$P($G(^LAB(62,+SAMPLE,0)),"^")_";99LRS^^^"_+SPECIMEN_";"_$P(X,"^")_";99LRX"
62 Q X
63LRSAMP(SAMPLE) ;HL7 -> File 62 sample format
64 ;Sample=Source of Specimen code
65 N X
66 S X=$P(SAMPLE,";",4)
67 Q X
68LRSPEC(SAMPLE) ;HL7 -> File 61 Specimen format
69 ;Sample=Source of Specimen code
70 N X
71 S X="" I $P($P(SAMPLE,"^",4),";") S X=$P($P(SAMPLE,"^",4),";")
72 I X="" S X=$S($L($P(SAMPLE,";")):$O(^LAB(61,"C",$P(SAMPLE,";"),0)),1:"")
73 I X="",$P(SAMPLE,";",4) S X=$P($G(^LAB(62,$P(SAMPLE,";",4),0)),"^",2)
74 Q X
75ACTCODE(TYPE) ;Lab Collection type -> HL7 Specimen Action Code
76 ;TYPE=WC, LC, SP, I, 3, A
77 N X
78 S X=$S(TYPE="SP":1,TYPE="WC":"O",TYPE="I":2,TYPE=3:3,TYPE="A":"A",1:"L")
79 Q X
80LRACTCOD(TYPE) ;HL7 Specimen Action Code -> Lab Collection type
81 ;Type=1, 2, 3, A, O, L
82 N X
83 S X=$S(TYPE=1:"SP",TYPE=2:"I",TYPE=3:3,TYPE="A":"A",TYPE="O":"WC",1:"LC")
84 Q X
85URG(URGENCY) ;Lab Urgency -> HL7 Priority code
86 ;URGENCY=Urgency ptr to Lab Urgency file
87 ;X returned: HL7 code;ptr to lab urgency file (62.05) e.g.: "S;1" for STAT
88 N X
89 S X=$S($D(^LAB(62.05,+$G(URGENCY),0)):$P(^(0),"^",4),1:""),X=X_";"_URGENCY
90 Q X
91LRURG(URGENCY) ;HL7 Priority -> Lab Urgency
92 ;URGENCY=HL7 Priority code
93 N X
94 S X=$P(URGENCY,";",2)
95 Q X
96FLAG(FLAG) ; Return HL7 Flag code
97 ;FLAG=Test result flag
98 N X
99 S X=$S(FLAG="L":FLAG,FLAG="H":FLAG,FLAG="H*":"HH",FLAG="L*":"LL",1:"")
100 Q X
Note: See TracBrowser for help on using the repository browser.