source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCCP.m@ 1607

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1GMRCCP ;SLC/JFR - utilities for clinical procedures; 10/07/04 15:24
2 ;;3.0;CONSULT/REQUEST TRACKING;**17,25,37,55**;DEC 27, 1997;Build 4
3 ;
4 ; This routine invokes IAs #3378,#3468
5 ;
6 Q
7CPLIST(GMRCPT,GMRCPR,GMRCRET) ;return list of patient CP requests
8 ; Input:
9 ; GMRCPT = patient DFN (required)
10 ; GMRCPR = ien from file 702.01 (optional)
11 ; if just one procedure
12 ; desired; defaults to all
13 ; GMRCRET= global array in which to (required)
14 ; return results
15 ;
16 ; Output:
17 ; ^global(array)=
18 ; date of request^CP DEF nam^urgency^status^cons #^CP DEF ien
19 ;
20 N GMRCDA,COUNT
21 S COUNT=1
22 I '$G(GMRCPT)!('$D(GMRCRET)) Q
23 I $G(GMRCPR) D
24 . S GMRCDA=0
25 . F S GMRCDA=$O(^GMR(123,"ACP",GMRCPR,GMRCPT,GMRCDA)) Q:'GMRCDA D
26 .. I '$$EXTDATA^MDAPI(GMRCPR) Q ; if no ext. data, don't send
27 .. D LOADAR(GMRCDA,GMRCRET,COUNT) S COUNT=COUNT+1
28 . Q
29 I '$G(GMRCPR) S GMRCPR=0 D
30 . F S GMRCPR=$O(^GMR(123,"ACP",GMRCPR)) Q:'GMRCPR D
31 .. I '$$EXTDATA^MDAPI(GMRCPR) Q ;don't send if no ext. data
32 .. S GMRCDA=0
33 .. F S GMRCDA=$O(^GMR(123,"ACP",GMRCPR,GMRCPT,GMRCDA)) Q:'GMRCDA D
34 ... D LOADAR(GMRCDA,GMRCRET,COUNT) S COUNT=COUNT+1
35 .. Q
36 . Q
37 Q
38 ;
39LOADAR(IEN,GMRCAR,CNT) ;set up array and return data for given file 123 ien
40 N GMRCDT,GMRCCP,GMRCUR,STS,GMRC,GMRCCPI
41 Q:'$D(^GMR(123,IEN,0))
42 Q:'+$G(^GMR(123,IEN,1))
43 S GMRC(0)=^GMR(123,IEN,0)
44 S GMRCDT=$P(GMRC(0),U,7)
45 S GMRCCPI=+^GMR(123,IEN,1)
46 S GMRCCP=$$GET1^DIQ(702.01,GMRCCPI,.01)
47 S GMRCUR=$$GET1^DIQ(101,+$P(GMRC(0),U,9),1)
48 S STS=$$GET1^DIQ(100.01,+$P(GMRC(0),U,12),.1)
49 S @(GMRCAR)@(CNT)=GMRCDT_U_GMRCCP_U_GMRCUR_U_STS_U_IEN_U_GMRCCPI
50 Q
51 ;
52CPROC(PROC) ;is orderable procedure mapped to Clinical Procedures
53 Q +$P($G(^GMR(123.3,PROC,0)),U,4)
54CPLINK(PROC) ;check "AC" x-ref to see if PROC is linked to entry in 123.3
55 ; PROC - ien from 702.01
56 Q $E($D(^GMR(123.3,"AC",+PROC)),1)
57CPLINKS(NAMES,PROC) ;return list of procedure names linked to a CP
58 ; Input
59 ; PROC - ien from PROCEDURE DEFINITION (#702.01) - (required)
60 ; Output:
61 ; NAMES - passed by reference
62 ; returned as array of GMRC PROCEDUREs linked to PROC
63 ; in format;
64 ; NAMES(x)=GMRC PROCEDURE name^GMRC PROCEDURE ien
65 ; NAMES(1)="EKG^21"
66 ; NAMES(2)="EKG PORTABLE^32"
67 ; if not currently linked, returned as:
68 ; NAMES(1)="-1^not currently linked"
69 N GMRCPR,I
70 S I=1,GMRCPR=0
71 F S GMRCPR=$O(^GMR(123.3,"AC",PROC,GMRCPR)) Q:'GMRCPR D
72 . S NAMES(I)=$P($G(^GMR(123.3,GMRCPR,0)),U)_U_GMRCPR
73 . S I=I+1
74 I '$D(NAMES(1)) S NAMES(1)="-1^not currently linked"
75 Q
76CPDOC(GMRCDA,TIUDA,ACTION) ;update file 123 entry with CLIN PROC DOC
77 ; Input:
78 ; GMRCDA = ien from file 123
79 ; TIUDA = ien from file 8925
80 ; ACTION = 1 - associate stub record
81 ; = 2 - partial results ready
82 ; = 3 - retract record
83 ;
84 ; Output:
85 ; 1 = successful
86 ; 0^error = unsuccessful^problem
87 ;
88 ;
89 N QVAL,GMRCADUZ
90 I '$D(^GMR(123,+GMRCDA,0)) Q "0^Invalid procedure record"
91 I '$G(ACTION) Q "0^Invalid action code"
92 I '$G(TIUDA) Q "0^No document to associate"
93 S QVAL=""
94 I ACTION=1 D Q QVAL
95 . S QVAL="0^Not a current API implementation"
96 . Q
97 I ACTION=2 D Q QVAL
98 . N GMRCCPA
99 . I $D(^GMR(123,+GMRCDA,50,"B",TIUDA_";TIU(8925")) Q
100 . S GMRCCPA=1 ; tell audit trail it's coming from CP ; slc/jfr 1/15/03
101 . D GET^GMRCTIU(+GMRCDA,TIUDA,"INCOMPLETE") ;update to pr
102 . D EN^GMRCT(+$P(^GMR(123,+GMRCDA,0),U,5)) ;get svc notif recips
103 . I $D(GMRCADUZ) D
104 .. N MSG,GMRCDFN,GMRCREF
105 .. S MSG="Procedure ready for interpretation"
106 .. S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
107 .. S GMRCREF=+GMRCDA_"|"_+TIUDA_";TIU(8925,"
108 .. D MSG^GMRCP(GMRCDFN,MSG,GMRCREF,66,.GMRCADUZ,0) ;send #66 alert
109 . S QVAL="1"
110 . Q
111 I ACTION=3 D Q QVAL
112 . I '$D(^GMR(123,+GMRCDA,50,"B",TIUDA_";TIU(8925")) D Q
113 .. S QVAL="0^Not an associated document"
114 . D ROLLBACK^GMRCTIU1(+GMRCDA,+TIUDA)
115 . S QVAL=1
116 . Q
117 Q
118CPACTM(GMRCDA) ;return actions available for a CP request
119 ;Input:
120 ; GMRCDA = file 123 ien
121 ;Output:
122 ; 0 = not a CP request or TIU*1*109 not present
123 ; 1 = CP request but no instrument report expected
124 ; 2 = CP and still waiting on instr. or images
125 ; 3 = CP and incomplete CP doc attached
126 ; 4 = CP and complete CP doc attached
127 ;
128 N EXTDTA,CPDOC
129 I '$$PATCH^XPDUTL("TIU*1.0*109") Q 0
130 I '$G(^GMR(123,GMRCDA,1)) Q 0
131 S EXTDTA=$$EXTDATA^MDAPI(+^GMR(123,GMRCDA,1))
132 S CPDOC=$G(^GMR(123,GMRCDA,50,+$O(^GMR(123,GMRCDA,50,0)),0))
133 I 'EXTDTA,'+CPDOC Q 1 ;no ext & no stub
134 I EXTDTA,'+CPDOC Q 2 ;ext data & no data
135 I $$GET1^DIQ(8925,+CPDOC,.05)'="COMPLETED" Q 3 ;partial results
136 Q 4 ;CP is done, allow additional CP titles
137 ;
138CPINTERP(GMRCTIU,GMRCUSER) ;is user an interpreter for TIU doc GMRCTIU
139 ;
140 ; Input:
141 ; GMRCTIU = ien from file 8925
142 ; GMRCUSER = DUZ of person to evaluate
143 ;
144 ; Output:
145 ; 1 = GMRCUSER is an interpreter
146 ; 0 = GMRCUSER is NOT an interpreter
147 ;
148 N GMRCSRV,GMRCDA,GMRCINT
149 S GMRCDA=$O(^GMR(123,"R",GMRCTIU_";TIU(8925,",0))
150 I 'GMRCDA Q 0 ;TIU doc not attached
151 S GMRCSRV=$P(^GMR(123,+GMRCDA,0),U,5)
152 I 'GMRCSRV Q 0 ;no service, can't tell if interpreter
153 S GMRCINT=+$$VALID^GMRCAU(GMRCSRV,,GMRCUSER) ;get upd authority
154 Q $S(GMRCINT=1:1,GMRCINT=2:1,GMRCINT=4:1,1:0) ;1=unrstrctd (upd) user, 2=upd user, 4=adm & upd user
155 ;
156CPPAT(GMRCDA,GMRCDFN) ;is patient object of given request?
157 ; Input:
158 ; GMRCDA = ien from file 123
159 ; GMRCDFN = patient DFN
160 ;
161 ; Output:
162 ; 1 = patient is object of request GMRCDA
163 ; 0 = patient is NOT object of request in GMRCDA
164 I $P($G(^GMR(123,GMRCDA,0)),U,2)'=GMRCDFN Q 0
165 Q 1
166 ;
167MCCNVT(GMRCMOD,GMRCMC,GMRCTIU) ;convert MC pointer to TIU pointer in file 123
168 ;Input:
169 ; GMRCMOD = boolean 1 (convert if found) or 0 (test conversion)
170 ; GMRCMC = var;ptr to a Medicine package result
171 ; GMRCTIU = ptr to file 8925
172 ;
173 ;Output:
174 ; -1^Description of error
175 ; 0^No Action needed
176 ; 1^Success message^Consult IEN
177 ;
178 I '$D(GMRCMOD) Q "-1^Mode unknown"
179 I '$G(GMRCMC) Q "-1^No MC results sent"
180 N GMRCIEN,GMRCRIEN,GMRCACT,GMRCERR,FDA
181 S GMRCIEN=$O(^GMR(123,"R",GMRCMC,0))
182 I 'GMRCIEN Q "0^No action needed"
183 I GMRCMOD=0 Q "1^Not converted^"_GMRCIEN
184 I '$G(GMRCTIU) Q "-1^No TIU ref sent"
185 S GMRCRIEN=$O(^GMR(123,"R",GMRCMC,GMRCIEN,0))
186 S FDA(1,123.03,GMRCRIEN_","_GMRCIEN_",",.01)=GMRCTIU_";TIU(8925,"
187 D FILE^DIE("K","FDA(1)","GMRCERR")
188 I $D(GMRCERR) Q "-1^Unable to convert"
189 ; rest of field conversions
190 I $P(^GMR(123,GMRCIEN,0),U,15)=GMRCMC D
191 . S FDA(1,123,GMRCIEN_",",11)="@"
192 . D FILE^DIE("K","FDA(1)","GMRCERR")
193 ;
194 S GMRCACT=0
195 F S GMRCACT=$O(^GMR(123,GMRCIEN,40,GMRCACT)) Q:'GMRCACT D
196 . I $P(^GMR(123,GMRCIEN,40,GMRCACT,0),U,9)'=GMRCMC Q ;no need to chg
197 . K FDA,GMRCERR
198 . S FDA(1,123.02,GMRCACT_","_GMRCIEN_",",9)=GMRCTIU_";TIU(8925,"
199 . D FILE^DIE("K","FDA(1)","GMRCERR")
200 ; NO IFC implications at this time
201 Q "1^Successfully converted^"_GMRCIEN
202 ;
203 Q
Note: See TracBrowser for help on using the repository browser.