| 1 | LR7OU0 ;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 | ; | 
|---|
| 8 | EN ; | 
|---|
| 9 | Q | 
|---|
| 10 | MSH(TYPE) ;Build MSH segment | 
|---|
| 11 | ;TYPE=Message type (ORM) | 
|---|
| 12 | N MSH | 
|---|
| 13 | S MSH="MSH|^~\&|LABORATORY|"_$G(DUZ(2))_"|||||"_TYPE | 
|---|
| 14 | Q MSH | 
|---|
| 15 | PID(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 | 
|---|
| 19 | PV1(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 | 
|---|
| 28 | HL7DT(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 | 
|---|
| 33 | FMDATE(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 | 
|---|
| 38 | NMSPACE(PKG) ; Returns pkg namespace | 
|---|
| 39 | N X S X=$P($G(^DIC(9.4,PKG,0)),"^",2) | 
|---|
| 40 | Q X | 
|---|
| 41 | UVID(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 | 
|---|
| 56 | SAMP(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 | 
|---|
| 63 | LRSAMP(SAMPLE) ;HL7 -> File 62 sample format | 
|---|
| 64 | ;Sample=Source of Specimen code | 
|---|
| 65 | N X | 
|---|
| 66 | S X=$P(SAMPLE,";",4) | 
|---|
| 67 | Q X | 
|---|
| 68 | LRSPEC(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 | 
|---|
| 75 | ACTCODE(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 | 
|---|
| 80 | LRACTCOD(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 | 
|---|
| 85 | URG(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 | 
|---|
| 91 | LRURG(URGENCY) ;HL7 Priority -> Lab Urgency | 
|---|
| 92 | ;URGENCY=HL7 Priority code | 
|---|
| 93 | N X | 
|---|
| 94 | S X=$P(URGENCY,";",2) | 
|---|
| 95 | Q X | 
|---|
| 96 | FLAG(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 | 
|---|