source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDAPI.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 9.5 KB
Line 
1MDAPI ; HOIFO/DP/NCA - CP API Calls ; [05-05-2003 10:28]
2 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
3 ; Description:
4 ; These API's are for use by external packages communicating with CP.
5 ;
6 ; Integration Agreements:
7 ; IA# 3378 [Subscription] Documents the APIs that external packages use to communicate with CP.
8 ; IA# 3468 [Subscription] Use GMRCCP APIs.
9 ;
10EXTDATA(MDPROC) ; [Procedure]
11 ; Returns 0/1 for external data needed
12 ; Called by Consults to determine status of consult ordered
13 ;
14 ; Input parameters
15 ; 1. MDPROC [Literal/Required] CP Definition IEN
16 ;
17 Q:'$D(^MDS(702.01,+$G(MDPROC),0)) 0
18 I +$P(^MDS(702.01,+$G(MDPROC),0),U,3)!($O(^(.1,0))) Q 1
19 E Q 0
20 ;
21ISTAT(MDARR) ; [Procedure] Called by Imaging to update status
22 ; Input parameters
23 ; 1. MDARR [Literal/Required] Array from Imaging
24 ;
25 ; Input: MDARR(0)="0^error message" or "1^success message"
26 ; MDARR(1)=TrackID (CP;Transaction IEN)
27 ; MDARR(2)=Queue Number
28 ; MDARR(3..N)=Warnings
29 N MDCON,MDCR,MDIEN,MDIENS,MDLP,MDSTAT,MDSTR,MDTIU,RESULTS
30 Q:$G(MDARR(0))=""
31 Q:$G(MDARR(1))=""
32 Q:$P(MDARR(1),";")'="CP"
33 Q:'(+$P(MDARR(1),";",2))
34 S MDIEN=+$P(MDARR(1),";",2),MDIENS=MDIEN_","
35 S MDSTAT=+$P(MDARR(0),"^")
36 S DATA("TRANSACTION")=MDIEN
37 ; Is it in error?
38 I 'MDSTAT D Q
39 .D STATUS^MDRPCOT(MDIENS,2,$P(MDARR(0),"^",2))
40 .S DATA("PKG")="IMAGING"
41 .S DATA("MESSAGE")=$P(MDARR(0),"^",2) D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
42 .F MDLP=2:0 S MDLP=$O(MDARR(MDLP)) Q:'MDLP I $G(MDARR(MDLP))'="" D
43 ..S DATA("MESSAGE")=$$TRANS(MDARR(MDLP)) D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
44 .D IMGSTAT^MDRPCOT1(+MDIENS,2) Q
45 ; Call Consults that Partial Result ready
46 S MDCON=+$P(^MDD(702,MDIEN,0),"^",5),MDTIU=+$P(^(0),"^",6)
47 S MDCR=$$UPDCONS^MDRPCOT1(MDCON,MDTIU)
48 I +MDCR<0 D Q
49 .D STATUS^MDRPCOT(MDIENS,2,$P(MDCR,"^",2))
50 .S DATA("PKG")="CONSULTS",DATA("MESSAGE")=$P(MDCR,"^",2)
51 .D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
52 .Q
53 ; Closeout the record
54 D STATUS^MDRPCOT(MDIENS,3,"")
55 ; Update Images Status
56 D IMGSTAT^MDRPCOT1(+MDIENS,3)
57 Q
58 ;
59ITIU(RESULTS,DFN,CONSULT,VSTRING) ; [Procedure] API for Vista Imaging
60 ; This API enables VistA Imaging to retrieve/create a TIU note for
61 ; a consult for attaching images to.
62 ;
63 ; RESULTS(0) will equal one of the following
64 ; IEN of the TIU note if successful
65 ; or on failure one of the following status messages
66 ; -1^No patient DFN
67 ; -1^No Consult IEN
68 ; -1^No VString
69 ; -1^Error in CP transaction
70 ; -1^Unable to create CP transaction
71 ; -1^Unable to create the TIU document
72 ; -1^No such consult for this patient.
73 ;
74 ; Input parameters
75 ; 1. RESULTS [Reference/Required] Return array
76 ; 2. DFN [Literal/Required] Patient IEN
77 ; 3. CONSULT [Literal/Required] Consult IEN
78 ; 4. VSTRING [Literal/Optional] VString data for TIU Note (Required to create new TIU note)
79 ;
80 ; Variables:
81 ; MDIEN: [Private] Returns IEN from UPDATE~DIE call
82 ; MDIENS: [Private] Scratch
83 ; MDNOTE: [Private] Scratch
84 ; MDTRANS: [Private] Contains IEN of CP transaction
85 ;
86 ; New private variables
87 NEW MDIEN,MDIENS,MDNOTE,MDTRANS
88 K ^TMP($J),^TMP("MDTIUST",$J)
89 N MDD,MDN,MDTIUER,MDTST,MDNEWV,MDTIUD S (MDTIUD,MDTIUER,MDTST)=""
90 I '$G(DFN) S RESULTS(0)="-1^No patient DFN" Q
91 I '$G(CONSULT) S RESULTS(0)="-1^No Consult IEN" Q
92 ; Look for existing transaction
93 S MDTIUD=$$PREV^MDRPCOT(+CONSULT,"")
94 I +MDTIUD S RESULTS(0)=+MDTIUD Q
95 ; No transaction, must create one for this consult
96 I $G(VSTRING)="" S RESULTS(0)="-1^No VString" Q
97 D CPLIST^GMRCCP(DFN,,$NA(^TMP($J)))
98 S MDX="" F S MDX=$O(^TMP($J,MDX)) Q:'MDX I $P(^(MDX),U,5)=CONSULT D Q
99 .D NOW^%DTC S MDD=%
100 .S:$L(VSTRING,";")=1 VSTRING=";"_VSTRING
101 .S MDNEWV=$$GETVSTR^MDRPCOT1(DFN,VSTRING,$P(^TMP($J,MDX),U,6),MDD)
102 .S MDFDA(702,"+1,",.01)=DFN
103 .S MDFDA(702,"+1,",.02)=MDD
104 .S MDFDA(702,"+1,",.03)=DUZ
105 .S MDFDA(702,"+1,",.04)=$P(^TMP($J,MDX),U,6)
106 .S MDFDA(702,"+1,",.05)=CONSULT
107 .S MDFDA(702,"+1,",.07)=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
108 .S MDFDA(702,"+1,",.09)=0
109 .;Create the new transaction
110 .D UPDATE^DIE("","MDFDA","MDIEN") I '$G(MDIEN(1)) D Q
111 ..S RESULTS(0)="-1^Unable to create CP transaction"
112 .
113 .;Create the new TIU Note
114 .S MDIENS=MDIEN(1)_","
115 .S MDN=$$NEWTIUN^MDRPCOT(+MDIENS)
116 .S MDNOTE=$S(MDN:$$GET1^DIQ(702,+MDIENS,.06,"I"),1:0)
117 .I 'MDNOTE D Q
118 ..N DA,DIK
119 ..S RESULTS(0)="-1^Unable to create the TIU document"
120 ..S DA=+MDIENS,DIK="^MDD(702," D ^DIK
121 .S RESULTS(0)=MDNOTE
122 Q
123 ;
124TIUCOMP(MDNOTE) ; [Procedure] Post Signature action to complete transaction
125 ; Input parameters
126 ; 1. MDNOTE [Literal/Required] TIU IEN
127 ;
128 N MDFDA,MDRES
129 S MDRES=$O(^MDD(702,"ATIU",MDNOTE,0))
130 I $G(^MDD(702,+MDRES,0))="" Q 0
131 I $P($G(^MDD(702,+MDRES,0)),"^",9)=3 Q 1
132 S MDFDA(702,MDRES_",",.09)=3
133 D FILE^DIE("","MDFDA")
134 Q 1
135 ;
136TIUDEL(MDNOTE) ; [Procedure] TIU Note deletion Update
137 ; Input parameters
138 ; 1. MDNOTE [Literal/Required] TIU IEN
139 ;
140 N MDGBL,MDRES,MDFDA,MDTRAN,RESULTS
141 S MDRES="" F S MDRES=$O(^MDD(702,"ATIU",MDNOTE,MDRES)) Q:'MDRES D
142 .Q:$G(^MDD(702,+MDRES,0))=""
143 .;S MDFDA(702,MDRES_",",.05)=""
144 .S MDFDA(702,MDRES_",",.06)=""
145 .D FILE^DIE("","MDFDA")
146 .S MDTRAN=$O(^MDD(702.001,"ASTUDY",MDRES,MDNOTE,0)) I +MDTRAN N DA,DIK S DA=+MDTRAN,DIK="^MDD(702.001," D ^DIK
147 .D STATUS^MDRPCOT(MDRES_",",2,"TIU note deleted.")
148 .S DATA("TRANSACTION")=MDRES,DATA("PKG")="TIU"
149 .S DATA("MESSAGE")="TIU note deleted." D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
150 S MDGBL=$NA(^MDD(702.001,"PK",MDNOTE)) F S MDGBL=$Q(@MDGBL) Q:MDGBL="" Q:$QS(MDGBL,2)'="PK"!($QS(MDGBL,3)'=MDNOTE) S MDTRAN=$QS(MDGBL,6) N DA,DIK S DA=+MDTRAN,DIK="^MDD(702.001," D ^DIK
151 Q 1
152 ;
153TIUREAS(MDFN,MDOLDC,MDANOTE,MDNDFN,MDNEWC,MDNEWV,MDNTIU) ; [Function] This is an API to clean up and update TIU note re-assignment.
154 ; Input parameters
155 ; 1. MDFN [Literal/Required] The Patient DFN whose TIU document is being re-assigned.
156 ; 2. MDOLDC [Literal/Required] The Consult that the note is being re-assigned from.
157 ; 3. MDANOTE [Literal/Required] The TIU Document IEN that is being re-assigned.
158 ; 4. MDNDFN [Literal/Required] The Patient DFN who will be re-assigned the TIU document.
159 ; 5. MDNEWC [Literal/Required] The consult number that will be assignment the TIU document.
160 ; 6. MDNEWV [Literal/Required] The new visit for the TIU document assignment.
161 ; 7. MDNTIU [Literal/Required] The new reassigned TIU document IEN.
162 ;
163 N MDD,MDGBL,MDTRAN,MDCHK,MDLP,MDMULN,MDN,MDPPR,MDREAS,MDTRANI,MDX
164 I '$G(MDFN) Q "0^No DFN for the TIU note re-assignment."
165 I '$G(MDOLDC) Q "0^No Old Consult # for the note re-assignment."
166 I '$G(MDANOTE) Q "0^No TIU Note IEN."
167 I '$G(MDNDFN) Q "0^No New DFN for the note assignment."
168 I '$G(MDNEWC) Q "0^No New Consult # for the note assignment."
169 I '$G(MDNTIU) Q "0^No New Reassigned TIU IEN."
170 S (MDD,MDCHK,MDREAS,MDTRAN)="",MDPPR=0 K ^TMP("MDTMP",$J)
171 S MDTRAN=$O(^MDD(702,"ATIU",MDANOTE,0)) I +MDTRAN S MDCHK=$G(^MDD(702,MDTRAN,0)),MDTRANI=MDTRAN_"," D
172 .I $P(MDCHK,U,5)=MDOLDC&($P(MDCHK,U,6)=MDANOTE) D
173 ..S MDFDA(702,+MDTRAN_",",.06)=""
174 ..D FILE^DIE("","MDFDA") K MDFDA
175 S MDGBL=$NA(^MDD(702.001,"PK",MDANOTE))
176 F S MDGBL=$Q(@MDGBL) Q:MDGBL="" Q:$QS(MDGBL,2)'="PK"!($QS(MDGBL,3)'=MDANOTE) S MDN=$QS(MDGBL,6) N DA,DIK S DA=+MDN,DIK="^MDD(702.001," D ^DIK
177 S MDMULN=+$O(^MDD(702.001,"ASTUDY",+MDTRAN,0))
178 I '+MDMULN I +MDTRAN N DA,DIK S DA=+MDTRAN,DIK="^MDD(702," D ^DIK
179 D NOW^%DTC S MDD=% S MDTRANI=$O(^MDD(702,"ACON",MDNEWC,0))
180 S MDREAS=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
181 I +MDTRANI&(MDNDFN=+$G(^MDD(702,+MDTRANI,0))) D
182 .S MDPPR=$P($G(^MDD(702,+MDTRANI,0)),"^",4) Q:'MDPPR
183 .S MDNEWV=$$GETVSTR^MDRPCOT1(MDNDFN,MDREAS,MDPPR,MDD)
184 .S MDFDA(702,+MDTRANI_",",.06)=MDNTIU
185 .S MDFDA(702,"+1,",.07)=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
186 .D FILE^DIE("","MDFDA") K MDFDA
187 I 'MDPPR D
188 .D CPLIST^GMRCCP(MDNDFN,,$NA(^TMP("MDTMP",$J)))
189 .S MDX=""
190 .F S MDX=$O(^TMP("MDTMP",$J,MDX)) Q:'MDX S:$P(^(MDX),U,5)=MDNEWC MDPPR=$P(^(MDX),U,6)
191 K ^TMP("MDTMP",$J)
192 I +MDPPR Q 1
193 S MDNEWV=$$GETVSTR^MDRPCOT1(MDNDFN,MDREAS,MDPPR,MDD)
194 S MDFDA(702,"+1,",.01)=MDNDFN
195 S MDFDA(702,"+1,",.02)=MDD
196 S MDFDA(702,"+1,",.03)=DUZ
197 S MDFDA(702,"+1,",.04)=MDPPR
198 S MDFDA(702,"+1,",.05)=MDNEWC
199 S MDFDA(702,"+1,",.06)=MDNTIU
200 S MDFDA(702,"+1,",.07)=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
201 S MDFDA(702,"+1,",.09)=0
202 D UPDATE^DIE("","MDFDA")
203 Q 1
204 ;
205TRANS(STR) ; [Function] Translate the upper arrows to blanks
206 ; Input parameters
207 ; 1. STR [Literal/Required] Input: Text with upper arrows that needs to be removed
208 ;
209 I STR["^" Q $TR(STR,"^"," ")
210 Q STR
211 ;
212GETCP(RESULTS,MDCSLT) ; API to return CP Study data
213 ; Input Parameters:
214 ; 1. RESULTS [Literal/Required] Return Array
215 ; 2. MDCSLT [Literal/Required] Consult number
216 ;
217 ; Output:
218 ; RESULTS(0)=-1^Error Message or 1 for success
219 ; (N,1)=CP Study Number
220 ; (N,2)=Patient DFN
221 ; (N,3)=Created Date/Time
222 ; (N,4)=Created By
223 ; (N,5)=CP Definition (External Name)
224 ; (N,6)=Consult Number
225 ; (N,7)=TIU Note IEN
226 ; (N,8)=VSTR
227 ; (N,9)=Transaction Status
228 ;
229 ; Where N = 1..n entries
230 ;
231 N MDCT,MDX,MDY
232 I '$G(MDCSLT) S @RESULTS@(0)="-1^No Consult Number passed" Q
233 S MDX=$O(^MDD(702,"ACON",MDCSLT,0)) I 'MDX S @RESULTS@(0)="-1^No CP Study Entry." Q
234 S @RESULTS@(0)=1
235 S MDCT=0,MDX="" F S MDX=$O(^MDD(702,"ACON",MDCSLT,MDX)) Q:MDX<1 D
236 .S MDCT=MDCT+1,@RESULTS@(MDCT,1)=MDX
237 .S MDY=$G(^MDD(702,+MDX,0)),@RESULTS@(MDCT,2)=$P(MDY,U),@RESULTS@(MDCT,3)=$P(MDY,U,2),@RESULTS@(MDCT,4)=$P(MDY,U,3),@RESULTS@(MDCT,5)=$$GET1^DIQ(702,+MDX,.04,"E")
238 .S @RESULTS@(MDCT,6)=$P(MDY,U,5),@RESULTS@(MDCT,7)=$P(MDY,U,6),@RESULTS@(MDCT,8)=$P(MDY,U,7),@RESULTS@(MDCT,9)=$$GET1^DIQ(702,+MDX,.09,"E")
239 Q
Note: See TracBrowser for help on using the repository browser.