source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCHL72.m@ 660

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

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1GMRCHL72 ;SLC/DCM - HL-7 formats OBX and NTE segments ;11/15/02 07:32
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,29**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #872
5 ;
6 Q
7OBX(GMRCIFN) ;Build the OBX segment of the HL-7 message
8 ;GMRCIFN=GMRCIEN - the internal file # of the record from file 123
9 N OBXSEGNO,GMRCND,GMRCND1
10 S OBXSEGNO=0
11 I ORCTRL'="RT",$D(^GMR(123,GMRCIFN,20,0)) S GMRCND=0,GMRCND1=0 D
12 . S OBXSEGNO=OBXSEGNO+1
13 . S GMRCND=$O(^GMR(123,GMRCIFN,20,GMRCND))
14 . S OBX(OBXSEGNO)="OBX|"_OBXSEGNO
15 . S OBX(OBXSEGNO)=OBX(OBXSEGNO)_"|TX|2000.02^REASON FOR REQUEST^AS4||"
16 . S OBX(OBXSEGNO)=OBX(OBXSEGNO)_^GMR(123,GMRCIFN,20,GMRCND,0)
17 . S GMRCND1=GMRCND1+1
18 . F S GMRCND=$O(^GMR(123,GMRCIFN,20,GMRCND)) Q:GMRCND="" D
19 .. S OBX(OBXSEGNO,GMRCND1)=^GMR(123,GMRCIFN,20,GMRCND,0)
20 .. S GMRCND1=GMRCND1+1
21 .Q
22 I $D(^GMR(123,GMRCIFN,30)) S OBXSEGNO=OBXSEGNO+1 D
23 . S OBX(OBXSEGNO)="OBX|"_OBXSEGNO
24 . N OBXSEG
25 . I '$D(^GMR(123,GMRCIFN,30.1)) D
26 .. S OBXSEG="|TX|^PROVISIONAL DIAGNOSIS^||"_$G(^GMR(123,GMRCIFN,30))
27 . I $D(^GMR(123,GMRCIFN,30.1)) D
28 .. S OBXSEG="|CE|^PROVISIONAL DIAGNOSIS^||"_^GMR(123,GMRCIFN,30.1)_U
29 .. S OBXSEG=OBXSEG_$P(^GMR(123,GMRCIFN,30),(" ("_^(30.1)))_U_"I9C"
30 . S OBX(OBXSEGNO)=OBX(OBXSEGNO)_OBXSEG
31 I ORCTRL="RE",$L($P(^GMR(123,GMRCIFN,0),U,19)) D
32 . S OBXSEGNO=OBXSEGNO+1
33 . S OBX(OBXSEGNO)="OBX|"_OBXSEGNO
34 . N OBXSEG
35 . S OBXSEG="|TX|^SIG FINDINGS^|1|"_$P(^GMR(123,GMRCIFN,0),U,19)
36 . S OBX(OBXSEGNO)=OBX(OBXSEGNO)_OBXSEG
37 Q
38 ;
39NTE(GMRCFN,GMRCND,GMRCTRL) ;Build the NTE segment of the HL7 message
40 ;GMRCND=GMRCOM, an array. GMRCND = flag that a comment exists.
41 ;GMRCND(0)= DA = the internal entry in node 40: ^GMR(123,IEN,40,DA
42 ;GMRCTRL=HL7 control code from table 119
43 Q:'$D(GMRCND(0)) S ND=GMRCND(0)
44 S ND2=1,NTE(ND2)="NTE|16|L|"
45 I $S($P(^GMR(123,GMRCFN,40,ND,0),"^",2)=6:1,$P(^(0),"^",2)=20:1,$P(^(0),"^",2)=7:1,$P(^(0),"^",2)=5:1,GMRCTRL="XX":1,1:0) D
46 .S ND1=0,ND1=$O(^GMR(123,GMRCFN,40,ND,1,ND1)) Q:ND1="" S NTE(ND2)=NTE(ND2)_^GMR(123,GMRCFN,40,ND,1,ND1,0),ND2=ND2+1
47 .F S ND1=$O(^GMR(123,GMRCFN,40,ND,1,ND1)) Q:ND1="" S NTE(ND2)=^GMR(123,GMRCFN,40,ND,1,ND1,0),ND2=ND2+1
48 .Q
49 ;I $P(NTE(1),"|",4)="",$S(GMRCTRL="OD":1,GMRCTRL="OC":1,1:0) S $P(NTE(1),"|",4)=$P(^GMR(123.1,$P(^GMR(123,GMRCFN,40,ND,0),"^",2),0),"^",1)_$S($P(^(0),"^",2)]"":" BY SERVICE",1:"")
50 I GMRCTRL="OD"!(GMRCTRL="OC") D
51 . N ACTION S ACTION=$P(^GMR(123,GMRCFN,40,ND,0),"^",2) Q:ACTION=""
52 . S ACTION=$$GET1^DIQ(123.1,ACTION,.01)
53 . S $P(NTE(1),"|",4)=ACTION_" BY SERVICE"
54 I $P(NTE(1),"|",4)="",GMRCTRL="XX" S $P(NTE(1),"|",4)=$P(^GMR(123.1,$P(^GMR(123,GMRCFN,40,ND,0),"^",2),0),"^",1)_" "_$S($P(^GMR(123,GMRCFN,40,ND,0),"^",6)]"":$P(^GMR(123.5,$P(^GMR(123,GMRCFN,40,ND,0),"^",6),0),"^",1),1:GMRCSSNM)
55 K N,ND1,ND2
56 Q
57OBR(GMRCIEN,RESBY,GMRCACDT) ;Build the OBR segment of the HL-7 message
58 ;GMRCIEN=IEN of the consult from file 123
59 ;NOTIFY=Person who is notified when consult is ordered/completed
60 ;RESBY=Person entering/interpreting result & signing report- GMRCPROV
61 K OBR
62 N OI,PROCID,PROCNM,STS,RESTATUS,SERVID,ORCDT,CONLOC,CONSVC,HL7DT
63 ;I +$P(^GMR(123,GMRCIEN,0),"^",5)'>0,$S($D(GMRCSSNM):1,+GMRCGRP("ROOT"):1,1:0) S $P(^(0),"^",5)=$S(+GMRCGRP("ROOT"):GMRCGRP("ROOT"),1:$O(^GMR(123.5,"B",GMRCSSNM,0)))
64 S STS=$P(^GMR(123,GMRCIEN,0),"^",12),RESTATUS=$S(STS=1:"X",STS=2:"F",STS=5:"O",STS=6:"I",STS=8:"S",STS=9:"R",1:"X")
65 S SERVID=$P(^GMR(123,GMRCIEN,0),"^",5),ORCDT=$P(^(0),"^",7),CONLOC=$P(^(0),"^",10) I CONLOC]"" S CONLOC=$S($P(^ORD(101,CONLOC,0),"^",1)["BEDSIDE":"B",$P(^(0),"^",1)["EMERGENCY":"E",1:"OC")
66 S NOTIFY=$P(^GMR(123,GMRCIEN,0),"^",11),CONSVC=$S(+SERVID]"":$P($G(^GMR(123.5,+SERVID,0)),"^",1),1:"")
67 I +$P(^GMR(123,+GMRCIEN,0),U,8) D
68 . S PROCID=+$P(^GMR(123,+GMRCIEN,0),U,8)
69 . S PROCNM=$$GET1^DIQ(123.3,PROCID,.01)
70 . S OI=PROCID_U_PROCNM_"^99PRC"
71 I '$D(OI) S OI=SERVID_U_CONSVC_"^99CON"
72 S HL7DT=$$HL7DT^GMRCHL7($S($G(GMRCACDT):GMRCACDT,1:$$NOW^XLFDT))
73 S OBR="OBR||||^^^"_OI_"||||||||||||||"_CONLOC_"|"_NOTIFY_"|||"_HL7DT_"|||"_RESTATUS_$S(RESBY]"":"|||||||"_RESBY,1:"")
74 K STS,RESTATUS,SERVID,ORCDT,CONLOC,CONSVC,HL7DT
75 Q
Note: See TracBrowser for help on using the repository browser.