source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCIACT.m@ 836

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

initial load of WorldVistAEHR
File size: 7.6 KB
Line 
1GMRCIACT ;SLC/JFR - PROCESS ACTIONS ON IFC ;02/10/02 22:13
2 ;;3.0;CONSULT/REQUEST TRACKING;**22,47**;DEC 27, 1997
3 Q ;don't start here!
4NW(ARRAY) ;process and file new order
5 ;Input:
6 ; ARRAY = name of array containing message parts
7 ;
8 N GMRCFDA,GMRCORC,GMRCDA,GMRCITM,GMRCITER,GMRCROUT,GMRCFCN,GMRCLAC
9 K ^TMP("GMRCIN",$J)
10 M ^TMP("GMRCIN",$J)=@ARRAY
11 S GMRCORC=^TMP("GMRCIN",$J,"ORC")
12 D I $D(GMRCITER) Q ;Check for order already being on file
13 . S GMRCFCN=+$P(GMRCORC,"|",2)
14 . S GMRCROUT=$$IEN^XUAF4($P($P(GMRCORC,"|",2),U,2))
15 . I '$O(^GMR(123,"AIFC",GMRCROUT,GMRCFCN,0)) Q ;no dup
16 . S GMRCITER=802
17 . D APPACK^GMRCIAC2(0,"AR",GMRCITER) ;send app. ack w/ error
18 . K ^TMP("GMRCIN",$J) Q
19 I '$D(^TMP("GMRCIN",$J,"PID")) Q ;prepare reject message (no PID)
20 D ;get patient DFN from ICN in message
21 . N PAT
22 . S PAT=$$GETDFN^MPIF001(+$P(^TMP("GMRCIN",$J,"PID"),"|",2))
23 . I +PAT'>1 S GMRCFDA(.02)="" Q
24 . S GMRCFDA(.02)=+PAT
25 I '$G(GMRCFDA(.02)) D Q ;reject message, patient is unknown
26 . N STA S STA=$P($P(^TMP("GMRCIN",$J,"ORC"),"|",2),U,2)
27 . D PTERRMSG^GMRCIERR(^TMP("GMRCIN",$J,"PID"),STA)
28 . D APPACK^GMRCIAC2(0,"AR",201) ; send app. ack w/error
29 . K ^TMP("GMRCIN",$J) Q
30 D ;get ordered item and service
31 . S GMRCITM=$P(^TMP("GMRCIN",$J,"OBR"),"|",4)
32 . I GMRCITM["VA1233" D ; proc
33 .. N PROC
34 .. S PROC=$$GETPROC^GMRCIUTL(GMRCITM)
35 .. I +PROC'>0!('$P(PROC,U,2)) S GMRCITER=$P(PROC,U,3) Q
36 .. S GMRCFDA(4)=$P(PROC,U)_";GMR(123.3,"
37 .. S GMRCFDA(1)=$P(PROC,U,2)
38 . I GMRCITM["VA1235" D
39 .. N SERV
40 .. S SERV=$$GETSERV^GMRCIUTL(GMRCITM) ;consult
41 .. I +SERV'>0 S GMRCITER=$P(SERV,U,3)
42 .. S GMRCFDA(1)=SERV
43 I $D(GMRCITER) D Q ;error in procedure or service, reject new order
44 . D APPACK^GMRCIAC2(0,"AR",GMRCITER) ; send app. ACK
45 . K ^TMP("GMRCIN",$J) Q
46 ;
47 S GMRCFDA(.01)=$$NOW^XLFDT
48 S GMRCFDA(3)=$$HL7TFM^XLFDT($P(GMRCORC,"|",15))
49 S GMRCFDA(6)=$$FIND1^DIC(101,"","X","GMRCPLACE - ON CALL")
50 D ;get urgency to file
51 . N URG
52 . S URG=$$URG^GMRCHL7A($P($P(GMRCORC,"|",7),U,6))
53 . S GMRCFDA(5)=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_URG)
54 S GMRCFDA(8)=5
55 S GMRCFDA(9)=$S($P(GMRCORC,"|",16)["FI":24,1:23),GMRCLAC=GMRCFDA(9)
56 S GMRCFDA(14)=$P(^TMP("GMRCIN",$J,"OBR"),"|",18)
57 S GMRCFDA(.05)=$$IEN^XUAF4(+$P(GMRCORC,"|",17))
58 S GMRCFDA(.06)=GMRCFCN
59 S GMRCFDA(.07)=GMRCROUT
60 D ;get and set ordering prov info & entering person info
61 . N GMRCOP
62 . S GMRCOP=$$FMNAME^XLFNAME($P(GMRCORC,"|",12))
63 . Q:'$L(GMRCOP)
64 . S GMRCFDA(.126)=GMRCOP
65 . Q
66 S GMRCFDA(.125)="F"
67 I $L($P(GMRCORC,"|",14)) D
68 . N GMRCP14 S GMRCP14=$P(GMRCORC,"|",14)
69 . S GMRCFDA(.132)=$P(GMRCP14,"B") ; requestor's phone number
70 . S GMRCFDA(.133)=$P(GMRCP14,"B",2) ; requestor's dig pager
71 S GMRCFDA(13)=$S($D(GMRCFDA(4)):"P",1:"C")
72 I $D(^TMP("GMRCIN",$J,"OBX",2)) D
73 . S GMRCFDA(30)=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U,2)
74 . S GMRCFDA(30.1)=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U)
75 M FDA(1,123,"+1,")=GMRCFDA
76 D UPDATE^DIE("","FDA(1)","GMRCDA","GMRCERR")
77 I '$D(GMRCDA) D Q ;couldn't get new consult #
78 . D APPACK^GMRCIAC2(0,"AR",901) ; send app. ACK
79 . K ^TMP("GMRCIN",$J) Q
80 K GMRCFDA,FDA
81 D ; file reason for request
82 . D TRIMWP^GMRCIUTL($NA(^TMP("GMRCIN",$J,"OBX",1)),5)
83 . D WP^DIE(123,GMRCDA(1)_",",20,"K",$NA(^TMP("GMRCIN",$J,"OBX",1)))
84 . Q
85 D ;file activity tracking
86 . N GMRCSEG
87 . S GMRCSEG("ORC")=GMRCORC
88 . S GMRCSEG("OBX",5,1)=^TMP("GMRCIN",$J,"OBX",5,1)
89 . D FILEACT^GMRCIAC2(GMRCDA(1),GMRCLAC,,"GMRCSEG")
90 D ;print SF-513
91 . I GMRCLAC=24 Q ;don't print if part of a FWD to IFC
92 . D PRNT^GMRCUTL1("",GMRCDA(1))
93 D ;send notifications
94 . I GMRCLAC=24 Q ;no alerts yet if part of FWD to IFC
95 . N GMRCORTX
96 . S GMRCORTX="New remotely ordered consult "_$$ORTX^GMRCAU(+GMRCDA(1))
97 . D MSG^GMRCP($P(^GMR(123,GMRCDA(1),0),U,2),GMRCORTX,GMRCDA(1),27,,1)
98 D ;send appl ack :-(
99 . N GMRCRSLT
100 . D RESP^GMRCIUTL("AA",HL("MID"),$P(GMRCORC,"|"),GMRCDA(1))
101 . D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT)
102 K ^TMP("GMRCIN",$J)
103 Q
104 ;
105DIS(GMRCAR) ;dis-associate a result from a remote request
106 ;Input:
107 ; GMRCAR = array name containing message
108 ; e.g. ^TMP("GMRCIF",$J)
109 N GMRCDA,GMRCFDA,FDA,GMRCERR,GMRCORC
110 M ^TMP("GMRCID",$J)=@GMRCAR
111 S GMRCORC=^TMP("GMRCID",$J,"ORC")
112 S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
113 I '$$LOCKREC^GMRCUTL1(GMRCDA) D Q ;couldn't lock record
114 . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ;send app. ACK
115 . K ^TMP("GMRCID",$J) Q
116 ; v--check to see if a dup transmission
117 I $$DUPACT^GMRCIAC2(GMRCDA,12,GMRCORC,^TMP("GMRCID",$J,"OBX",4,1)) Q
118 ;
119 D FILEACT^GMRCIAC2(GMRCDA,12,,$NA(^TMP("GMRCID",$J))) ; act. tracking
120 D FILRES^GMRCIAC2(GMRCDA,^TMP("GMRCID",$J,"OBX",4,1)) ;file results
121 K GMRCERR,FDA,GMRCFDA
122 I $$STSCHG^GMRCDIS(GMRCDA) S FDA(1,123,GMRCDA_",",8)=6
123 S FDA(1,123,GMRCDA_",",9)=12
124 D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and status
125 D ;send notifications
126 . I $P(^GMR(123,GMRCDA,12),U,5)="F" Q ;DIS from placer before IFC
127 . N GMRCORTX
128 . S GMRCORTX="Remote result removed from "_$$ORTX^GMRCAU(+GMRCDA)
129 . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,63,,1)
130 D ;send appl ACK
131 . D APPACK^GMRCIAC2(GMRCDA,"AA") ; send app. ACK and unlock record
132 K ^TMP("GMRCID",$J)
133 Q
134 ;
135OTHER(GMRCAR) ;process most IFC actions
136 ;will process the receive, schedule, DC, cancel and added comment action
137 ;
138 ;Input:
139 ; GMRCAR = array name containing message
140 ; e.g. ^TMP("GMRCIF",$J)
141 ;
142 N GMRCDA,GMRCFDA,GMRCORC,GMRCLAT,GMRCACT,GMRCROL,FDA
143 K ^TMP("GMRCIN",$J)
144 M ^TMP("GMRCIN",$J)=@GMRCAR
145 ;
146 S GMRCORC=^TMP("GMRCIN",$J,"ORC")
147 S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC) ;get ien to work on
148 S GMRCROL=$P(^GMR(123,GMRCDA,12),U,5)
149 I '$$LOCKREC^GMRCUTL1(GMRCDA) D Q ;couldn't lock record
150 . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ; send app. ACK
151 . K ^TMP("GMRCIN",$J) Q
152 ;
153 I $P(GMRCORC,"|")'="IP" D ; status update
154 . N GMRCOS S GMRCOS=$P(GMRCORC,"|",5)
155 . S GMRCFDA(8)=$S(GMRCOS="IP":6,GMRCOS="SC":8,GMRCOS="CA":13,1:1)
156 . ; IP=receive, SC=schedule, CA=cancel, DC=discontinue
157 D ; get last action taken
158 . I '$G(GMRCFDA(8)) S (GMRCFDA(9),GMRCLAT)=20 Q
159 . I GMRCFDA(8)=6 S (GMRCFDA(9),GMRCLAT)=21 Q
160 . I GMRCFDA(8)=8 S (GMRCFDA(9),GMRCLAT)=8 Q
161 . I GMRCFDA(8)=1 S (GMRCFDA(9),GMRCLAT)=6 Q
162 . I GMRCFDA(8)=13 S (GMRCFDA(9),GMRCLAT)=19 Q
163 ; ^--last action taken
164 ; v-- check to see if a dup transmission
165 I $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAT,GMRCORC) Q
166 ;
167 M FDA(1,123,GMRCDA_",")=GMRCFDA
168 D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and update status
169 K GMRCFDA
170 D FILEACT^GMRCIAC2(GMRCDA,GMRCLAT,,$NA(^TMP("GMRCIN",$J)))
171 D ;send notifications
172 . N GMRCTX,GMRCNOT,GMRCFL
173 . S GMRCFL=1
174 . I GMRCLAT=20!(GMRCLAT=8)!(GMRCLAT=21) D
175 .. I GMRCLAT=20 D I '$D(GMRCTX) Q
176 ... I $P(^GMR(123,GMRCDA,40,1,0),U,2)'=24 D Q
177 .... S GMRCTX="Comment Added to remote"
178 ... N ACT S ACT=1
179 ... F S ACT=$O(^GMR(123,GMRCDA,40,ACT)) Q:'ACT!($D(GMRCTX)) D
180 .... I $P(^GMR(123,GMRCDA,40,ACT,0),U,2)=25,$O(^GMR(123,GMRCDA,40,ACT)) D
181 ..... S GMRCTX="Comment Added to remote"
182 .. I '$D(GMRCTX),GMRCROL="F" Q ;sch & rec on filler part of FWD 2 IFC
183 .. I GMRCLAT=8 S GMRCTX="Scheduled remote"
184 .. I GMRCLAT=21 S GMRCTX="Received remote"
185 .. S GMRCTX=GMRCTX_" Consult: "_$$ORTX^GMRCAU(+GMRCDA)
186 .. S GMRCNOT=63
187 . I GMRCLAT=6 D
188 .. S GMRCFL=$$DCNOTE^GMRCADC(GMRCDA,.5)
189 .. S GMRCTX="Discontinued remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
190 .. S GMRCNOT=23
191 . I GMRCLAT=19 D
192 .. I GMRCROL="F" Q ;canc on a filler is part of FWD 2 IFC
193 .. S GMRCTX="Cancelled remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
194 .. S GMRCNOT=30
195 . I '$D(GMRCNOT) Q ;don't send any alerts
196 . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,GMRCNOT,,GMRCFL)
197 ;
198 D ;send appl ACK
199 . D APPACK^GMRCIAC2(GMRCDA,"AA") ;send app. ACK and unlock record
200 K ^TMP("GMRCIN",$J)
201 Q
202 ;
Note: See TracBrowser for help on using the repository browser.