source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCNT1.m@ 707

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1MDRPCNT1 ; HOIFO/NCA - Object RPCs (TMDNOTE) Continued 2;10/29/04 12:20 ;3/12/08 09:15
2 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
3 ; Integration Agreements:
4 ; IA# 2693 [Subscription] TIU Extractions.
5 ; IA# 3535 [Subscription] Calls to TIUSRVP.
6ADDMSG ; [Procedure] Add message to transaction
7 N MDIEN,MDIENS,MDRET
8 Q:'$G(DATA("TRANSACTION"))
9 Q:$G(DATA("MESSAGE"))=""
10 S MDIEN=+DATA("TRANSACTION"),MDIENS="+1,"_MDIEN_","
11 D NOW^%DTC S DATA("DATE")=%
12 S MDFDA(702.091,MDIENS,.01)=+$O(^MDD(702,+MDIEN,.091,"A"),-1)+1
13 S MDFDA(702.091,MDIENS,.02)=DATA("DATE")
14 S MDFDA(702.091,MDIENS,.03)=$G(DATA("PKG"),"UNKNOWN")
15 S MDFDA(702.091,MDIENS,.09)=DATA("MESSAGE")
16 D UPDATE^DIE("","MDFDA","MDRET")
17 Q
18 ;
19FILEMSG(STUDY,MDPKG,MDSTAT,MDMSG) ; [Procedure] File Study Status and Message.
20 S DATA("TRANSACTION")=STUDY,DATA("PKG")=MDPKG
21 S DATA("MESSAGE")=$P(MDMSG,"^",2)
22 D STATUS(STUDY_",",MDSTAT,$P(MDMSG,"^",2)),ADDMSG
23 Q
24 ;
25STATUS(MDIENS,MDSTAT,MDMSG) ; [Procedure] Update transaction status
26 S MDFDA(702,MDIENS,.08)=$G(MDMSG)
27 S MDFDA(702,MDIENS,.09)=MDSTAT
28 D FILE^DIE("","MDFDA")
29 Q
30 ;
31SUBMIT(MDDATA,MDDT,MDAU,MDESIG,MDNTL,MDG1) ; [Procedure] Process the Image(s) Submission.
32 ; Input: MDDATA - Study ID
33 ; MDDT-Date/Time of Document
34 ; MDA - Author
35 ; MDESIG - Electronic Signature
36 ; MDNTL - Note title
37 ; MDG1 - ^TMP global with the text of the report
38 ; Output: -1^Error Message or
39 ; 1^Successful Message
40 N MDANS,MDRESUL,MDSTUDY,MDG2,RES
41 S MDSTUDY=+MDDATA,(RES,MDRESUL)=""
42 ; Create New TIU Document
43 S MDRESUL=$$NEWTIUN(MDSTUDY,MDDT,MDAU,MDNTL)
44 ; File TIU Error messages
45 I +MDRESUL<0 D Q RES
46 .D FILEMSG(MDSTUDY,"TIU",2,MDRESUL)
47 .S RES=MDRESUL
48 S MDANS=+MDRESUL
49 ; Update the text of the TIU document
50 S MDG2=@($NA(MDG1))
51 I +$O(@MDG2@(""),-1) D Q:RES'="" RES
52 .S MDRESUL=$$UPDATE(MDSTUDY,MDANS,MDESIG,MDG2)
53 .I +MDRESUL<0 D Q
54 ..D FILEMSG(MDSTUDY,"TIU",2,MDRESUL)
55 ..S RES=MDRESUL
56 S RES=MDANS
57 N XX S XX="",XX=$$UPDCONS^MDRPCOT1(+$P($G(^MDD(702,+MDSTUDY,0)),U,5),+$P($G(^MDD(702,+MDSTUDY,0)),U,6))
58 Q RES
59 ;
60GETDATA(STUDY) ; [Function] Return the Necessary data for creating a TIU note.
61 ; Return: Patient DFN_"^"_TIU title_"^"_Hospital Location_"^"_TIU Note
62 ; IEN_"^"_Consult #_"^"_CP Definition IEN_"^"_Visit String_"^"
63 ; New Visit Flag
64 ; or
65 ; -1^Error Message
66 N DFN,MDCON,MDFN,MDIEN,MDIENS,MDLOC,MDNEWV,MDNOTE,MDNVST,MDPROC,MDVSTR,MDTITL,MDX,MDTST
67 S MDIEN=+STUDY,MDIENS=MDIEN_",",MDNVST=0
68 I $$GET1^DIQ(702,MDIENS,.01)="" Q "-1^No such study entry."
69 ; Get DFN
70 S DFN=$$GET1^DIQ(702,MDIEN,.01,"I")
71 I 'DFN Q "-1^No DFN."
72 ; Get CP Def
73 S MDPROC=$$GET1^DIQ(702,MDIEN,.04,"I")
74 I 'MDPROC Q "-1^No CP Def."
75 ; Get Consult
76 S MDCON=$$GET1^DIQ(702,MDIEN,.05,"I")
77 I 'MDCON Q "-1^No Consult #."
78 ; Get TIU Note Title
79 S MDTITL=$$GET1^DIQ(702.01,+MDPROC_",",.04,"I")
80 I 'MDTITL Q "-1^No TIU Note Title."
81 S MDVSTR=$$GET1^DIQ(702,MDIEN,.07)
82 I MDVSTR="" Q "-1^No Visit String."
83 I $L(MDVSTR,";")=1 S MDNVST=1,MDVSTR=";"_MDVSTR ; If new visit is selected
84 ; MDLOC is Hospital Location
85 I MDVSTR'="" D
86 .S MDVSTR=$$GETVSTR^MDRPCOT1(DFN,MDVSTR,MDPROC,$$GET1^DIQ(702,MDIEN,.02,"I"))
87 .S MDLOC=$P(MDVSTR,";",1)
88 ; Does TIU doc already exist?
89 ;I $$GET1^DIQ(702,MDIEN,.06,"I") Q DFN_"^"_MDTITL_"^"_MDLOC_"^"_+$$GET1^DIQ(702,MDIEN,.06,"I")_"^"_MDCON_"^"_MDPROC_"^"_MDVSTR_"^"_MDNVST
90 ; Does TIU doc exist for previous transaction of this consult?
91 ;I MDCON S MDNOTE=$$PREV(MDCON,MDIEN)
92 S MDNOTE=""
93 Q DFN_"^"_MDTITL_"^"_MDLOC_"^"_+MDNOTE_"^"_MDCON_"^"_MDPROC_"^"_MDVSTR_"^"_MDNVST
94 ;
95NEWTIUN(STUDY,MDDT,MDA,MDNT) ; [Function] Create a new TIU for transaction
96 ; Input: STUDY - IENS of CP study entry
97 ; MDDT - Date of Note
98 ; MDA - Author
99 ; MDNT - Note Title
100 ; Return: TIU Document IEN
101 N CTR,DFN,MDCON,MDFDA,MDGST,MDL,MDLOC,MDNOTE,MDPDT,MDPROC,MDPT,MDRESU,MDDTTL,MDTITL,MDTSTR,MDVST,MDVSTR,MDWP S CTR=0,MDGST=+STUDY,MDRESU="" N MDFIL S MDFIL=8925.1
102 ; Get data for TIU Note Creation
103 S (MDTSTR,MDRESU)=$$GETDATA(MDGST),MDDTTL=0
104 ; File Error message
105 I +MDRESU<0 D FILEMSG(MDGST,"CP",2,MDRESU) Q MDRESU
106 I $G(MDTSTR)="" Q "-1^No Data to Create TIU Document"
107 F MDL="DFN","MDTITL","MDLOC","MDNOTE","MDCON","MDPROC","MDVSTR","MDNVST" D
108 .S CTR=CTR+1,@MDL=$P(MDTSTR,"^",CTR)
109 S (MDVST,MDRESU)=""
110 ; If previous TIU document exists, quit
111 ;I MDNOTE Q MDNOTE
112 I 'MDLOC Q "-1^No Hospital Location."
113 ; Create new visit, if no vstring
114 S MDDTTL=+$$FIND1^DIC(MDFIL,"","BOX",MDNT,"B","","MDERR")
115 S MDTITL=$S(+MDDTTL>0:+MDDTTL,1:MDTITL)
116 S MDPDT=$$PDT^MDRPCOT1(MDGST)
117 I 'MDPDT S MDPT=$O(^MDD(703.1,"ASTUDYID",+MDGST,0)),MDPDT=$P($G(^MDD(703.1,+MDPT,0)),U,3)
118 S:'MDPDT MDPDT=$P(MDVSTR,";",2) ; If No D/T Performed grab visit D/T
119 ; Build variables for TIU Call
120 S MDWP(.05)=1 ; Undicated Status
121 S MDWP(1201)=MDDT ; Date/Time Note Created
122 S MDWP(1202)=MDA ; Author of Note
123 S MDWP(1302)=MDA ; Entered By
124 S MDWP(1405)=+MDCON_";GMR(123," ; Package Reference
125 S MDWP(70201)=5 ; Default Procedure Summary Code "Machine Resulted"
126 I MDPDT S MDWP(70202)=MDPDT ; Date/Time Performed
127 ; File PCE Error message
128 I MDNVST S MDRESU=$$EN1^MDPCE(MDGST,MDPDT,MDPROC,$P(MDVSTR,";",3),"P") I +MDRESU S MDVST=+MDRESU,MDVSTR=$P(MDRESU,"^",2)
129 I +MDRESU<0 D FILEMSG(MDGST,"PCE",2,$P(MDRESU,"^",2)) Q MDRESU
130 ; Create the TIU note stub
131 S MDNOTE="" D MAKE^TIUSRVP(.MDNOTE,DFN,MDTITL,$P(MDVSTR,";",2),MDLOC,$S(MDVST:MDVST,1:""),.MDWP,MDVSTR,1,1)
132 I '(+MDNOTE) S $P(MDNOTE,"^")=-1 Q MDNOTE
133 ;S MDFDA(702,STUDY_",",.06)=+MDNOTE
134 S MDFDA(702,STUDY_",",.08)=""
135 D FILE^DIE("","MDFDA")
136 D UPD^MDKUTLR(STUDY,+MDNOTE)
137 Q MDNOTE
138 ;
139UPDATE(STUDY,MDA,SIGN,MDGLB) ; Update the TIU document with the text
140 N MDK,MDNOTE,MDPPR,MDRESU,MDS,MDTI,MDTIUER,MDWP,MDV,MDV1 S (MDNOTE,MDTIUER)="" K MDWP,^TMP("MDTIUST",$J)
141 F MDK=0:0 S MDK=$O(@MDGLB@(MDK)) Q:'MDK S MDWP("TEXT",MDK,0)=$G(@MDGLB@(MDK))
142 S MDTI=MDA
143 S MDWP(.05)=5
144 D UPDATE^TIUSRVP(.MDNOTE,+MDTI,.MDWP,1)
145 I '+MDNOTE S MDNOTE="-1^"_$P(MDNOTE,"^",2) Q MDNOTE
146 ; Sign TIU Document
147 S MDS=$$SIGN(MDTI,SIGN) I MDS<0 Q MDS
148 Q 1
149SIGN(MDTIUIN,MDSIGN) ; Sign the TIU Document
150 ; [Function] TIU SIGN RECORD
151 ;Input Parameters:
152 ; 1. TIUIEN [Literal/Required] TIU internal Entry Number
153 ; 2. MDSIGN [Literal/Required] User Signature
154 N MDSRES,X
155 S MDSRES=""
156 D SIGN^TIUSRVP(.MDSRES,MDTIUIN,MDSIGN)
157 I +MDSRES>0 Q "-1^"_$P(MDSRES,"^",2)
158 Q 1
159 ;
160PREV(MDC,MDS) ; [Function] Return the Previous TIU document.
161 N MDNEWV,MDDOC,MDTRAN,MDTIUER,MDTST
162 S (MDDOC,MDNEWV,MDTRAN,MDTIUER,MDTST)="" K ^TMP("MDTIUST",$J)
163 F S MDTRAN=$O(^MDD(702,"ACON",MDC,MDTRAN)) Q:'MDTRAN D Q:'MDTRAN
164 .I $P(^MDD(702,MDTRAN,0),U,6) D
165 ..D EXTRACT^TIULQ($P(^MDD(702,MDTRAN,0),U,6),"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;1406") Q:+MDTIUER
166 ..S MDTST=$G(^TMP("MDTIUST",$J,$P(^MDD(702,MDTRAN,0),U,6),.05,"E"))
167 ..I MDTST'="UNDICTATED"&(MDTST'="UNSIGNED") K ^TMP("MDTIUST",$J) Q
168 ..I MDTST="UNSIGNED"&'($G(^TMP("MDTIUST",$J,$P(^MDD(702,MDTRAN,0),U,6),1406,"I"))) K ^TMP("MDTIUST",$J) Q
169 ..S MDDOC=$P(^MDD(702,MDTRAN,0),U,6),MDNEWV=$P(^MDD(702,MDTRAN,0),U,7)
170 ..Q:'MDS
171 ..S MDFDA(702,MDS_",",.06)=MDDOC
172 ..S MDFDA(702,MDS_",",.07)=MDNEWV
173 ..D FILE^DIE("","MDFDA")
174 ..S MDTRAN=""
175 Q MDDOC
Note: See TracBrowser for help on using the repository browser.