source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVP.m@ 711

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

initial load of FOIAVistA 6/30/08 version
File size: 7.4 KB
Line 
1TIUSRVP ; SLC/JER - RPCs for CREATE & UPDATE ;8/16/05
2 ;;1.0;TEXT INTEGRATION UTILITIES;**1,7,19,28,47,89,104,100,115,109,167,113,112,175,157,184**;Jun 20, 1997
3MAKE(SUCCESS,DFN,TITLE,VDT,VLOC,VSIT,TIUX,VSTR,SUPPRESS,NOASF) ; New Document
4 ; SUCCESS = (by ref) TIU DOCUMENT # (PTR to 8925)
5 ; = 0^Explanatory message if no SUCCESS
6 ; DFN = Patient (#2)
7 ; TITLE = TIU Document Definition (#8925.1)
8 ; [VDT] = Date(/Time) of Visit
9 ; [VLOC] = Visit Location (HOSPITAL LOCATION)
10 ; [VSIT] = Visit file ien (#9000010)
11 ; [VSTR] = Visit string (i.e., VLOC;VDT;VTYPE)
12 ; [NOASF] = if 1=Do Not Set ASAVE cross-reference
13 ; TIUX = (by ref) array containing field data and document body
14 ;
15 N TIU,TIUDA,LDT,NEWREC
16 S SUCCESS=0
17 I +$G(VSIT) S VSTR=$$VSTRBLD(+VSIT)
18 I $L($G(VSTR)) D
19 . S VDT=$S(+$G(VDT):+$G(VDT),1:$P(VSTR,";",2))
20 . S LDT=$S(+$G(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
21 . S VLOC=$S(+$G(VLOC):+$G(VLOC),1:$P(VSTR,";"))
22 . ; If note is for Ward Location, call MAIN^TIUMOVE
23 . I $P($G(^SC(+VLOC,0)),U,3)="W" D MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC) Q
24 . ; Otherwise, call PATVADPT^TIULV
25 . D PATVADPT^TIULV(.TIU,DFN,"",VSTR)
26 I '+$G(VSIT),'$L($G(VSTR)),+$G(VDT),+$G(VLOC) D
27 . S VDT=$G(VDT),LDT=$S(+$G(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
28 . ; If note is for Ward Location, call MAIN^TIUMOVE
29 . I $P($G(^SC(+VLOC,0)),U,3)="W" D MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC) Q
30 . ; Otherwise, call MAIN^TIUVSIT
31 . D MAIN^TIUVSIT(.TIU,DFN,"",VDT,LDT,"LAST",0,VLOC)
32 I '+$G(TIU("VSTR")) D
33 . D EVENT^TIUSRVP1(.TIU,DFN)
34 S TIU("INST")=$$DIVISION^TIULC1(+TIU("LOC"))
35 I $S($D(TIU)'>9:1,+$G(DFN)'>0:1,1:0) S SUCCESS="0^"_$$EZBLD^DIALOG(89250001) Q
36 ;
37 S TIUDA=$$GETREC(DFN,.TIU,TITLE,.NEWREC)
38 I +TIUDA'>0 S SUCCESS="0^"_$$EZBLD^DIALOG(89250002) Q
39 S SUCCESS=+TIUDA
40 D STUFREC^TIUSRVP1(+TIUDA,.TIUX,DFN,,TITLE,.TIU)
41 S:'+$G(NOASF) ^TIU(8925,"ASAVE",DUZ,TIUDA)=""
42 K ^TIU(8925,+TIUDA,"TEMP")
43 M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT") K TIUX("TEXT")
44 D SETXT0(TIUDA)
45 D FILE(.SUCCESS,+TIUDA,.TIUX,+$G(SUPPRESS))
46 I +SUCCESS'>0 D DIK^TIURB2(TIUDA) Q
47 I +$O(^TIU(8925,+TIUDA,"TEMP",0)) D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
48 I +$G(TIU("STOP")) D DEFER^TIUVSIT(TIUDA,TIU("STOP")) I 1
49 E D QUE^TIUPXAP1
50 I '+$G(SUPPRESS) D
51 . D RELEASE^TIUT(TIUDA,1)
52 . D UPDTIRT^TIUDIRT(.TIU,TIUDA)
53 K ^TIU(8925,+TIUDA,"TEMP")
54 Q
55VSTRBLD(VSIT) ; Given Visit ien, build Visit-Descriptor String
56 N TIUY,VSIT0,VLOC,VDT,VSVCAT
57 S VSIT0=$G(^AUPNVSIT(+VSIT,0)),VDT=+$P(VSIT0,U),VLOC=+$P(VSIT0,U,22)
58 S VSVCAT=$P(VSIT0,U,7)
59 S TIUY=VLOC_";"_VDT_";"_VSVCAT
60 Q TIUY
61SETXT0(TIUDA) ; Set root node of "TEMP" WP-field
62 N TIUC,TIUI S (TIUC,TIUI)=0
63 F S TIUI=$O(^TIU(8925,TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
64 . S:$D(^TIU(8925,TIUDA,"TEMP",TIUI,0)) TIUC=TIUC+1
65 S ^TIU(8925,TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
66 Q
67MAKEADD(TIUDADD,TIUDA,TIUX,SUPPRESS) ; Create addendum
68 ; For backward compatibility
69 ; Use MAKEADD^TIUSRVP2 now, please
70 D MAKEADD^TIUSRVP2(.TIUDADD,TIUDA,.TIUX,+$G(SUPPRESS))
71 Q
72UPDATE(SUCCESS,TIUDA,TIUX,SUPPRESS) ; Update existing Document
73 N TIU,TIUI,TIUC,TIUD0,TIUD12,TIUD15,TIUCPF,TITLE,PRFUNLNK
74 I $S(+$G(TIUDA)'>0:1,'$D(^TIU(8925,+TIUDA,0)):1,1:0) D Q
75 . S SUCCESS="0^ Cannot update a non-existent document..."
76 I +$P($G(^TIU(8925,+TIUDA,0)),U,5)>6 D Q
77 . S SUCCESS="0^ TIU Document #"_TIUDA_" is already signed..."
78 I $D(TIUX("TEXT")) D
79 . K ^TIU(8925,+TIUDA,"TEMP")
80 . M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
81 . S (TIUC,TIUI)=0
82 . F S TIUI=$O(^TIU(8925,+TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
83 . . S TIUC=TIUC+1
84 . I +TIUC>0 S ^TIU(8925,+TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
85 . K TIUX("TEXT")
86 I +$O(TIUX(""))'>0 S:+$G(SUPPRESS) SUCCESS=+TIUDA Q
87 S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^(12)),TITLE=+TIUD0
88 ;Set a flag to indicate whether or not a Title is a member of the
89 ;Clinical Procedures Class (1=Yes and 0=No)
90 S TIUCPF=+$$ISA^TIULX(TITLE,+$$CLASS^TIUCP)
91 D SETCOS^TIUSRVP2(TIUDA,.TIUX,TIUD0,TIUD12)
92 ; Title changed? Refile DC
93 I +$G(TIUX(.01))>0,(+$G(TIUX(.01))'=+TIUD0) D
94 . S TIUX(.04)=$$DOCCLASS^TIULC1(+$G(TIUX(.01)))
95 . ; If change title from PRF to nonPRF, set flg to unlink note:
96 . I $$ISPFTTL^TIUPRFL(TITLE),'$$ISPFTTL^TIUPRFL(+$G(TIUX(.01))) S PRFUNLNK=1
97 D FILE(.SUCCESS,+TIUDA,.TIUX,+$G(SUPPRESS),TIUCPF)
98 I +SUCCESS'>0 K ^TIU(8925,+TIUDA,"TEMP") Q
99 I $G(PRFUNLNK) D UNLINK^TIUPRF1(TIUDA)
100 D GETTIU^TIULD(.TIU,TIUDA)
101 I $D(^TIU(8925,+TIUDA,"TEMP")) D
102 . K ^TIU(8925,+TIUDA,"TEXT")
103 . D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
104 . K ^TIU(8925,+TIUDA,"TEMP")
105 . S:'+$G(SUCCESS) SUCCESS=+TIUDA
106 ; If signed, re-file /ES/
107 S TIUD15=$G(^TIU(8925,+TIUDA,15))
108 I +TIUD15 D
109 . N TIUBY,DR,DIE,DA,X,Y S TIUBY=$P(TIUD15,U,2) Q:+TIUBY'>0
110 . S DR="1503///^S X=$$SIGNAME^TIULS("_TIUBY_");1504///^S X=$$SIGTITL^TIULS("_TIUBY_")"
111 . S DA=TIUDA,DIE=8925 D ^DIE
112 ; send alerts
113 I '+$G(SUPPRESS) D
114 . I +$P(TIUD0,U,5)<5,'$D(TIUX(.05)) D UPDSTAT(TIUDA,+$G(TIUD0))
115 . D SEND^TIUALRT(TIUDA),SENDID^TIUALRT1(TIUDA):+$G(^TIU(8925,+TIUDA,21))
116 . D UPDTIRT^TIUDIRT(.TIU,TIUDA)
117 Q
118SETCOS(TIUDA,TIUX,TIUD0,TIUD12) ; set cosig req
119 ; For backward compatibility
120 ; Use SETCOS^TIUSRVP2 now, please
121 D SETCOS^TIUSRVP2(TIUDA,.TIUX,TIUD0,TIUD12)
122 Q
123UPDSTAT(DA,TITLE) ; Update status on commit
124 N DR,DIE S DR=".05////"_$$STATUS^TIUSRVP1(DA,0,TITLE)
125 I '+$P($G(^TIU(8925,DA,13)),U,4) S DR=DR_";1304////^S X=$$NOW^XLFDT"
126 S DIE=8925
127 D ^DIE
128 Q
129GETREC(DFN,TIU,TITLE,TIUNEW) ; Get/create document record
130 N DA,DIC,DIE,DLAYGO,DR,X,Y,TIUDPRM,TIUFPRIV,TIUHIT,TIUSCAT
131 S (TIUHIT,DA)=0,TIUFPRIV=1
132 S (DIC,DLAYGO)=8925,DIC(0)="FL"
133 S X=""""_"`"_+TITLE_"""" D ^DIC K DIC("S")
134 I +Y'>0 Q Y_U_" Insufficient data to create a new record."
135 S DA=+Y,TIUNEW=+$P(Y,U,3)
136 N DIE,DR,TIUVISIT S DIE=8925
137 S TIUVISIT=$S(+$G(TIU("VISIT")):+$G(TIU("VISIT")),1:"")
138 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:"")
139 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)
140 D ^DIE
141 Q +$G(DA)
142FILE(SUCCESS,TIUDA,TIUX,SUPPRESS,TIUCPF) ; Call FM Filer & commit
143 N FDA,FDARR,IENS,FLAGS,TIUMSG,TIUCMMTX
144 S IENS=""""_TIUDA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS=""
145 I +$G(TIUX(1202)) S TIUX(1204)=+$G(TIUX(1202))
146 I +$G(TIUX(1209)) S TIUX(1208)=+$G(TIUX(1209))
147 ;If the document is a member of the Clinical Procedures Class, set the
148 ;Entered By field to the Author/Dictator field
149 I $G(TIUCPF),+$G(TIUX(1202)) S TIUX(1302)=+$G(TIUX(1202))
150 M @FDARR=TIUX
151 D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
152 I $D(TIUMSG)>9 S SUCCESS=0_U_$G(TIUMSG("DIERR",1,"TEXT",1)) Q
153 S SUCCESS=TIUDA
154 I '+$G(SUPPRESS) D
155 . N DA
156 . S DA=TIUDA
157 . S TIUCMMTX=$$COMMIT^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
158 . I TIUCMMTX]"" X TIUCMMTX
159 . K ^TIU(8925,"ASAVE",DUZ,TIUDA)
160 Q
161SIGN(ERR,TIUDA,TIUX) ; API for /es/
162 ; For backward compatibility
163 ; Use SIGN^TIUSRVP2 now, please
164 D SIGN^TIUSRVP2(.ERR,TIUDA,.TIUX)
165 Q
166DELETE(ERR,TIUDA,TIURSN,OVRRIDE) ; delete document
167 N TIUDEL,TIUD0 S ERR=0
168 I '+$G(OVRRIDE) D Q:+$G(TIUDEL)'>0
169 . S TIUDEL=$$CANDO^TIULP(TIUDA,"DELETE RECORD")
170 . I TIUDEL'>0 S ERR="89250003^"_$$EZBLD^DIALOG(89250003)
171 S TIUD0=$G(^TIU(8925,+TIUDA,0))
172 I +$P(TIUD0,U,5)'<6 D Q
173 . S TIURSN=$G(TIURSN,"A")
174 . D DELTEXT^TIURB2(TIUDA,TIURSN)
175 D DIK^TIURB2(TIUDA)
176 D DELAUDIT^TIUEDI1(TIUDA)
177 Q
178LOCK(ERR,TIUDA) ; Bid for lock on a TIU Document record
179 L +^TIU(8925,+TIUDA):1 I S ERR=0
180 E S ERR="1^ Another session has this record locked."
181 Q
182UNLOCK(ERR,TIUDA) ; Decrement Lock on a TIU Document record
183 L -^TIU(8925,+TIUDA) S ERR=0
184 Q
Note: See TracBrowser for help on using the repository browser.