source: FOIAVistA/tag/r/CLINICAL_PROCEDURES-MD/MDRPCOT.m@ 636

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

WorldVistAEHR overlayed on FOIAVistA
File size: 8.5 KB
Line 
1MDRPCOT ; HOIFO/DP/NCA - Object RPCs (TMDTransaction) ;12/5/02 15:33
2 ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
3 ; Integration Agreements:
4 ; IA# 2693 [Subscription] TIU Extractions.
5 ; IA# 2944 [Subscription] Calls to TIUSRVR1.
6 ; IA# 3535 [Subscription] Calls to TIUSRVP.
7 ; IA# 10104 [Supported] Routine XLFSTR calls
8ADDMSG ; [Procedure] Add message to transaction
9 N MDIEN,MDIENS,MDRET
10 Q:'$G(DATA("TRANSACTION"))
11 Q:$G(DATA("MESSAGE"))=""
12 S MDIEN=+DATA("TRANSACTION"),MDIENS="+1,"_MDIEN_","
13 D NOW^%DTC S DATA("DATE")=% K %
14 S MDFDA(702.091,MDIENS,.01)=+$O(^MDD(702,+MDIEN,.091,"A"),-1)+1
15 S MDFDA(702.091,MDIENS,.02)=DATA("DATE")
16 S MDFDA(702.091,MDIENS,.03)=$G(DATA("PKG"),"UNKNOWN")
17 S MDFDA(702.091,MDIENS,.09)=DATA("MESSAGE")
18 D UPDATE^DIE("","MDFDA","MDRET")
19 Q
20 ;
21DELETE ; [Procedure] Delete Study
22 ; Sets @RESULTS@(0)="-1^Reason for not deleting" or "1^Study Deleted"
23 ;
24 N MDHOLD,MDNOTE,MDRES,MDSIEN
25 S (MDHOLD,MDSIEN)=+DATA,MDRES=0,MDNOTE=""
26 S:+$P(^MDD(702,MDSIEN,0),U,6) MDNOTE=$P(^MDD(702,MDSIEN,0),U,6)
27 I "13"[$P(^MDD(702,MDSIEN,0),U,9) S @RESULTS@(0)="-1^Can't Delete TIU Note from a "_$$GET1^DIQ(702,MDSIEN,.09,"E")_" Study." Q
28 I "5"[$P(^MDD(702,MDSIEN,0),U,9) S MDCANR=$$CANCEL^MDHL7B(MDHOLD) I MDCANR<1 S @RESULTS@(0)="-1^"_$P(MDCANR,"^",2) Q
29 I +MDNOTE S MDRES="" D DELETE^TIUSRVP(.MDRES,MDNOTE)
30 I MDRES D Q
31 .D STATUS(MDSIEN_",",2,$P(MDRES,"^",2))
32 .S DATA("TRANSACTION")=MDSIEN,DATA("PKG")="TIU"
33 .S DATA("MESSAGE")=$P(MDRES,"^",2) D ADDMSG
34 .S @RESULTS@(0)="-1^"_$P(MDRES,"^",2)
35 .Q
36 E D
37 .S MDFDA(702,DATA_",",.01)=""
38 .D FILE^DIE("","MDFDA")
39 .N DA,DIK S DA=+MDSIEN,DIK="^MDD(702," D ^DIK
40 .S @RESULTS@(0)="1^Study Deleted."
41 .Q
42 Q
43 ;
44FILEMSG(STUDY,MDPKG,MDSTAT,MDMSG) ; [Procedure] File Study Status and Message.
45 S DATA("TRANSACTION")=STUDY,DATA("PKG")=MDPKG
46 S DATA("MESSAGE")=$P(MDMSG,"^",2)
47 D STATUS(STUDY_",",MDSTAT,$P(MDMSG,"^",2)),ADDMSG
48 Q
49 ;
50FILES ; [Procedure] Add/remove an attachment to this transaction
51 NEW MDFDA,MDIEN,MDIENS,MDRET,P1,P2,P3,P4
52 S P1=$P(DATA,U,1),P2=$P(DATA,U,2),P3=$P(DATA,U,3),P4=$P(DATA,U,4)
53 S MDIEN=0
54 ; Look for file (All comparisons done on lower case values)
55 F S MDIEN=$O(^MDD(702,P1,.1,MDIEN)) Q:'MDIEN D Q:X=P3
56 .S X=$$LOW^XLFSTR($G(^MDD(702,P1,.1,MDIEN,.1)))
57 I MDIEN&P4 S @RESULTS@(0)="1^File already assigned" Q
58 I 'MDIEN&'P4 S @RESULTS@(0)="1^File not assigned" Q
59 I P4 D Q ; Add a file
60 .S MDIENS="+1,"_P1_","
61 .S MDFDA(702.1,MDIENS,.01)=$O(^MDD(702,P1,.1,"B",""),-1)+1
62 .S MDFDA(702.1,MDIENS,.02)=$S(P2:"I",1:"U")
63 .I P2 S MDFDA(702.1,MDIENS,.03)=P2
64 .S MDFDA(702.1,MDIENS,.1)=P3
65 .D UPDATE^DIE("","MDFDA","MDIEN")
66 .S @RESULTS@(0)=+$G(MDIEN(1),-1)
67 I 'P4 D Q ; Remove the file
68 .S MDFDA(702.1,MDIEN_","_P1_",",.01)="@"
69 .D FILE^DIE("","MDFDA","MDRET")
70 .S @RESULTS@(0)=$S($D(MDRET):-1,1:1)
71 Q
72 ;
73GETATT ; [Procedure] Get Attachments
74 F X=0:0 S X=$O(^MDD(702,DATA,.1,X)) Q:'X D
75 .S Y=$O(@RESULTS@(""),-1)+1
76 .S @RESULTS@(Y)=$P(^MDD(702,DATA,.1,X,0),U,1,3)
77 .S $P(@RESULTS@(Y),U,4)=$G(^MDD(702,DATA,.1,X,.1))
78 S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
79 Q
80 ;
81GETERR ; [Procedure] Return list of Imaging Errors
82 ; DATA = Transaction IEN
83 F MDX=0:0 S MDX=$O(^MDD(702,DATA,.091,MDX)) Q:'MDX D
84 .S MDY=+^MDD(702,DATA,.091,MDX,0)_U,Y=$P(^(0),U,2)
85 .D D^DIQ S MDY=MDY_Y_U
86 .S MDY=MDY_$P(^MDD(702,DATA,.091,MDX,0),U,3)_U_$P(^(0),U,9)
87 .S ^TMP($J,$O(^TMP($J,""),-1)+1)=MDY
88 S ^TMP($J,0)=+$O(^TMP($J,""),-1)
89 Q
90 ;
91NEWSTAT ; [Procedure] RPC Call to set status
92 S MDFDA(702,DATA,.09)=TYPE
93 D FILE^DIE("","MDFDA")
94 Q
95 ;
96RPC(RESULTS,OPTION,DATA,TYPE,FILE,RESREP) ; [Procedure] Main RPC call
97 N MDCANR,MDCON,MDDOC,MDFDA,MDFN,MDGST,MDHOLD,MDIEN,MDIENS,MDL,MDLOC,MDMSG,MDNEWV,MDNOTE,MDNVST,MDPDT,MDPKG,MDPROC,MDRES,MDRESU,MDRESUL,MDRET,MDS,MDSIEN,MDSTAT,MDSTUDY,MDTITL,MDTIUER,MDTRAN,MDTST,MDTSTR,MDVST,MDVSTR,MDWP,MDX,MDY
98 S RESULTS=$NA(^TMP($J)) K @RESULTS
99 D:$T(@OPTION)]"" @OPTION
100 D:'$D(@RESULTS) BADRPC^MDRPCU("MD TMDTRANSACTION","MDRPCOT",OPTION)
101 D CLEAN^DILF
102 Q
103 ;
104STATUS(MDIENS,MDSTAT,MDMSG) ; [Procedure] Update transaction status
105 S MDFDA(702,MDIENS,.08)=$G(MDMSG)
106 S MDFDA(702,MDIENS,.09)=MDSTAT
107 D FILE^DIE("","MDFDA")
108 Q
109 ;
110SUBMIT ; [Procedure] Process the Image(s) Submission.
111 ; Output: -1^Error Message or
112 ; 1^Successful Message
113 N MDRESUL,MDSTUDY
114 S MDSTUDY=+DATA,MDRESUL=""
115 ; Create New TIU Document
116 S MDRESUL=$$NEWTIUN(MDSTUDY)
117 ; File TIU Error messages
118 ;I +MDRESUL<0 D FILEMSG(MDSTUDY,"TIU",2,MDRESUL) Q MDRESUL
119 I +MDRESUL<0 D Q
120 .D FILEMSG(MDSTUDY,"TIU",2,MDRESUL)
121 .S @RESULTS@(0)=MDRESUL
122 ; Submit and export the images
123 S MDRESUL=$$SUBMIT^MDRPCOT1(MDSTUDY)
124 ; File message
125 D FILEMSG(MDSTUDY,"IMAGING",$S(+MDRESUL>0:+MDRESUL,1:2),MDRESUL)
126 S @RESULTS@(0)=MDRESUL
127 Q
128 ;
129VIEWTIU ; [Procedure] VIew the associated tiu document
130 I '$P(^MDD(702,+DATA,0),U,6) D Q
131 .S @RESULTS@(0)="NO TIU NOTE FOR THIS STUDY"
132 D TGET^TIUSRVR1(.RESULTS,+$P(^MDD(702,+DATA,0),U,6))
133 Q
134 ;
135GETDATA(STUDY) ; [Function] Return the Necessary data for creating a TIU note.
136 ; Return: Patient DFN_"^"_TIU title_"^"_Hospital Location_"^"_TIU Note
137 ; IEN_"^"_Consult #_"^"_CP Definition IEN_"^"_Visit String_"^"
138 ; New Visit Flag
139 ; or
140 ; -1^Error Message
141 N DFN,MDCON,MDFN,MDIEN,MDIENS,MDLOC,MDNEWV,MDNOTE,MDNVST,MDPROC,MDVSTR,MDTITL,MDX,MDTST
142 S MDIEN=+STUDY,MDIENS=MDIEN_",",MDNVST=0
143 I $$GET1^DIQ(702,MDIENS,.01)="" Q "-1^No such study entry."
144 ; Get DFN
145 S DFN=$$GET1^DIQ(702,MDIEN,.01,"I")
146 I 'DFN Q "-1^No DFN."
147 ; Get CP Def
148 S MDPROC=$$GET1^DIQ(702,MDIEN,.04,"I")
149 I 'MDPROC Q "-1^No CP Def."
150 ; Get Consult
151 S MDCON=$$GET1^DIQ(702,MDIEN,.05,"I")
152 I 'MDCON Q "-1^No Consult #."
153 ; Get TIU Note Title
154 S MDTITL=$$GET1^DIQ(702.01,+MDPROC_",",.04,"I")
155 I 'MDTITL Q "-1^No TIU Note Title."
156 S MDVSTR=$$GET1^DIQ(702,MDIEN,.07)
157 I MDVSTR="" Q "-1^No Visit String."
158 I $L(MDVSTR,";")=1 S MDNVST=1,MDVSTR=";"_MDVSTR ; If new visit is selected
159 ; MDLOC is Hospital Location
160 I MDVSTR'="" D
161 .S MDVSTR=$$GETVSTR^MDRPCOT1(DFN,MDVSTR,MDPROC,$$GET1^DIQ(702,MDIEN,.02,"I"))
162 .S MDLOC=$P(MDVSTR,";",1)
163 ; Does TIU doc already exist?
164 I $$GET1^DIQ(702,MDIEN,.06,"I") Q DFN_"^"_MDTITL_"^"_MDLOC_"^"_+$$GET1^DIQ(702,MDIEN,.06,"I")_"^"_MDCON_"^"_MDPROC_"^"_MDVSTR_"^"_MDNVST
165 ; Does TIU doc exist for previous transaction of this consult?
166 I MDCON S MDNOTE=$$PREV(MDCON,MDIEN)
167 Q DFN_"^"_MDTITL_"^"_MDLOC_"^"_+MDNOTE_"^"_MDCON_"^"_MDPROC_"^"_MDVSTR_"^"_MDNVST
168 ;
169NEWTIUN(STUDY) ; [Function] Create a new TIU for transaction
170 ; Input: STUDY - IENS of CP study entry
171 ; Return: TIU Document IEN
172 N CTR,DFN,MDCON,MDFDA,MDGST,MDL,MDLOC,MDNOTE,MDPDT,MDPROC,MDRESU,MDTITL,MDTSTR,MDVST,MDVSTR,MDWP S CTR=0,MDGST=+STUDY,MDRESU=""
173 ; Get data for TIU Note Creation
174 S (MDTSTR,MDRESU)=$$GETDATA(MDGST)
175 ; File Error message
176 I +MDRESU<0 D FILEMSG(MDGST,"CP",2,MDRESU) Q MDRESU
177 I $G(MDTSTR)="" Q "-1^No Data to Create TIU Document"
178 F MDL="DFN","MDTITL","MDLOC","MDNOTE","MDCON","MDPROC","MDVSTR","MDNVST" D
179 .S CTR=CTR+1,@MDL=$P(MDTSTR,"^",CTR)
180 S MDVST=""
181 ; If previous TIU document exists, quit
182 I MDNOTE Q MDNOTE
183 I 'MDLOC Q "-1^No Hospital Location."
184 ; Create new visit, if no vstring
185 S MDPDT=$$PDT^MDRPCOT1(MDGST)
186 S:'MDPDT MDPDT=$P(MDVSTR,";",2) ; If No D/T Performed grab visit D/T
187 ; Build variables for TIU Call
188 S MDWP(.05)=1 ; Undicated Status
189 S MDWP(1405)=+MDCON_";GMR(123," ; Package Reference
190 I MDPDT S MDWP(70202)=MDPDT ; Date/Time Performed
191 ; File PCE Error message
192 I MDNVST S MDRESU=$$EN1^MDPCE(MDGST,MDPDT,MDPROC,$P(MDVSTR,";",3),"P") I +MDRESU S MDVST=+MDRESU,MDVSTR=$P(MDRESU,"^",2)
193 I MDNVST&(+MDRESU<0) D FILEMSG(MDGST,"PCE",2,$P(MDRESU,"^",2)) Q MDRESU
194 ; Create the TIU note stub
195 S MDNOTE="" D MAKE^TIUSRVP(.MDNOTE,DFN,MDTITL,$P(MDVSTR,";",2),MDLOC,$S(MDVST:MDVST,1:""),.MDWP,MDVSTR,1,1)
196 I '(+MDNOTE) S $P(MDNOTE,"^")=-1 Q MDNOTE
197 ; Finalize the transaction
198 S MDFDA(702,STUDY_",",.06)=+MDNOTE
199 S MDFDA(702,STUDY_",",.08)=""
200 D FILE^DIE("","MDFDA")
201 Q 1
202 ;
203PREV(MDC,MDS) ; [Function] Return the Previous TIU document.
204 N MDNEWV,MDDOC,MDTRAN,MDTIUER,MDTST
205 S (MDDOC,MDNEWV,MDTRAN,MDTIUER,MDTST)="" K ^TMP("MDTIUST",$J)
206 F S MDTRAN=$O(^MDD(702,"ACON",MDC,MDTRAN)) Q:'MDTRAN D Q:'MDTRAN
207 .I $P(^MDD(702,MDTRAN,0),U,6) D
208 ..D EXTRACT^TIULQ($P(^MDD(702,MDTRAN,0),U,6),"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;1406") Q:+MDTIUER
209 ..S MDTST=$G(^TMP("MDTIUST",$J,$P(^MDD(702,MDTRAN,0),U,6),.05,"E"))
210 ..I MDTST'="UNDICTATED"&(MDTST'="UNSIGNED") K ^TMP("MDTIUST",$J) Q
211 ..I MDTST="UNSIGNED"&'($G(^TMP("MDTIUST",$J,$P(^MDD(702,MDTRAN,0),U,6),1406,"I"))) K ^TMP("MDTIUST",$J) Q
212 ..S MDDOC=$P(^MDD(702,MDTRAN,0),U,6),MDNEWV=$P(^MDD(702,MDTRAN,0),U,7)
213 ..Q:'MDS
214 ..S MDFDA(702,MDS_",",.06)=MDDOC
215 ..S MDFDA(702,MDS_",",.07)=MDNEWV
216 ..D FILE^DIE("","MDFDA")
217 ..S MDTRAN=""
218 Q MDDOC
219 ;
Note: See TracBrowser for help on using the repository browser.