source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCISG1.m@ 1608

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

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
[613]1GMRCISG1 ;SLC/JFR - BUILD IFC HL7 SEGMENTS CONT'D ;10/31/01 09:00
2 ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
3 Q ;can't start here
4ORCRESP(GMRCO,GMRCOC,GMRCOS) ;build ORC for app ACK msgs
5 ; Input:
6 ; GMRCO = ien from file 123 of entry responding to
7 ; GMRCOC = order control to put into segment
8 ; GMRCOS = HL7 encoded order status to put in message
9 ;
10 ; Output:
11 ; ORC segment to use in response message
12 ;
13 N GMRCPCS,SITE
14 S GMRCPCS(1)=GMRCOC
15 S GMRCPCS(2)=$P(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($P(^(0),U,23))_"^GMRCIFR"
16 S GMRCPCS(3)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_"^GMRCIFC"
17 S GMRCPCS(5)=$G(GMRCOS)
18 S GMRCPCS(17)=$$STA^XUAF4($$KSP^XUPARAM("INST"))
19 Q $$BUILD^GMRCISEG("ORC",.GMRCPCS)
20 ;
21NWORC(GMRCO) ; build ORC seg for a new order
22 ; Input:
23 ; GMRCO = ien from file 123 of order to send remotely
24 ;
25 ; Output:
26 ; ORC segment to send with a new order to remote facility
27 ;
28 N GMRCPCS,SITE,GMRCPHN,GMRCPAG
29 S GMRCPCS(1)="NW"
30 S GMRCPCS(2)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_U_"GMRCIFR"
31 S $P(GMRCPCS(7),U,6)=$$URG^GMRCIUTL(GMRCO)
32 S GMRCPCS(9)=$$FMTHL7^XLFDT(+^GMR(123,GMRCO,0))
33 S GMRCPCS(10)=$$HLNAME^GMRCIUTL($P($G(^GMR(123,GMRCO,40,1,0)),U,5))
34 S GMRCPCS(12)=$$HLNAME^GMRCIUTL($P(^GMR(123,GMRCO,0),U,14))
35 S GMRCPHN=$$GET1^DIQ(200,$P(^GMR(123,GMRCO,0),U,14),.132)
36 S GMRCPAG=$$GET1^DIQ(200,$P(^GMR(123,GMRCO,0),U,14),.138)
37 S GMRCPCS(14)=$$HLPHONE^HLFNC(GMRCPHN,GMRCPAG)
38 S GMRCPCS(15)=$$FMTHL7^XLFDT($P(^GMR(123,GMRCO,0),U,7))
39 I $O(^GMR(123,GMRCO,40,1)) D
40 . N I,ACTV S I=1
41 . F S I=$O(^GMR(123,GMRCO,40,I)) Q:'I S ACTV=$P(^(I,0),U,2) D
42 .. I ACTV'=25 Q
43 .. S GMRCPCS(16)="FI^FORWARD TO IFC^99GMRC"
44 S SITE=$$SITE^VASITE
45 I +SITE S GMRCPCS(17)=$P(SITE,U,3)_U_$P(SITE,U,2) ;use loc instead? ;-(
46 Q $$BUILD^GMRCISEG("ORC",.GMRCPCS)
47OBXPD(GMRCO) ; create OBX segment for the prov. dx
48 ; Input:
49 ; GMRCO = ien from file 123 of order to send remotely
50 ;
51 ; Output:
52 ; OBX segment containing the Provisional Diagnosis
53 ;
54 Q:'$L($G(^GMR(123,GMRCO,30))) ""
55 N GMRCPCS
56 S GMRCPCS(1)=2,GMRCPCS(2)=$S($L($G(^GMR(123,GMRCO,30.1))):"CE",1:"TX")
57 S GMRCPCS(3)="^PROVISIONAL DIAGNOSIS^",GMRCPCS(4)=1
58 S GMRCPCS(11)="O"
59 I $L($G(^GMR(123,GMRCO,30.1))) D Q $$BUILD^GMRCISEG("OBX",.GMRCPCS)
60 . ;coded diagnosis
61 . S GMRCPCS(5)=$G(^GMR(123,GMRCO,30.1))_U_$G(^(30))_U_"I9C"
62 S GMRCPCS(5)=U_$G(^GMR(123,GMRCO,30))_U ;free text dx
63 Q $$BUILD^GMRCISEG("OBX",.GMRCPCS)
64 ;
65OBR(GMRCO,GMRCACT) ; build an OBR seg for new order or resubmit
66 ; Input:
67 ; GMRCO = ien from file 123
68 ; GMRCACT = ien from 40 multiple of action (only on resubmit or fwd)
69 ;
70 ; Output:
71 ; OBR segment
72 ;
73 N GMRCPCS,GMRCROL
74 S GMRCPCS(1)=1
75 S GMRCROL=$P(^GMR(123,GMRCO,12),U,5)
76 I GMRCROL="P" D
77 . S GMRCPCS(2)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_U_"GMRCIFR"
78 I $D(GMRCACT) D ; resubmit sends filler # too
79 . I GMRCROL="P" D
80 .. S GMRCPCS(3)=$P(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($P(^(0),U,23))
81 .. S GMRCPCS(3)=GMRCPCS(3)_U_"GMRCIFC"
82 . I GMRCROL="F" D
83 .. S GMRCPCS(2)=$P(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($P(^(0),U,23))
84 .. S GMRCPCS(2)=GMRCPCS(2)_U_"GMRCIFR"
85 .. S GMRCPCS(3)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_U_"GMRCIFC"
86 I $D(GMRCACT),$P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)=17 D
87 . ;FWD uses txt of current svc
88 . N SITE,SERVNM,SERV
89 . S SITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))_"VA1235"
90 . I GMRCROL="F" S SERV=$P(^GMR(123,GMRCO,0),U,5)
91 . I GMRCROL="P" S SERV=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,6)
92 . S SERVNM=$S(+SERV:$P(^GMR(123.5,SERV,0),U),1:"")
93 . S GMRCPCS(4)=SERV_U_SERVNM_U_SITE
94 I $D(GMRCACT),$P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)=25 D
95 . ;FWD to IFC uses the FORWARDED FROM service name
96 . N SITE,SERVNM,SERV
97 . S SITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))_"VA1235"
98 . S SERV=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,6)
99 . I '+SERV Q
100 . S SERVNM=$P(^GMR(123.5,SERV,0),U)
101 . S GMRCPCS(4)=SERV_U_SERVNM_U_SITE
102 I '$D(GMRCPCS(4)) D
103 . S GMRCPCS(4)=$$CODEOI^GMRCIUTL(GMRCO) ;get remote service or proc
104 I $D(GMRCACT) D ;resubmit or fwd so use activity fields for msg
105 . S GMRCPCS(6)=$$FMTHL7^XLFDT($P(^GMR(123,GMRCO,40,GMRCACT,0),U,3))
106 . S GMRCPCS(16)=$$HLNAME^GMRCIUTL($P(^GMR(123,GMRCO,40,GMRCACT,0),U,4))
107 I '$D(GMRCACT) D ; new order being sent
108 . S GMRCPCS(6)=$$FMTHL7^XLFDT($P(^GMR(123,GMRCO,0),U,7))
109 . S GMRCPCS(16)=$$HLNAME^GMRCIUTL($P(^GMR(123,GMRCO,0),U,14))
110 S GMRCPCS(18)=$P(^GMR(123,GMRCO,0),U,18)
111 Q $$BUILD^GMRCISEG("OBR",.GMRCPCS)
112 ;
113ORCTST() ;build ORC for testing imp.
114 ;Input:
115 ;
116 ;Output:
117 ; ORC segment used to test IFC implementation
118 ;
119 N GMRCPCS,SITE,GMRCRP
120 S GMRCPCS(1)="NW"
121 S GMRCPCS(2)="TST1234"_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_"^GMRCIFR"
122 S GMRCPCS(9)=$$FMTHL7^XLFDT($$NOW^XLFDT)
123 S GMRCPCS(10)="PUBLIC^JOHN^Q"
124 S GMRCPCS(16)="T^TESTING^99GMRC"
125 Q $$BUILD^GMRCISEG("ORC",.GMRCPCS)
126 ;
127 ;
128OBRTST(GMRCOI,GMRCTYP) ; build OBR seg for testing imp.
129 ; Input:
130 ; GMRCOI = ien from file 123.5 or 123.3
131 ; GMRCTYP = "P" or "C" (procedure or consult service)
132 ;
133 ; Output:
134 ; OBR segment used to test implementation
135 ;
136 N GMRCPCS,SITE
137 S SITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))
138 S GMRCPCS(1)=1
139 S GMRCPCS(2)="TST1234"_U_SITE_"^GMRCIFR"
140 I GMRCTYP="C" D
141 . N SERV
142 . S SERV=$P(^GMR(123.5,GMRCOI,"IFC"),U,2)
143 . S GMRCPCS(4)=GMRCOI_U_SERV_U_SITE_"VA1235"
144 I GMRCTYP="P" D
145 . N PROC
146 . S PROC=$P(^GMR(123.3,GMRCOI,"IFC"),U,2)
147 . S GMRCPCS(4)=GMRCOI_U_PROC_U_SITE_"VA1233"
148 Q $$BUILD^GMRCISEG("OBR",.GMRCPCS)
149 ;
Note: See TracBrowser for help on using the repository browser.