source: FOIAVistA/tag/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCISEG.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1GMRCISEG ;SLC/JFR - CREATE IFC HL7 SEGMENTS ; 7/26/01 22:15
2 ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
3 Q ;don't enter at top
4BUILD(SEG,PCS) ;create any segment from array in PCS using |^&/~
5 ; SEG = ORC,OBR,etc.
6 ; PCS = array of data elements to be combined into the segement
7 ; array is numbered by the "|" piece
8 N ARR,SEGMNT
9 S ARR=0,SEGMNT=""
10 F S ARR=$O(PCS(ARR)) Q:'ARR D
11 . S $P(SEGMNT,"|",ARR)=PCS(ARR)
12 . Q
13 Q SEG_"|"_SEGMNT
14ORC(GMRCO,GMRCOC,GMRCOS,GMRCACT) ;build ORC for all but new orders
15 ;Input:
16 ; GMRCO = ien from file 123
17 ; GMRCOC = order control
18 ; GMRCOS = order status
19 ; GMRCACT = ien in 40 multiple of particular action
20 ;
21 ;Output:
22 ; ORC segment
23 ;
24 I '$D(GMRCO)!('$D(GMRCOC))!('$D(GMRCACT)) Q "ERROR"
25 N GMRCPCS,SITE,GMRCRP
26 S GMRCPCS(1)=GMRCOC
27 I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D
28 . S GMRCPCS(2)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_"^GMRCIFR"
29 . S GMRCPCS(3)=$P(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($P(^(0),U,23))
30 . S GMRCPCS(3)=GMRCPCS(3)_"^GMRCIFC"
31 I $P($G(^GMR(123,GMRCO,12)),U,5)="F" D
32 . S GMRCPCS(2)=$P(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($P(^(0),U,23))
33 . S GMRCPCS(2)=GMRCPCS(2)_"^GMRCIFR"
34 . S GMRCPCS(3)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_"^GMRCIFC"
35 S GMRCPCS(5)=$S($D(GMRCOS):GMRCOS,1:"")
36 I GMRCOC["X" S $P(GMRCPCS(7),U,6)=$$URG^GMRCIUTL(GMRCO)
37 S GMRCPCS(9)=$$FMTHL7^XLFDT($P(^GMR(123,GMRCO,40,GMRCACT,0),U,1))
38 S GMRCPCS(10)=$$HLNAME^GMRCIUTL($P(^GMR(123,GMRCO,40,GMRCACT,0),U,5))
39 S GMRCRP=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,4) I +GMRCRP D
40 . S GMRCPCS(12)=$$HLNAME^GMRCIUTL(GMRCRP)
41 . N GMRCPHN,GMRCPAG
42 . S GMRCPHN=$$GET1^DIQ(200,GMRCRP,.132)
43 . S GMRCPAG=$$GET1^DIQ(200,GMRCRP,.138)
44 . S GMRCPCS(14)=$$HLPHONE^HLFNC(GMRCPHN,GMRCPAG)
45 S GMRCPCS(15)=$$FMTHL7^XLFDT($P(^GMR(123,GMRCO,40,GMRCACT,0),U,3))
46 I GMRCOC["X"!(GMRCOC="SC")!(GMRCOC="RE") D
47 . I GMRCOC="XX" D Q
48 .. I $P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)=25 D Q
49 ... S GMRCPCS(16)="FI^FORWARD TO IFC^99GMRC"
50 .. S GMRCPCS(16)="F^FORWARD^99GMRC"
51 . I GMRCOC="XO" S GMRCPCS(16)="E^EDIT-RESUBMIT^99GMRC" Q
52 . I GMRCOC="SC" D Q
53 .. I GMRCOS="IP" S GMRCPCS(16)="R^RECEIVE^99GMRC"
54 .. I GMRCOS="SC" S GMRCPCS(16)="SC^SCHEDULE^99GMRC"
55 . I GMRCOC="RE" D
56 .. N ACTVT S ACTVT=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)
57 .. I ACTVT=12 S GMRCPCS(16)="D^DISASSOCIATE RESULT^99GMRC"
58 .. I ACTVT=13 S GMRCPCS(16)="A^ADDENDUM^99GMRC"
59 .. I ACTVT=4 S GMRCPCS(16)="S^SIGNIFICANT FINDING^99GMRC"
60 . Q
61 S SITE=$$SITE^VASITE
62 I +SITE S GMRCPCS(17)=$P(SITE,U,3)_U_$P(SITE,U,2) ;use loc instead? ;-(
63 Q $$BUILD^GMRCISEG("ORC",.GMRCPCS)
64 ;
65OBXWP(GMRCO,GMRCOC,GMRCACT,GMRCSEG) ; return a WP field in OBX segs
66 ; Input:
67 ; GMRCO =
68 ; GMRCOC =
69 ; GMRCACT = activity in 40 mult triggering msg
70 ; GMRCSEG = GLOBAL array to return results in
71 ;
72 ; Output:
73 ; ARRAY(1)=OBX|1|TX|coding scheme|1|text||||||obs result status
74 ; ARRAY(2)=OBX|1|TX|coding scheme|2|text||||||obs result status
75 ;
76 K ^TMP("GMRCWP",$J)
77 N GMRCPCS
78 I GMRCOC="NW"!(GMRCOC="XO") D Q
79 . N SUBS S SUBS=0
80 . F S SUBS=$O(^GMR(123,GMRCO,20,SUBS)) Q:'SUBS D
81 .. S GMRCPCS(1)=1,GMRCPCS(2)="TX"
82 .. S GMRCPCS(3)="2000.02^REASON FOR REQUEST^AS4",GMRCPCS(4)=SUBS
83 .. S GMRCPCS(5)=$G(^GMR(123,GMRCO,20,SUBS,0)),GMRCPCS(11)="O"
84 .. S ^TMP("GMRCWP",$J,SUBS)=$$BUILD^GMRCISEG("OBX",.GMRCPCS)
85 . M @GMRCSEG=^TMP("GMRCWP",$J)
86 . K ^TMP("GMRCWP",$J)
87 . Q
88 I '$D(GMRCACT)!('$D(^GMR(123,GMRCO,40,GMRCACT,1))) Q
89 N CMT,ACTVT
90 S CMT=0,ACTVT=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)
91 F S CMT=$O(^GMR(123,GMRCO,40,GMRCACT,1,CMT)) Q:'CMT D
92 . S GMRCPCS(1)=3,GMRCPCS(2)="TX"
93 . S GMRCPCS(3)="^COMMENTS^",GMRCPCS(4)=CMT
94 . S GMRCPCS(5)=$G(^GMR(123,GMRCO,40,GMRCACT,1,CMT,0))
95 . S GMRCPCS(11)=$S(ACTVT=10:"F",1:"P") ;F if an admin comp. else "P"
96 . S ^TMP("GMRCWP",$J,CMT)=$$BUILD^GMRCISEG("OBX",.GMRCPCS)
97 M @GMRCSEG=^TMP("GMRCWP",$J)
98 K ^TMP("GMRCWP",$J)
99 Q
100 ;
101OBXRSLT(GMRCO,GMRCACT) ; build an OBX segment to send a TIU doc reference
102 ; Input:
103 ; GMRCO = ien from file 123
104 ; GMRCACT = activity entry in 40 multiple
105 ;
106 ; Output:
107 ; OBX segment
108 ; e.g. OBX|4|RP|^TIU DOC^VA8925||41320^TIU^660||||||||F
109 ;
110 Q:'$D(^GMR(123,GMRCO,40,GMRCACT)) ""
111 N GMRCPCS,RSLT,GMRCACTV
112 S GMRCPCS(1)=4,GMRCPCS(2)="RP"
113 S GMRCPCS(4)=1
114 S GMRCACTV=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)
115 S RSLT=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,9)
116 I RSLT["TIU" D
117 . S GMRCPCS(3)="^TIU DOC^VA8925"
118 . S GMRCPCS(5)=+RSLT_"^TIU DOCUMENT^"_$$STA^XUAF4($$KSP^XUPARAM("INST"))
119 I RSLT["MCAR" D
120 . N MCPRNM S MCPRNM=$P($$SINGLE^MCAPI(RSLT),U)
121 . S GMRCPCS(3)="^MED RSLT^VA"_+$P(RSLT,"MCAR(",2)
122 . S GMRCPCS(5)=+RSLT_U_MCPRNM_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))
123 S GMRCPCS(11)=$S(GMRCACTV=9:"S",GMRCACTV=12:"D",1:"F")
124 Q $$BUILD^GMRCISEG("OBX",.GMRCPCS)
125 ;
126NTE(GMRCO,GMRCACT,GMRCAR) ;format an NTE seg with DC comment
127 ; Input:
128 ; GMRCO = ien from file 123
129 ; GMRCACT = activity entry in 40 multiple
130 ; GMRCAR = array in which to pass back NTE segs
131 ;
132 ; Output:
133 ; array of NTE segments containing the comment
134 ; e.g. NTE|1|L|cancelled by requestor
135 ;
136 Q:'$D(^GMR(123,GMRCO,40,GMRCACT,1))
137 N CMT,GMRCPCS S CMT=0
138 F S CMT=$O(^GMR(123,GMRCO,40,GMRCACT,1,CMT)) Q:'CMT D
139 . S GMRCPCS(1)=CMT,GMRCPCS(2)="L"
140 . S GMRCPCS(3)=$G(^GMR(123,GMRCO,40,GMRCACT,1,CMT,0))
141 . S GMRCAR(CMT)=$$BUILD^GMRCISEG("NTE",.GMRCPCS)
142 Q
143 ;
144MSA(GMRCAC,GMRCMSG,GMRCERR) ; build MSA for response to placer activity
145 ; Input:
146 ; GMRCAC = acknowledgment code (AA or AR)
147 ; GMRCMSG = message number from incoming msg being responded to
148 ; GMRCERR = error message if can't accept the activity
149 ;
150 ; Output:
151 ; MSA segment to include with ACK or NAK
152 ;
153 N GMRCPCS
154 S GMRCPCS(1)=GMRCAC
155 S GMRCPCS(2)=GMRCMSG
156 S GMRCPCS(3)=$G(GMRCERR)
157 Q $$BUILD^GMRCISEG("MSA",.GMRCPCS)
158 ;
159OBXTZ() ;build and return an OBX with the current TIME ZONE encoded
160 ;Input:
161 ; none
162 ;
163 ;Output:
164 ; OBX segment in the format:
165 ; OBX|5|CE|^TIME ZONE^VA4.4|1|MST||||||O
166 ;
167 N GMRCPCS
168 S GMRCPCS(1)=5,GMRCPCS(2)="CE"
169 S GMRCPCS(3)="^TIME ZONE^VA4.4",GMRCPCS(4)=1
170 S GMRCPCS(5)=$$GET1^DIQ(4.3,1,1)
171 Q $$BUILD^GMRCISEG("OBX",.GMRCPCS)
172 ;
173OBXSF(GMRCO) ; build OBX seg for Sig. Find.
174 ; Input:
175 ; GMRCO = ien from file 123
176 ;
177 ; Output:
178 ; OBX segment in format:
179 ; OBX|6|TX|^SIG FINDINGS^|1|S||||||O
180 ;
181 I '$L($P(^GMR(123,GMRCO,0),U,19)) Q ""
182 N GMRCPCS
183 S GMRCPCS(1)=6,GMRCPCS(2)="TX",GMRCPCS(3)="^SIG FINDINGS^"
184 S GMRCPCS(4)=1,GMRCPCS(5)=$P(^GMR(123,GMRCO,0),U,19),GMRCPCS(11)="O"
185 Q $$BUILD^GMRCISEG("OBX",.GMRCPCS)
Note: See TracBrowser for help on using the repository browser.