source: FOIAVistA/tag/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCTIU1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1GMRCTIU1 ;SLC/JER - More CT/TIU interface modules ;7/9/2003 [7/9/03 1:51pm]
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,21,17,34**;DEC 27, 1997
3 ;
4 ;This routine invokes IA #2693
5ROLLBACK(DA,TIUDA) ; Roll-back a CT record when result is deleted or
6 ;reassigned
7 ;Disassociate Note logic
8 ;The action removes the association of a TIU note with a consult.
9 ;The new CPRS status will change to "ACTIVE", unless one of the
10 ;remaining notes has a completed status.
11 ;This action should send an alert to the service notification users.
12 N DIE,DR,GMRCSTS,GMRCA,GMRCO,GMRCOM,GMRCORNP,GMRCDFN,GMRCNODE,GMRCLIST,GMRCD0,GMRCD1,GMRCSF,GMRCADUZ,MSGTOSRV,GMRCATX,GMRCORTX,GMRCSTAR,GMRCERR,ACTDA,ACTREC,GMRCLSCH,GMRCLER,GMRCRBDA,GMRCTDA,GMRCRSLT
13 S GMRCNODE=$G(^GMR(123,+DA,0))
14 ; If current result has never been posted, no need to roll back
15 ; Patch GMRC*1*21
16 I '+$O(^GMR(123,+DA,50,"B",+TIUDA_";TIU(8925,",0)) Q
17 I ($P(GMRCNODE,U,20)=TIUDA) S DIE="^GMR(123,",DR="16///@" D ^DIE
18 S GMRCD0=DA,GMRCD1=0 F S GMRCD1=$O(^GMR(123,GMRCD0,50,GMRCD1)) Q:'GMRCD1 D
19 .N DA,DIK
20 .Q:'(TIUDA=+$G(^GMR(123,GMRCD0,50,GMRCD1,0)))
21 .S DA(1)=GMRCD0,DA=GMRCD1
22 .S DIK="^GMR(123,"_DA(1)_",50,"
23 .D ^DIK
24 ;
25 S GMRCA=12,GMRCO=DA
26 D GETLIST^GMRCTIUL(DA,2,1,.GMRCLIST)
27 S GMRCSTS=9
28 ;Following if statement and DO block accomplish the following
29 ;If there are no other associated TIU Docs then
30 ;Set status to scheduled if it was last status before the TIU doc
31 ;Set status to pending if it was the last status before the TIU doc
32 ;Set status to active otherwise
33 I '$G(GMRCLIST(0)) S GMRCSTS=6 D
34 .S ACTDA=0,ACTREC=0,GMRCRBDA=0,GMRCLER=-1,GMRCLSCH=-1
35 .F S ACTDA=$O(^GMR(123,DA,40,ACTDA)) Q:-ACTDA=0 D
36 ..S ACTREC=$G(^GMR(123,DA,40,ACTDA,0))
37 ..I $P(ACTREC,U,2)=9,$P($P(ACTREC,U,9),";",1)=TIUDA S GMRCRBDA=ACTDA
38 ..I $P(ACTREC,U,2)=8 S GMRCLSCH=ACTDA
39 ..I $P(ACTREC,U,2)=11 S GMRCLER=ACTDA
40 .I GMRCLER'=-1,GMRCLER>GMRCLSCH S GMRCSTS=5
41 .I GMRCLSCH'=-1,GMRCLSCH>GMRCLER S GMRCSTS=8
42 E S GMRCD0="" F S GMRCD0=$O(^TMP("GMRC50",$J,GMRCD0)) Q:'$L(GMRCD0) D
43 .Q:(+GMRCD0=TIUDA)
44 .S GMRCD1=0 F S GMRCD1=$O(^TMP("GMRC50",$J,GMRCD0,GMRCD1)) Q:'GMRCD1 D
45 ..S:($P($G(^TMP("GMRC50",$J,GMRCD0,GMRCD1)),U,6)="completed") GMRCSTS=2
46 Q:$G(NOSAVE)
47 ;Make status completed if the Consult was Admin. Completed
48 S ACTDA=0,ACTREC=0
49 F S ACTDA=$O(^GMR(123,DA,40,ACTDA)) Q:-ACTDA=0 D
50 .S ACTREC=$G(^GMR(123,DA,40,ACTDA,0))
51 .I $P(ACTREC,U,2)=10,$P(ACTREC,U,9)="" S GMRCSTS=2
52 D STATUS^GMRCP
53 K ^TMP("GMRC50",$J),^TMP("GMRC50R",$J)
54 ;
55 S GMRCOM=0,MSGTOSRV=0,GMRCRSLT=TIUDA_";TIU(8925," D AUDIT^GMRCP
56 ;
57 ;Build message information if status has changed or sig finding="Y"
58 S GMRCSF=$P(GMRCNODE,U,19)
59 I ($P(GMRCNODE,U,12)=$P($G(^GMR(123,GMRCO,0)),U,12)) D Q:GMRCATX=""
60 . S GMRCATX="" Q:GMRCSF'="Y"
61 . S GMRCATX="*Removed consult note for "
62 E S GMRCATX=$S((GMRCSF="Y"):"*",1:"")_"Reactivated consult, removed note for ",MSGTOSRV=1
63 S GMRCORNP=$P(GMRCNODE,U,14),GMRCDFN=$P(GMRCNODE,U,2)
64 S GMRCORTX=$$ORTX^GMRCAU(GMRCO)
65 S GMRCORTX=GMRCATX_GMRCORTX
66 S:GMRCORNP GMRCADUZ(GMRCORNP)=""
67 S GMRCTDA=TIUDA
68 D EXTRACT^TIULQ(GMRCTDA,"GMRCSTAR",.GMRCERR,.05)
69 I '$G(GMRCERR) D
70 .I $G(GMRCSTAR(GMRCTDA,.05,"I"))'=5 D
71 ..D MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,23,.GMRCADUZ,MSGTOSRV)
72 Q:($P(GMRCNODE,U,12)=$P($G(^GMR(123,+GMRCO,0)),U,12))
73 ;
74 ;On status change, send "SC" (status change) HL7 msg to update order
75 D EN^GMRCHL7(GMRCDFN,+GMRCO,$G(GMRCTYPE),$G(GMRCRB),"SC",GMRCORNP,$G(GMRCVSIT),.GMRCOM)
76 Q
77 ;
78STATUS ;Update the status of a consult that has a TIU result
79 N GMRCAD,GMRCATX,GMRCOA,GMRCOSTS,GMRCOTFN,GMRC,GMRCSF,GMRCLAE,GMRCRSLT,GMRCADUZ,GMRCOADT
80 D GETOLD
81 S GMRCORNP=$G(GMRCAUTH) ;author
82 S GMRCRSLT=GMRCTUFN_";TIU(8925,"
83 ;
84 ;Evaluate whether a complete action is actually an addendum or New note
85 I GMRCA=10 S GMRCA=$$EVALACT(GMRCOSTS,+GMRCO,GMRCRSLT)
86 ;
87 ;Update the status and last activity field
88 ;Do not change the status if already completed
89 I GMRCOSTS=2,GMRCSTS=9 S GMRCSTS=2
90 D STATUS^GMRCP
91 ;
92 ;Update activity log
93 D AUDIT
94 ;
95 ;Update the last TIU entry modified and add result to result multiple
96 D ADD^GMRCTIUA(GMRCTUFN,GMRCO)
97 ;
98 ;Update order
99 S GMRCORNP=$P(^GMR(123,+GMRCO,0),"^",14)
100 D EN^GMRCHL7(GMRCDFN,+GMRCO,$G(GMRCTYPE),$G(GMRCRB),"RE",GMRCORNP,$G(GMRCVSIT),.GMRCOM)
101 ;
102 ;Send a message
103 I $$COMPLETE(GMRCA) D
104 . N GMRCDATA
105 . S GMRCATX=""
106 . I GMRCA=14 S GMRCATX="New Note for "
107 . I GMRCA=13 S GMRCATX="Addendum Added for "
108 . S GMRCATX=$S((GMRCSF="Y"):"*",1:"")_GMRCATX
109 . S GMRCORTX=GMRCATX_"Completed Consult "_$$ORTX^GMRCAU(+GMRCO)
110 . S GMRCDATA=+GMRCO
111 . S GMRCDATA=GMRCDATA_"|"_$G(GMRCRSLT)
112 . I $P(GMRC(0),"^",14) S GMRCADUZ($P(GMRC(0),"^",14))=""
113 . D MSG^GMRCP(GMRCDFN,GMRCORTX,GMRCDATA,23,.GMRCADUZ,0)
114 . Q
115 Q
116 ;
117GETOLD ;save the old values of status, and the last activity data
118 ;to determine how to update status and TIU activity log
119 S GMRC(0)=$G(^GMR(123,+GMRCO,0))
120 S GMRCDFN=$P(GMRC(0),"^",2)
121 S GMRCSF=$P(GMRC(0),U,19)
122 S GMRCOSTS=$P(GMRC(0),"^",12) ;status before activity
123 S GMRCLAE=+$P($G(^GMR(123,+GMRCO,40,0)),U,3) ;last activity entry
124 S GMRC(40)=$G(^GMR(123,+GMRCO,40,+GMRCLAE,0))
125 S GMRCOADT=+$P(GMRC(40),U,1) ;last activity entry date
126 S GMRCOA=$P(GMRC(40),"^",2) ;last activity
127 S GMRCOTFN=$P(GMRC(40),"^",9) ;last result
128 Q
129 ;
130AUDIT ;Determine appropriate update activity.
131 ;Quit if new activity is same as previous "Incomplete Rpt" activity
132 I GMRCOTFN=GMRCRSLT,GMRCOA=9,GMRCOA=GMRCA,GMRCOSTS=GMRCSTS Q
133 ;
134 S GMRCOM=0
135 S GMRCDT=$$NOW^XLFDT
136 ;Check for overwrite of incomplete rpt activity if the new
137 ;activity occurs within 15 minutes of the last.
138 S GMRCOADT=$$FMADD^XLFDT(GMRCOADT,0,0,15)
139 I GMRCOTFN=GMRCRSLT,GMRCOA=9,$$COMPLETE(GMRCA),GMRCDT<GMRCOADT D AUDIT1 Q
140 D AUDIT^GMRCP Q
141 Q
142 ;
143AUDIT1 ;overwrite last activity
144 L +^GMR(123,+GMRCO,40):5 I '$T S GMRCUT=1,GMRCERR=1,GMRCERMS="Activity Trail Not filed - Consult In Use By Another User." L -^GMR(123,+GMRCO,40) Q
145 S DA=$P(^GMR(123,+GMRCO,40,0),"^",3)
146 D AUDIT1^GMRCP
147 Q
148 ;
149COMPLETE(GMRCA) ;Determine if the action is a complete action (10,13,14)
150 Q $S(GMRCA=13:1,GMRCA=14:1,GMRCA=10:1,1:0)
151 ;
152EVALACT(GMRCOSTS,GMRCO,GMRCRSLT) ;Evaluate complete action based on prev results and sts
153 N EVALA,GMRCLAE
154 I '$D(^GMR(123,+GMRCO,50)) Q 10
155 I GMRCOSTS'=2 Q 10
156 I '$D(^GMR(123,+GMRCO,50,"B",GMRCRSLT)) Q 14
157 S EVALA=0,GMRCLAE=+$P($G(^GMR(123,+GMRCO,40,0)),U,3)+1
158 F S GMRCLAE=$O(^GMR(123,+GMRCO,40,GMRCLAE),-1) Q:'GMRCLAE D Q:+EVALA
159 . S GMRCLAE(40)=^GMR(123,+GMRCO,40,GMRCLAE,0)
160 . I $P(GMRCLAE(40),U,9)=GMRCRSLT D
161 .. I $P(GMRCLAE(40),U,2)=9 S EVALA=14 Q
162 .. I $$COMPLETE($P(GMRCLAE(40),U,2)) S EVALA=13 Q
163 I +EVALA Q EVALA
164 Q 10
165 ;
Note: See TracBrowser for help on using the repository browser.