source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCOT.m@ 1203

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

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