source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCIAC2.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1GMRCIAC2 ;SLC/JFR - FILE IFC ACTIVITIES CONT'D ;07/08/03 11:30
2 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,35**;DEC 27, 1997
3 Q ;can't start here
4FILRES(GMRCO,GMRCOBX) ;file or delete results
5 N GMRCRES,GMRCFIL,GMRCSITE,GMRCROOT,RESIEN,GMRCERR
6 S GMRCRES=+$P(GMRCOBX,"|",5)
7 S GMRCFIL=$P($P(GMRCOBX,"|",3),U,3)
8 S GMRCROOT=$S($P($P(GMRCOBX,"|",3),U,2)["TIU":"TIU(",1:"MCAR(")
9 S GMRCFIL=$P(GMRCFIL,"VA",2)
10 S GMRCRES=GMRCRES_";"_GMRCROOT_GMRCFIL
11 S GMRCSITE=$$IEN^XUAF4($P($P(GMRCOBX,"|",5),U,3))
12 I $P(GMRCOBX,"|",11)'="D" D ;add new result
13 . S FDA(1,123.051,"+1,"_GMRCO_",",.01)=$$NOW^XLFDT
14 . S FDA(1,123.051,"+1,"_GMRCO_",",.02)=GMRCRES
15 . S FDA(1,123.051,"+1,"_GMRCO_",",.03)=GMRCSITE
16 I $P(GMRCOBX,"|",11)="D" D ; find and delete result
17 . N RESIEN
18 . S RESIEN=$O(^GMR(123,GMRCO,51,"AR",GMRCRES,GMRCSITE,0))
19 . I 'RESIEN Q
20 . S FDA(1,123.051,RESIEN_","_GMRCO_",",.01)="@"
21 I '$D(FDA) Q
22 D UPDATE^DIE("","FDA(1)",,"GMRCERR")
23 Q
24 ;
25UPDORD(GMRCDA,GMRC40) ; update CPRS order if action on placer order.
26 ; Input:
27 ; GMRCDA = ien from file 123
28 ; GMRC40 = ien of activity in 40 multiple
29 ;
30 N GMRCDFN,GMRCAD,AC,GMRCOC,GMRCMT
31 S GMRCDFN=$P(^GMR(123,GMRCDA,0),U,2)
32 I $O(^GMR(123,GMRCDA,40,GMRC40,1,0)) D
33 . S GMRCMT=1,GMRCMT(0)=GMRC40
34 S GMRCAD=$P(^GMR(123,GMRCDA,40,GMRC40,0),U,3)
35 S AC=$P(^GMR(123,GMRCDA,40,GMRC40,0),U,2)
36 S GMRCOC=$S(AC=6:"OD",AC=19:"OC",AC=10:"RE",AC=9:"RE",AC=8:"ZC",1:"SC")
37 D EN^GMRCHL7(GMRCDFN,GMRCDA,"","",GMRCOC,"","",.GMRCMT,,GMRCAD)
38 Q
39FILEACT(GMRCO,GMRCLAST,GMRCFR,GMRCAR) ;file REQUEST PROCESSING ACTIVITY
40 ; Input:
41 ; GMRCO = ien from file 123
42 ; GMRCLAST = last action taken on request
43 ; GMRCFR = service that consult was forwarded from
44 ; GMRCAR = name of the array containing the message
45 ;
46 N GMRCORC,GMRCFDA,GMRCRP,GMRCEP,GMRCACT,GMRCERR,FDA
47 M ^TMP("GMRCFIL",$J)=@GMRCAR
48 S GMRCORC=^TMP("GMRCFIL",$J,"ORC")
49 S GMRCFDA(.01)=$$NOW^XLFDT
50 S GMRCFDA(.25)=$$HL7TFM^XLFDT($P(GMRCORC,"|",9))
51 S GMRCFDA(1)=GMRCLAST
52 S GMRCFDA(2)=$$HL7TFM^XLFDT($P(GMRCORC,"|",15))
53 D ;get entering and responsible persons
54 . D UNHLNAME^GMRCIUTL($P(GMRCORC,"|",10),.GMRCEP,0,U)
55 . D UNHLNAME^GMRCIUTL($P(GMRCORC,"|",12),.GMRCRP,0,U)
56 S GMRCFDA(.21)=GMRCEP
57 S GMRCFDA(.22)=GMRCRP
58 S GMRCFDA(.23)=$P($G(^TMP("GMRCFIL",$J,"OBX",5,1)),"|",5)
59 I $D(GMRCFR) S GMRCFDA(.31)=GMRCFR
60 I $D(^TMP("GMRCFIL",$J,"OBX",4)) D
61 . N RFIL,RSLT,DESC,GMRCOBX,ROOT,RSITE
62 . S GMRCOBX=^TMP("GMRCFIL",$J,"OBX",4,1)
63 . S RFIL=$P($P(GMRCOBX,"|",3),U,3),RFIL=$P(RFIL,"VA",2)
64 . S RSLT=+$P(GMRCOBX,"|",5)
65 . S RSITE=$$IEN^XUAF4($P($P(GMRCOBX,"|",5),U,3))
66 . S ROOT=$S($P($P(GMRCOBX,"|",3),U,2)["TIU":"TIU(",1:"MCAR(")
67 . S DESC=$P($P(GMRCOBX,"|",5),U,2)
68 . S GMRCFDA(.24)=RSLT_";"_ROOT_RFIL_";"_DESC_";"_RSITE
69 I GMRCLAST=10 D ; overwite inc. report in last action?
70 . N GMRCLACT
71 . S GMRCLACT=$O(^GMR(123,GMRCO,40," "),-1)
72 . I '$G(GMRCLACT) Q
73 . I $P($G(^GMR(123,GMRCO,40,GMRCLACT,0)),U,2)'=9 Q
74 . I $$FMDIFF^XLFDT($$NOW^XLFDT,+^GMR(123,GMRCO,40,GMRCLACT,0),2)>900 Q
75 . I $P($G(^GMR(123,GMRCO,40,GMRCLACT,2)),U,4)=GMRCFDA(.24) D
76 .. S GMRCACT(1)=GMRCLACT
77 .. M FDA(1,123.02,GMRCACT(1)_","_GMRCO_",")=GMRCFDA
78 .. D UPDATE^DIE("","FDA(1)",,"GMRCERR")
79 . Q
80 I '$D(GMRCACT(1)) D ; need to create new activity
81 . M FDA(1,123.02,"+1,"_GMRCO_",")=GMRCFDA
82 . D UPDATE^DIE("","FDA(1)","GMRCACT","GMRCERR")
83 K GMRCFDA,FDA
84 D ; file comments if present
85 . I $D(^TMP("GMRCFIL",$J,"OBX",3)) D ; general comments
86 .. N TMPARR
87 .. S TMPARR=$NA(^TMP("GMRCFIL",$J,"OBX",3))
88 .. D TRIMWP^GMRCIUTL(TMPARR,5)
89 .. D WP^DIE(123.02,GMRCACT(1)_","_GMRCO_",",5,"K",TMPARR)
90 . I $D(^TMP("GMRCFIL",$J,"NTE")) D ; DC or cancel comments
91 .. N TMPARR
92 .. S TMPARR=$NA(^TMP("GMRCFIL",$J,"NTE"))
93 .. D TRIMWP^GMRCIUTL(TMPARR,3)
94 .. D WP^DIE(123.02,GMRCACT(1)_","_GMRCO_",",5,"K",TMPARR)
95 .. Q
96 D ; update order if necessary
97 . I $P($G(^GMR(123,GMRCO,12)),U,5)="F" Q ; fillers have no order
98 . I GMRCLAST=11!(GMRCLAST=13)!(GMRCLAST=14) Q ;no status chg
99 . I GMRCLAST=4!(GMRCLAST=20) Q ;no status chg
100 . D UPDORD(GMRCO,GMRCACT(1))
101 K ^TMP("GMRCFIL",$J)
102 Q
103 ;
104TST(ARRAY) ;process test message and check item ordered
105 ;Input:
106 ; ARRAY = name of array containing message parts
107 ;
108 N GMRCFDA,GMRCORC,GMRCDA,GMRCITM,GMRCITER
109 K ^TMP("GMRCIN",$J)
110 M ^TMP("GMRCIN",$J)=@ARRAY
111 D ;get ordered item and service
112 . S GMRCITM=$P(^TMP("GMRCIN",$J,"OBR"),"|",4)
113 . I GMRCITM["VA1233" D ; proc
114 .. N PROC
115 .. S PROC=$$GETPROC^GMRCIUTL(GMRCITM)
116 .. I +PROC'>0!('$P(PROC,U,2)) S GMRCITER=$P(PROC,U,3) Q
117 . I GMRCITM["VA1235" D
118 .. N SERV
119 .. S SERV=$$GETSERV^GMRCIUTL(GMRCITM) ;consult
120 .. I +SERV'>0 S GMRCITER=$P(SERV,U,3)
121 I $D(GMRCITER) D ;error in procedure or service, reject new order
122 . N GMRCRSLT
123 . D RESP^GMRCIUTL("AR",HL("MID"),,,GMRCITER) ;build HLA(
124 . D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT)
125 I '$D(GMRCITER) D
126 . N GMRCRSLT
127 . D RESP^GMRCIUTL("AA",HL("MID")) ;build HLA(
128 . D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT)
129 K ^TMP("GMRCIN",$J)
130 Q
131 ;
132GETDA(GMRCORC) ; determine what local Consult ien to work on
133 ; Input:
134 ; GMRCORC = ORC seg from incoming message
135 ; Output:
136 ; ien from file 123
137 ;
138 N GMRCORC2,GMRCORC3
139 S GMRCORC2=$P(GMRCORC,"|",2),GMRCORC3=$P(GMRCORC,"|",3)
140 I $$IEN^XUAF4($P(GMRCORC2,U,2))=$$KSP^XUPARAM("INST") Q +GMRCORC2
141 Q +GMRCORC3
142 ;
143DUPACT(GMRCO,ACTVT,ORC,OBX) ;check to see if activity is a dup transmission
144 ;Input:
145 ; GMRCO = ien of consult
146 ; ACTVT = ien of activity from file 123.1
147 ; ORC = ORC segment from message
148 ; OBX = OBX segment containing result
149 ;
150 ;Output:
151 ; 0 = activity is not a duplicate of one on file already
152 ; 1 = duplicate, activity already on file
153 ;
154 N GMRCIADT,GMRCIFDT,DUP
155 S GMRCIFDT=+$$HL7TFM^XLFDT($P(ORC,"|",9))
156 S GMRCIADT=+$$HL7TFM^XLFDT($P(ORC,"|",15))
157 S DUP=0
158 I $D(^GMR(123,GMRCO,40,"AC",ACTVT,GMRCIFDT,GMRCIADT)) D Q DUP ;dupl.
159 . N RSLT,RFIL,RSITE,ROOT
160 . I $L($G(OBX)) D Q:'$G(DUP)
161 .. S RFIL=$P($P(OBX,"|",3),U,3),RFIL=$P(RFIL,"VA",2)
162 .. S RSLT=+$P(OBX,"|",5)
163 .. S RSITE=$$IEN^XUAF4($P($P(OBX,"|",5),U,3))
164 .. S ROOT=$S($P($P(OBX,"|",3),U,2)["TIU":"TIU(",1:"MCAR(")
165 .. S RSLT=RSLT_";"_ROOT_RFIL
166 .. I ACTVT=12,$D(^GMR(123,GMRCO,51,"AR",RSLT,RSITE)) Q ;no dup
167 .. I ACTVT'=12,'$D(^GMR(123,GMRCO,51,"AR",RSLT,RSITE)) Q ;no dup
168 .. S DUP=1
169 . S DUP=1
170 . D APPACK(GMRCO,"AR",802) ;send app. ACK and unlock record
171 Q 0
172 ;
173APPACK(GMRCO,ACK,ERR) ;send application acknowledgement for all cases
174 ;Input:
175 ; GMRCO = ien from file 123
176 ; ACK = ACK code to include ("AA"=accept or "AR"=reject)
177 ; ERR = error code to return if there is one (optional)
178 ;
179 ; Output: none
180 ;
181 ;send appl ACK
182 N GMRCRSLT
183 I '$G(ERR) S ERR=""
184 D RESP^GMRCIUTL(ACK,HL("MID"),,,ERR) ;build HLA("HLA", array
185 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT)
186 ;
187 D UNLKREC^GMRCUTL1(GMRCO) ;unlock record
188 Q
Note: See TracBrowser for help on using the repository browser.