source: cprs/branches/tmg-cprs/m_files/TMGSRVP.m@ 840

Last change on this file since 840 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 10.4 KB
Line 
1TMGSRVP ; SLC/JER - RPCs for CREATE & UPDATE ;11/01/03
2 ;;1.0;TEXT INTEGRATION UTILITIES;**1,7,19,28,47,89,104,100,115,109,167,113,112,175**;Jun 20, 1997
3 ;
4 ;"Note: Code copied from TIUSRVP for local modifications.
5
6MAKE(SUCCESS,DFN,TITLE,VDT,VLOC,VSIT,TIUX,VSTR,SUPPRESS,NOASF) ;" New Document
7 ;" SUCCESS = (by ref) TIU DOCUMENT # (PTR to 8925)
8 ;" = 0^Explanatory message if no SUCCESS
9 ;" DFN = Patient (#2)
10 ;" TITLE = TIU Document Definition (#8925.1)
11 ;" [VDT] = Date(/Time) of Visit
12 ;" [VLOC] = Visit Location (HOSPITAL LOCATION)
13 ;" [VSIT] = Visit file ien (#9000010)
14 ;" [VSTR] = Visit string (i.e., VLOC;VDT;VTYPE)
15 ;" [NOASF] = if 1=Do Not Set ASAVE cross-reference
16 ;" TIUX = (by ref) array containing field data and document body
17 ;
18 N TIU,TIUDA,LDT,NEWREC
19 S SUCCESS=0
20 I +$G(VSIT) S VSTR=$$VSTRBLD(+VSIT)
21 I $L($G(VSTR)) D
22 . S VDT=$S(+$G(VDT):+$G(VDT),1:$P(VSTR,";",2))
23 . S LDT=$S(+$G(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
24 . S VLOC=$S(+$G(VLOC):+$G(VLOC),1:$P(VSTR,";"))
25 . ; If note is for Ward Location, call MAIN^TIUMOVE
26 . I $P($G(^SC(+VLOC,0)),U,3)="W" D Q
27 . . DO MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC)
28 . ;" Otherwise, call PATVADPT^TIULV
29 . D PATVADPT^TIULV(.TIU,DFN,"",VSTR)
30 I '+$G(VSIT),'$L($G(VSTR)),+$G(VDT),+$G(VLOC) D
31 . S VDT=$G(VDT),LDT=$S(+$G(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
32 . ;" If note is for Ward Location, call MAIN^TIUMOVE
33 . I $P($G(^SC(+VLOC,0)),U,3)="W" D Q
34 . . DO MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC)
35 . ;" Otherwise, call MAIN^TIUVSIT
36 . D MAIN^TIUVSIT(.TIU,DFN,"",VDT,LDT,"LAST",0,VLOC)
37 I '+$G(TIU("VSTR")) D
38 . D EVENT^TIUSRVP1(.TIU,DFN)
39 S TIU("INST")=$$DIVISION^TIULC1(+TIU("LOC"))
40 I $S($D(TIU)'>9:1,+$G(DFN)'>0:1,1:0) S SUCCESS="0^"_$$EZBLD^DIALOG(89250001) Q
41 ;
42 S TIUDA=$$GETREC(DFN,.TIU,TITLE,.NEWREC)
43 I +TIUDA'>0 S SUCCESS="0^"_$$EZBLD^DIALOG(89250002) Q
44 S SUCCESS=+TIUDA
45 ;
46 D STUFREC^TIUSRVP1(+TIUDA,.TIUX,DFN,,TITLE,.TIU)
47 S:'+$G(NOASF) ^TIU(8925,"ASAVE",DUZ,TIUDA)=""
48 K ^TIU(8925,+TIUDA,"TEMP")
49 M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT") K TIUX("TEXT")
50 D SETXT0(TIUDA)
51 D FILE(.SUCCESS,+TIUDA,.TIUX,+$G(SUPPRESS))
52 I +SUCCESS'>0 D DIK^TIURB2(TIUDA) Q
53 I +$O(^TIU(8925,+TIUDA,"TEMP",0)) D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
54 I +$G(TIU("STOP")) D DEFER^TIUVSIT(TIUDA,TIU("STOP")) I 1
55 E D QUE^TIUPXAP1
56 I '+$G(SUPPRESS) D
57 . D RELEASE^TIUT(TIUDA,1)
58 . D UPDTIRT^TIUDIRT(.TIU,TIUDA)
59 K ^TIU(8925,+TIUDA,"TEMP")
60 Q
61 ;
62VSTRBLD(VSIT) ;" Given Visit ien, build Visit-Descriptor String
63 N TIUY,VSIT0,VLOC,VDT,VSVCAT
64 S VSIT0=$G(^AUPNVSIT(+VSIT,0)),VDT=+$P(VSIT0,U),VLOC=+$P(VSIT0,U,22)
65 S VSVCAT=$P(VSIT0,U,7)
66 S TIUY=VLOC_";"_VDT_";"_VSVCAT
67 Q TIUY
68 ;
69SETXT0(TIUDA) ;" Set root node of "TEMP" WP-field
70 N TIUC,TIUI S (TIUC,TIUI)=0
71 F S TIUI=$O(^TIU(8925,TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
72 . S:$D(^TIU(8925,TIUDA,"TEMP",TIUI,0)) TIUC=TIUC+1
73 S ^TIU(8925,TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
74 Q
75 ;
76MAKEADD(TIUDADD,TIUDA,TIUX,SUPPRESS) ;" Create addendum
77 ;"Input: TIUADD -- OUT Parameter, for results
78 ;" TIUDA -- IEN of the parent document in file 8925
79 ;" TIUX -- Local input array containing the data to be filed for the
80 ;" addendum record, formatted as below. It should look something like this:
81 ;" TIUX(.02)=45678
82 ;" TIUX(1301)=2960703.104556
83 ;" TIUX(1302)=293764
84 ;" TIUX("TEXT",1,0)="The patient is a 70 year old WHITE MALE, who presented to the ONCOLOGY CLINIC"
85 ;" TIUX("TEXT",2,0)="On JULY 3, 1996@10:00 AM, with the chief complaint of NECK PAIN..."
86 ;" SUPPRESS
87 ;"Output: TIUADD returns IEN of created record, or error msg--
88 ;" -1^Could not create addendum.
89 ;" 0^<some message>
90 ;
91 N DIE,DR,DA,DIC,X,Y,DLAYGO,TIUATYP,TIUCAN,TIUFPRIV,TIU
92 S TIUFPRIV=1
93 S TIUCAN=$$CANDO^TIULP(TIUDA,"MAKE ADDENDUM")
94 I TIUCAN'>0 DO Q
95 . S TIUDADD="0^You may not MAKE AN ADDENDUM for this "
96 . S TIUDADD=TIUDADD_$$STATUS^TIULC(TIUDA)_" "
97 . S TIUDADD=TIUDADD_$$PNAME^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
98 S TIUATYP=+$$WHATITLE^TIUPUTU("ADDENDUM")
99 S (DIC,DLAYGO)=8925,DIC(0)="L",X=""""_"`"_TIUATYP_""""
100 D ^DIC
101 S TIUDADD=+Y
102 I +Y'>0 S TIUDADD=TIUDADD_"^Could not create addendum." Q
103 D GETTIU^TIULD(.TIU,TIUDA)
104 S TIU("DOCTYP")=TIUATYP_U_$$PNAME^TIULC1(TIUATYP)
105 D STUFREC^TIUSRVP1(+TIUDADD,.TIUX,DFN,+$G(TIUDA),TIUATYP,.TIU)
106 K ^TIU(8925,+TIUDADD,"TEMP")
107 M ^TIU(8925,+TIUDADD,"TEMP")=TIUX("TEXT") K TIUX("TEXT")
108 D SETXT0(+TIUDADD)
109 D FILE(.SUCCESS,+TIUDADD,.TIUX,+$G(SUPPRESS))
110 I +SUCCESS'>0 D DIK^TIURB2(TIUDADD) Q
111 I +$O(^TIU(8925,+TIUDADD,"TEMP",0)) D MERGTEXT^TIUEDI1(+TIUDADD,.TIU)
112 I '+$G(SUPPRESS) D RELEASE^TIUT(+TIUDADD,1)
113 K ^TIU(8925,+TIUDADD,"TEMP")
114 Q
115 ;
116UPDATE(SUCCESS,TIUDA,TIUX,SUPPRESS) ; Update existing Document
117 N TIU,TIUI,TIUC,TIUD0,TIUD12,TIUD15,TIUCPF,TITLE
118 I $S(+$G(TIUDA)'>0:1,'$D(^TIU(8925,+TIUDA,0)):1,1:0) D Q
119 . S SUCCESS="0^ Cannot update a non-existent document..."
120 I +$P($G(^TIU(8925,+TIUDA,0)),U,5)>6 D Q
121 . S SUCCESS="0^ TIU Document #"_TIUDA_" is already signed..."
122 I $D(TIUX("TEXT")) D
123 . K ^TIU(8925,+TIUDA,"TEMP")
124 . M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
125 . S (TIUC,TIUI)=0
126 . F S TIUI=$O(^TIU(8925,+TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
127 . . S TIUC=TIUC+1
128 . I +TIUC>0 S ^TIU(8925,+TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
129 . K TIUX("TEXT")
130 I +$O(TIUX(""))'>0 S:+$G(SUPPRESS) SUCCESS=+TIUDA Q
131 S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^(12)),TITLE=+TIUD0
132 ;Set a flag to indicate whether or not a Title is a member of the
133 ;Clinical Procedures Class (1=Yes and 0=No)
134 S TIUCPF=+$$ISA^TIULX(TITLE,+$$CLASS^TIUCP)
135 D SETCOS(TIUDA,.TIUX,TIUD0,TIUD12)
136 ; Title changed? Refile DC
137 I +$G(TIUX(.01))>0,(+$G(TIUX(.01))'=+TIUD0) D
138 . S TIUX(.04)=$$DOCCLASS^TIULC1(+$G(TIUX(.01)))
139 D FILE(.SUCCESS,+TIUDA,.TIUX,+$G(SUPPRESS),TIUCPF)
140 I +SUCCESS'>0 K ^TIU(8925,+TIUDA,"TEMP") Q
141 D GETTIU^TIULD(.TIU,TIUDA)
142 I $D(^TIU(8925,+TIUDA,"TEMP")) D
143 . K ^TIU(8925,+TIUDA,"TEXT")
144 . D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
145 . K ^TIU(8925,+TIUDA,"TEMP")
146 . S:'+$G(SUCCESS) SUCCESS=+TIUDA
147 ; If signed, re-file /ES/
148 S TIUD15=$G(^TIU(8925,+TIUDA,15))
149 I +TIUD15 D
150 . N TIUBY,DR,DIE,DA,X,Y S TIUBY=$P(TIUD15,U,2) Q:+TIUBY'>0
151 . S DR="1503///^S X=$$SIGNAME^TIULS("_TIUBY_");1504///^S X=$$SIGTITL^TIULS("_TIUBY_")"
152 . S DA=TIUDA,DIE=8925 D ^DIE
153 ; send alerts
154 I '+$G(SUPPRESS) D
155 . I +$P(TIUD0,U,5)<5,'$D(TIUX(.05)) D UPDSTAT(TIUDA,+$G(TIUD0))
156 . D SEND^TIUALRT(TIUDA),SENDID^TIUALRT1(TIUDA):+$G(^TIU(8925,+TIUDA,21))
157 . D UPDTIRT^TIUDIRT(.TIU,TIUDA)
158 Q
159 ;
160SETCOS(TIUDA,TIUX,TIUD0,TIUD12) ; set cosig req
161 N TIUDAD,TIUEXS,TIUNCS,TIUEXCS,TIURCS,TIUATT,TIUTTL,TIUDAD0
162 S TIUEXS=$S(+$G(TIUX(1202)):+$G(TIUX(1202)),1:$P(TIUD12,U,4))
163 S TIUNCS=$S(+$G(TIUX(1208)):+$G(TIUX(1208)),+$G(TIUX(1209)):+$G(TIUX(1209)),1:0)
164 I TIUNCS S TIUX(1506)=$S(TIUNCS=TIUEXS:0,1:1) G SETCOSX
165 S TIUEXCS=$P(TIUD12,U,8),TIUATT=$P(TIUD12,U,9)
166 S TIUDAD=+$P(TIUD0,U,6),TIUDAD0=$G(^TIU(8925,+TIUDAD,0))
167 I +$$ISDS^TIULX($S(+TIUDAD:+TIUDAD0,1:+TIUD0)) D G SETCOSX
168 . S TIUX(1506)=$S(TIUEXS=TIUEXCS:0,1:1)
169 S TIUTTL=$S(+$G(TIUX(.01)):+$G(TIUX(.01)),1:+TIUD0)
170 S TIUX(1506)=+$$REQCOSIG^TIULP(TIUTTL,TIUDA,TIUEXS)
171SETCOSX S:'TIUX(1506) TIUX(1208)="@"
172 Q
173 ;
174UPDSTAT(DA,TITLE) ; Update status on commit
175 N DR,DIE S DR=".05////"_$$STATUS^TIUSRVP1(DA,0,TITLE)
176 I '+$P($G(^TIU(8925,DA,13)),U,4) S DR=DR_";1304////^S X=$$NOW^XLFDT"
177 S DIE=8925
178 D ^DIE
179 Q
180 ;
181GETREC(DFN,TIU,TITLE,TIUNEW) ; Get/create document record
182 N DA,DIC,DIE,DLAYGO,DR,X,Y,TIUDPRM,TIUFPRIV,TIUHIT,TIUSCAT
183 S (TIUHIT,DA)=0,TIUFPRIV=1
184 S (DIC,DLAYGO)=8925,DIC(0)="FL"
185 S X=""""_"`"_+TITLE_"""" D ^DIC K DIC("S")
186 I +Y'>0 Q Y_U_" Insufficient data to create a new record."
187 S DA=+Y,TIUNEW=+$P(Y,U,3)
188 N DIE,DR,TIUVISIT S DIE=8925
189 S TIUVISIT=$S(+$G(TIU("VISIT")):+$G(TIU("VISIT")),1:"")
190 S TIUSCAT=$S(+$L($P($G(TIU("CAT")),U)):$P($G(TIU("CAT")),U),+$L($P($G(TIU("VSTR")),";",3)):$P($G(TIU("VSTR")),";",3),1:"")
191 S DR=".04////"_$$DOCCLASS^TIULC1(+$P(Y,U,2))_";.13////"_TIUSCAT_";1205////"_$P($G(TIU("LOC")),U)_";1211////"_$P($G(TIU("VLOC")),U)_";1212////"_$P($G(TIU("INST")),U)
192 D ^DIE
193 Q +$G(DA)
194 ;
195FILE(SUCCESS,TIUDA,TIUX,SUPPRESS,TIUCPF) ; Call FM Filer & commit
196 ;"Purpose:
197 ;"Input: SUCCESS -- Out paramater
198 ;" TIUDA -- IEN
199 ;" TIUX -- Array with text to file
200 ;" SUPPRESS -- if 1 then suppress addditional processing
201 ;" TIUCPF
202 N FDA,FDARR,IENS,FLAGS,TIUMSG,TIUCMMTX
203 S IENS=""""_TIUDA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS=""
204 I +$G(TIUX(1202)) S TIUX(1204)=+$G(TIUX(1202))
205 I +$G(TIUX(1209)) S TIUX(1208)=+$G(TIUX(1209))
206 ;"If the document is a member of the Clinical Procedures Class, set the
207 ;"Entered By field to the Author/Dictator field
208 I $G(TIUCPF),+$G(TIUX(1202)) S TIUX(1302)=+$G(TIUX(1202))
209 M @FDARR=TIUX
210 D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
211 I $D(TIUMSG)>9 S SUCCESS=0_U_$G(TIUMSG("DIERR",1,"TEXT",1)) Q
212 S SUCCESS=TIUDA
213 I '+$G(SUPPRESS) D
214 . N DA
215 . S DA=TIUDA
216 . S TIUCMMTX=$$COMMIT^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
217 . I TIUCMMTX]"" X TIUCMMTX
218 . K ^TIU(8925,"ASAVE",DUZ,TIUDA)
219 Q
220 ;
221SIGN(ERR,TIUDA,TIUX) ; API for /es/
222 N X,TIUACT,TIUSIGN,TIUD0,TIUD12,TIUSTAT,SIGNER,COSIGNER,VALID,XTRASGNR
223 N TIUES S ERR=0
224 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
225 S SIGNER=$P(TIUD12,U,4),COSIGNER=$P(TIUD12,U,8)
226 I (DUZ'=SIGNER),(DUZ'=COSIGNER) S XTRASGNR=+$O(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
227 S TIUSTAT=+$P(TIUD0,U,5)
228 S TIUACT=$S(TIUSTAT'>5:"SIGNATURE",+$G(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")
229 S TIUSIGN=$$CANDO^TIULP(TIUDA,TIUACT)
230 I +TIUSIGN'>0 S ERR="89250004^"_$P(TIUSIGN,U,2) Q
231 S VALID=$$VALIDATE($$DECRYP^XUSRB1(TIUX))
232 I +VALID'>0 S ERR="89250005^"_$$EZBLD^DIALOG(89250005) Q
233 S TIUES=1_U_$P($G(^VA(200,+DUZ,20)),U,2,3)
234 I '+$G(XTRASGNR) D ES^TIURS(TIUDA,TIUES)
235 I +$G(XTRASGNR) D ADDSIG^TIURS1(TIUDA,XTRASGNR)
236 I +$G(^TIU(8925,TIUDA,21)),(TIUACT="SIGNATURE") D AUDLINK^TIUGR1(TIUDA,"a",+$G(^(21)))
237 Q
238 ;
239VALIDATE(X) ; Validate /es/-code
240 N TIUY S TIUY=0
241 D HASH^XUSHSHP I X]"",(X=$P($G(^VA(200,+DUZ,20)),U,4)) S TIUY=1
242 Q TIUY
243 ;
244DELETE(ERR,TIUDA,TIURSN,OVRRIDE) ; delete document
245 N TIUDEL,TIUD0 S ERR=0
246 I '+$G(OVRRIDE) D Q:+$G(TIUDEL)'>0
247 . S TIUDEL=$$CANDO^TIULP(TIUDA,"DELETE RECORD")
248 . I TIUDEL'>0 S ERR="89250003^"_$$EZBLD^DIALOG(89250003)
249 S TIUD0=$G(^TIU(8925,+TIUDA,0))
250 I +$P(TIUD0,U,5)'<6 D Q
251 . S TIURSN=$G(TIURSN,"A")
252 . D DELTEXT^TIURB2(TIUDA,TIURSN)
253 D DIK^TIURB2(TIUDA)
254 D DELAUDIT^TIUEDI1(TIUDA)
255 Q
256 ;
257LOCK(ERR,TIUDA) ; Bid for lock on a TIU Document record
258 L +^TIU(8925,+TIUDA):1 I S ERR=0
259 E S ERR="1^ Another session has this record locked."
260 Q
261 ;
262UNLOCK(ERR,TIUDA) ; Decrement Lock on a TIU Document record
263 L -^TIU(8925,+TIUDA) S ERR=0
264 Q
Note: See TracBrowser for help on using the repository browser.