source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPUTCP.m@ 1650

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

initial load of WorldVistAEHR
File size: 9.5 KB
Line 
1TIUPUTCP ; SLC/JER,RMO - CP Look-up Method ;4/18/03
2 ;;1.0;TEXT INTEGRATION UTILITIES;**109,113**;Jun 20, 1997
3 ; This routine is a modified version of TIUPUTCN
4LOOKUP ; Look-up code used by router/filer
5 ; Required: TIUSSN, TIUVDT, TIUCNNBR
6 N DA,DFN,TIU,TIUDAD,TIUDPRM,TIUEDIT,TIUEDT,TIULDT,TIUXCRP,TIUTYPE,TIUNEW,TIUDNB
7 I $S('$D(TIUSSN):1,'$D(TIUVDT):1,$G(TIUSSN)?4N:1,$G(TIUSSN)']"":1,1:0) S Y=-1 G LOOKUPX
8 I TIUSSN?3N1P2N1P4N.E S TIUSSN=$TR(TIUSSN,"-/","")
9 I TIUSSN["?" S Y=-1 G LOOKUPX
10 S TIULOC=+$$ILOC(TIULOC)
11 I '$D(^SC(+$G(TIULOC),0)) S Y=-1 G LOOKUPX
12 S TIUINST=+$$DIVISION^TIULC1(TIULOC)
13 S TIUEDT=$$IDATE^TIULC(TIUVDT),TIULDT=$$FMADD^XLFDT(TIUEDT,1)
14 I +TIUEDT'>0 S Y=-1 Q
15 S TIUTYPE=$$WHATITLE(TIUTITLE)
16 I +TIUTYPE'>0 S Y=-1 Q
17 I $P($G(^SC(+TIULOC,0)),U,3)="W" D I 1
18 . D MAIN^TIUMOVE(.TIU,.DFN,TIUSSN,TIUEDT,TIULDT,1,"LAST",0,TIULOC)
19 E D MAIN^TIUVSIT(.TIU,.DFN,TIUSSN,TIUEDT,TIULDT,"LAST",0,TIULOC)
20 I $S($D(TIU)'>9:1,+$G(DFN)'>0:1,1:0) S Y=-1 G LOOKUPX
21 I $P(+$G(TIU("EDT")),".")'=$P($$IDATE^TIULC(TIUVDT),".") S Y=-1 G LOOKUPX
22 D DOCPRM^TIULC1(TIUTYPE,.TIUDPRM)
23 ;
24 ;Check consult associated with document
25 I '$$CHKCN($G(TIUCNNBR),DFN,$G(TIUPLDA),.TIUDNB) S Y=-1 G LOOKUPX
26 ;
27 ;Check status of consult as it relates to CP
28 I '$$CHKCP($G(TIUCNNBR),$G(TIUPLDA),.TIUDNB) S Y=-1 G LOOKUPX
29 S TIUTYP(1)=1_U_TIUTYPE_U_$$PNAME^TIULC1(TIUTYPE)
30 ;
31 ;If TIU document IEN is defined use it, otherwise call TIUEDI3
32 I $G(TIUPLDA)>0 D
33 . S Y=TIUPLDA
34 ELSE D
35 . S Y=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM)
36 I +Y'>0 G LOOKUPX
37 ; If record is not new, has text and can be edited, then replace
38 ; existing text
39 I +$G(TIUNEW)'>0 D
40 . S TIUEDIT=$$CANEDIT(+Y)
41 . I +TIUEDIT>0,$D(^TIU(8925,+Y,"TEXT")) D DELTEXT(+Y)
42 . I +TIUEDIT'>0 S TIUDAD=+Y,Y=$$MAKEADD
43 I +Y'>0 Q
44 D STUFREC(Y,+$G(TIUDAD))
45 I +$G(TIUDAD) D SENDADD^TIUALRT(+Y)
46 ;Kill elements of TIUHDR so data is not filed twice
47 K TIUHDR(.01),TIUHDR(.07),TIUHDR(1301)
48 K TIUHDR(.001),TIUHDR(70201),TIUHDR(70202)
49LOOKUPX Q
50ILOC(LOCATION) ; Get pointer to file 44
51 N DIC,X,Y
52 S DIC=44,DIC(0)="M",X=LOCATION D ^DIC
53 Q Y
54CANEDIT(DA) ; Check if document is not released yet
55 Q $S(+$P($G(^TIU(8925,+DA,0)),U,5)<4:1,1:0) ;TIU*1*131
56 ;
57CHKCN(TIUCDA,DFN,TIUDA,TIUDNB) ;Check if Consult is associated with correct patient
58 ;and document
59 ; Input -- TIUCDA Request/Consult file (#123) IEN
60 ; DFN Patient file (#2) IEN
61 ; TIUDA TIU Document file (#8925) IEN (Optional)
62 ; Output -- 1=Successful and 0=Failure
63 ; TIUDNB Dialogue Number for Error Message (Optional)
64 N OKF
65 ;
66 I $G(TIUCDA)']"" S TIUDNB=89250009 G CHKCNQ
67 ;
68 ;Check if the patient is associated with the consult
69 I '$$CPPAT^GMRCCP(TIUCDA,DFN) S TIUDNB=89250006 G CHKCNQ
70 ;
71 ;Check 0th node and consult if document IEN is defined
72 I $G(TIUDA)>0 D G CHKCNQ:$G(TIUDNB)
73 . ;Check if 0th node of document is defined
74 . I $G(^TIU(8925,TIUDA,0))="" S TIUDNB=89250007 Q
75 . ;Check if consult is associated with the document
76 . I +$P($G(^TIU(8925,TIUDA,14)),U,5)'=TIUCDA S TIUDNB=89250008 Q
77 ;
78 ;Set success flag
79 S OKF=1
80 ;
81CHKCNQ Q +$G(OKF)
82 ;
83CHKCP(TIUCDA,TIUDA,TIUDNB) ;Check status of Consult as it relates to CP
84 ; Input -- TIUCDA Request/Consult file (#123) IEN
85 ; TIUDA TIU Document file (#8925) IEN (Optional)
86 ; Output -- 1=Successful and 0=Failure
87 ; TIUDNB Dialogue Number for Error Message (Optional)
88 N OKF,TIUCPACT
89 S TIUCPACT=$$CPACTM^GMRCCP(TIUCDA)
90 I 'TIUCPACT S TIUDNB=89250010 G CHKCPQ
91 I TIUCPACT=2 S TIUDNB=89250011 G CHKCPQ
92 I TIUCPACT=3,$G(TIUDA)'>0 S TIUDNB=89250012 G CHKCPQ
93 ;
94 ;Set success flag
95 S OKF=1
96 ;
97CHKCPQ Q +$G(OKF)
98 ;
99MAKEADD() ; Create an addendum record
100 N DIE,DR,DA,DIC,X,Y,DLAYGO,TIUATYP,TIUFPRIV S TIUFPRIV=1
101 S TIUATYP=+$$WHATITLE^TIUPUTU("ADDENDUM")
102 S (DIC,DLAYGO)=8925,DIC(0)="L",X=""""_"`"_TIUATYP_""""
103 D ^DIC
104 S DA=+Y
105 I +DA>0 S DIE=DIC,DR=".04////"_$$DOCCLASS^TIULC1(TIUATYP) D ^DIE
106 K TIUHDR(.01)
107 Q +DA
108STUFREC(DA,PARENT) ; Stuff fixed field data
109 N FDA,FDARR,IENS,FLAGS,TIUMSG,TIUPSCI,TIUDTPI
110 S IENS=""""_DA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
111 I +$G(PARENT)'>0 D
112 . I '$G(TIUPLDA) D
113 . . S @FDARR@(.02)=$G(DFN),@FDARR@(.03)=$P($G(TIU("VISIT")),U)
114 . . S @FDARR@(.07)=$P($G(TIU("EDT")),U)
115 . . S @FDARR@(.08)=$P($G(TIU("LDT")),U)
116 . . S @FDARR@(1201)=$$NOW^TIULC
117 . . S @FDARR@(1205)=$S(+$P($G(TIU("LOC")),U):$P($G(TIU("LOC")),U),1:$P($G(TIU("VLOC")),U))
118 . . S @FDARR@(1404)=$P($G(TIU("SVC")),U)
119 . I '$G(TIUPLDA)!('$P($G(^TIU(8925,+$G(TIUPLDA),13)),U,4)) S @FDARR@(.05)=3
120 I +$G(PARENT)>0 D
121 . S @FDARR@(.02)=+$P($G(^TIU(8925,+PARENT,0)),U,2)
122 . S @FDARR@(.03)=$P($G(^TIU(8925,+PARENT,0)),U,3)
123 . S @FDARR@(.05)=3
124 . S @FDARR@(.06)=PARENT
125 . S @FDARR@(.07)=$P($G(^TIU(8925,+PARENT,0)),U,7)
126 . S @FDARR@(.08)=$P($G(^TIU(8925,+PARENT,0)),U,8)
127 . S @FDARR@(1205)=$P($G(^TIU(8925,+PARENT,12)),U,5)
128 . S @FDARR@(1404)=$P($G(^TIU(8925,+PARENT,14)),U,4)
129 . S @FDARR@(1201)=$$NOW^TIULC
130 I '$G(TIUPLDA) S @FDARR@(1205)=$P($G(TIU("LOC")),U)
131 S @FDARR@(1212)=$P($G(TIU("INST")),U)
132 S @FDARR@(1301)=$S($G(TIUDDT)]"":$$IDATE^TIULC($G(TIUDDT)),1:"")
133 I @FDARR@(1301)'>0 S @FDARR@(1301)=$G(@FDARR@(.07))
134 S @FDARR@(1303)="U"
135 I $G(TIUPSC)]"" D VAL^DIE(8925,DA,70201,,TIUPSC,.TIUPSCI)
136 S @FDARR@(70201)=$S($G(TIUPSCI):TIUPSCI,1:"")
137 I '$G(TIUPLDA)!($P($G(^TIU(8925,+$G(TIUPLDA),702)),U,2))="" D
138 . I $G(TIUDTP)]"" D VAL^DIE(8925,DA,70202,,TIUDTP,.TIUDTPI)
139 . S @FDARR@(70202)=$S($G(TIUDTPI):TIUDTPI,1:"")
140 D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
141 Q
142DELTEXT(DA) ; Delete existing text in preparation for replacement
143 N DIE,DR,X,Y
144 S DIE=8925,DR="2///@" D ^DIE
145 Q
146WHATYPE(X) ; Identify document type
147 ; Receives: X=Document Definition Name
148 ; Returns: Y=Document Definition IFN
149 N DIC,Y,TIUFPRIV S TIUFPRIV=1
150 S DIC=8925.1,DIC(0)="M"
151 S DIC("S")="I +$O(^TIU(8925.1,+Y,""HEAD"",0))!+$O(^TIU(8295.1,+Y,""ITEM"",0))"
152 D ^DIC K DIC("S")
153WHATYPX Q Y
154WHATITLE(X) ; Identify document title
155 ; Receives: X=Document Definition Name
156 ; Returns: Y=Document Definition IFN
157 N DIC,Y,TIUFPRIV,SCREEN,TIUCLASS S TIUFPRIV=1
158 S DIC=8925.1,DIC(0)="M",TIUCLASS=+$$CLASS^TIUCP
159 S SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",+$$ISA^TIULX(+Y,"_TIUCLASS_"),+$$CANPICK^TIULP(+Y)"
160 S DIC("S")=SCREEN
161 D ^DIC K DIC("S")
162WHATITX Q Y
163FOLLOWUP(TIUDA) ; Post-filing code for CLINICAL PROCEDURES
164 N FDA,FDARR,IENS,FLAGS,TIUMSG,TIU,DFN
165 S IENS=""""_TIUDA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
166 S @FDARR@(1204)=$$WHOSIGNS^TIULC1(TIUDA)
167 I +$P($G(^TIU(8925,TIUDA,12)),U,9),'+$P($G(^(12)),U,8) D
168 . S @FDARR@(1208)=$$WHOCOSIG^TIULC1(TIUDA)
169 D FILE^DIE(FLAGS,"FDA","TIUMSG")
170 I +$P($G(^TIU(8925,+TIUDA,12)),U,8),(+$P($G(^TIU(8925,+TIUDA,12)),U,4)'=+$P($G(^(12)),U,8)) D
171 . S @FDARR@(1506)=1 D FILE^DIE(FLAGS,"FDA","TIUMSG")
172 D RELEASE^TIUT(TIUDA,1)
173 D AUDIT^TIUEDI1(TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
174 I +$P($G(^TIU(8925,+TIUDA,14)),U,5) D
175 . N TIUCDA,DA S TIUCDA=+$P($G(^TIU(8925,+TIUDA,14)),U,5)
176 . W !,$$PNAME^TIULC1(+$G(^TIU(8925,+TIUDA,0)))," #: ",TIUDA
177 . W " Linked to Consult Request #: ",TIUCDA,".",!
178 . ; Post result in CT Pkg
179 . D GET^GMRCTIU(TIUCDA,TIUDA,"INCOMPLETE RPT")
180 I '$D(TIU("VSTR")) D
181 . N TIUD0,TIUD12,TIUVLOC,TIUHLOC,TIUEDT,TIULDT
182 . S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^(12))
183 . S DFN=+$P(TIUD0,U,2),TIUEDT=+$P(TIUD0,U,7)
184 . S TIULDT=$$FMADD^XLFDT(TIUEDT,1),TIUHLOC=+$P(TIUD12,U,5)
185 . S TIUVLOC=$S(+$P(TIUD12,U,11):+$P(TIUD12,U,11),1:+TIUHLOC)
186 . I $S(+DFN'>0:1,+TIUEDT'>0:1,+TIULDT'>0:1,+TIUVLOC'>0:1,1:0) Q
187 . D MAIN^TIUVSIT(.TIU,DFN,"",TIUEDT,TIULDT,"LAST",0,+TIUVLOC)
188 Q:'$D(TIU("VSTR"))
189 D QUE^TIUPXAP1 ; Get/file VISIT
190 Q
191GETCP ; Help get Fields for CP Dictation/Error Resolution
192 N TIU,DFN,TIUY,TITLE,TIUBUF,TIUPLDA,TIUMVN,TIUVSTR
193 W ! S DFN=+$$PATIENT^TIULA G GETCPQ:+DFN'>0
194 S TIUBUF=$S(+$G(BUFDA):+$G(BUFDA),+$G(XQADATA):+$G(XQADATA),1:"")
195 ;If there is a buffer entry with a TIU Document Number, ask for document
196 I $G(TIUBUF),$$CHKUPL(TIUBUF) D G GETCPQ:'$D(TIU)
197 . I $$ASKUPL(DFN,.TIUPLDA) D
198 . . ;If Patient Movement
199 . . I +$G(^TIU(8925,+TIUPLDA,14)) D
200 . . . S TIUMVN=+$G(^TIU(8925,+TIUPLDA,14))
201 . . ;Else set up Visit string
202 . . ELSE D
203 . . . S TIUVSTR=$P($G(^TIU(8925,+TIUPLDA,12)),U,11)_";"_$P($G(^TIU(8925,+TIUPLDA,0)),U,7)_";"_$P($G(^TIU(8925,+TIUPLDA,0)),U,13)
204 . . ;Populate demographic and Visit information
205 . . D PATVADPT^TIULV(.TIU,DFN,$G(TIUMVN),$G(TIUVSTR))
206 ELSE D G GETCPQ:'$D(TIU)
207 . ;If there is no stub ask for Visit
208 . D ENPN^TIUVSIT(.TIU,+DFN,1)
209 . I '$D(TIU) Q
210 . S TIUY=$$CHEKPN^TIUCHLP(.TIU)
211 D MAKE^TIUCPFIX(.SUCCESS,DFN,.TITLE,.TIU,$G(TIUBUF),$G(TIUPLDA))
212 I +SUCCESS D
213 . S TIUDONE=1
214 ELSE D
215 . W !!,"Please correct the buffered upload data.",!,$P(SUCCESS,U,2),!
216 . I $$READ^TIUU("FOA","Press RETURN to continue...") W ""
217GETCPQ Q
218 ;
219CHKUPL(TIUBUF) ;Check if Buffer Entry has TIU Document Number
220 ; Input -- TIUBUF TIU Upload Buffer file (#8925.2) IEN
221 ; Output -- 1=Yes and 0=No
222 N TIUX,Y
223 D LOADTIUX^TIUCPFIX(.TIUX,TIUBUF)
224 I $G(TIUX(.001)) S Y=1
225 Q +$G(Y)
226 ;
227ASKUPL(DFN,TIUPLDA) ;Ask TIU Document Number for Error Resolution
228 ; Input -- DFN Patient file (#2) IEN
229 ; Output -- 1=Successful and 0=Failure
230 ; TIUPLDA TIU Document file (#8925) IEN
231 N D,DD,DIC,DINUM,DLAYGO,D0,X,Y
232 S DIC="^TIU(8925,",DIC(0)="EUVX",D="C"
233 S X=DFN
234 S DIC("S")="I $P(^(0),U,5)=1,+$$ISA^TIULX(+$P(^(0),U),+$$CLASS^TIUCP)"
235 S DIC("W")="D ID^TIUPUTCP(+Y)"
236 D IX^DIC
237 I Y>0 S TIUPLDA=+Y
238 Q $S($G(TIUPLDA)="":0,1:1)
239 ;
240ID(TIUDA) ;Display TIU Document Information for Error Resolution
241 ; Input -- TIUDA TIU Document file (#8925) IEN (Optional)
242 ; Output -- None
243 W !?12,"Document #: ",TIUDA
244 W ?34,"Dated: ",$$DATE^TIULS(+$G(^TIU(8925,+TIUDA,13)),"MM/DD/CCYY@HR:MIN")
245 W ?60,"Consult #: ",+$P($G(^TIU(8925,+TIUDA,14)),U,5)
246 Q
Note: See TracBrowser for help on using the repository browser.