source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCIMSG.m@ 1806

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1GMRCIMSG ;SLC/JFR - IFC MESSAGE HANDLING ROUTINE; 09/26/02 00:23
2 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,51**;DEC 27, 1997
3 ;
4 Q ;don't start at the top
5IN ;process incoming message and save segments to ^TMP(
6 K ^TMP("GMRCIF",$J)
7 N HLNODE,SEG,I,GMRCIER ;production code
8 F I=1:1 X HLNEXT Q:HLQUIT'>0 D
9 . I $P(HLNODE,"|")="OBX" D ;multiple segs for OBX
10 .. S ^TMP("GMRCIF",$J,"OBX",$P(HLNODE,"|",2),$P(HLNODE,"|",5))=$E(HLNODE,5,999)
11 . I $P(HLNODE,"|")="NTE" D ; may be multiple NTE's
12 .. S ^TMP("GMRCIF",$J,"NTE",$P(HLNODE,"|",2))=$E(HLNODE,5,999)
13 . I "OBXNTE"'[$P(HLNODE,"|") D ;all other segs are single
14 .. S ^TMP("GMRCIF",$J,$P(HLNODE,"|"))=$E(HLNODE,5,999)
15 . Q
16 ;
17 I '$$VALMSG(^TMP("GMRCIF",$J,"ORC")) D EX Q ;chk msg for valid cslt #'s
18 ;
19 I $P(^TMP("GMRCIF",$J,"ORC"),"|")="NW" D D EX Q
20 . I $P(^TMP("GMRCIF",$J,"ORC"),"|",2)["TST1234" D D EX Q ;testing impl
21 .. D TST^GMRCIAC2($NA(^TMP("GMRCIF",$J)))
22 . D NW^GMRCIACT($NA(^TMP("GMRCIF",$J)))
23 I $P(^TMP("GMRCIF",$J,"ORC"),"|")="XO" D D EX Q
24 . D RESUB^GMRCIAC1($NA(^TMP("GMRCIF",$J)))
25 I $P(^TMP("GMRCIF",$J,"ORC"),"|")="XX" D D EX Q
26 . D FWD^GMRCIAC1($NA(^TMP("GMRCIF",$J)))
27 I $P(^TMP("GMRCIF",$J,"ORC"),"|")="RE" D D EX Q
28 . I $P($G(^TMP("GMRCIF",$J,"OBX",4,1)),"|",11)="D" D Q
29 .. D DIS^GMRCIACT($NA(^TMP("GMRCIF",$J))) ; dis-assoc. result
30 . I $P($P(^TMP("GMRCIF",$J,"ORC"),"|",16),U)="S" D Q
31 .. D SF^GMRCIAC1($NA(^TMP("GMRCIF",$J))) ; significant findings
32 . D COMP^GMRCIAC1($NA(^TMP("GMRCIF",$J)))
33 D OTHER^GMRCIACT($NA(^TMP("GMRCIF",$J)))
34 D EX
35 Q
36 ;
37EX ; clean up ^TMP(
38 K ^TMP("GMRCIF",$J)
39 Q
40 ;
41ORRIN ;process IFC responses
42 K ^TMP("GMRCIF",$J)
43 N HLNODE,SEG,I ;production code
44 F I=1:1 X HLNEXT Q:HLQUIT'>0 D
45 .S ^TMP("GMRCIF",$J,$P(HLNODE,"|"))=$E(HLNODE,5,999)
46 I $D(^TMP("GMRCIF",$J,"ORC")),$P(^("ORC"),"|")="OK" D
47 . N GMRCFNUM,GMRCROUT,GMRCDA,FDA
48 . S GMRCROUT=$$IEN^XUAF4($P($P(^TMP("GMRCIF",$J,"ORC"),"|",3),U,2))
49 . S GMRCDA=+$P(^TMP("GMRCIF",$J,"ORC"),"|",2)
50 . ;I GMRCROUT'=$P(^GMR(123,GMRCDA,0),U,23) Q
51 . S GMRCFNUM=+$P(^TMP("GMRCIF",$J,"ORC"),"|",3)
52 . S FDA(1,123,GMRCDA_",",.06)=GMRCFNUM
53 . D UPDATE^DIE("","FDA(1)",,"GMRCERR")
54 . Q
55 I $P(^TMP("GMRCIF",$J,"MSA"),"|")="AA" D
56 . N MSGID,MSGLOG,FDA,GMRCDA,GMRCACT,GMRCLOG
57 . S MSGID=$P(^TMP("GMRCIF",$J,"MSA"),"|",2)
58 . S MSGLOG=$O(^GMR(123.6,"AM",MSGID,0)) Q:'MSGLOG
59 . S FDA(1,123.6,MSGLOG_",",.06)="@"
60 . S FDA(1,123.6,MSGLOG_",",.08)="@"
61 . D UPDATE^DIE("","FDA(1)",,"GMRCERR")
62 . S GMRCDA=$P(^GMR(123.6,MSGLOG,0),U,4) Q:'GMRCDA
63 . S GMRCACT=$P(^GMR(123.6,MSGLOG,0),U,5) Q:'GMRCACT
64 . S GMRCACT=$O(^GMR(123.6,"AC",GMRCDA,GMRCACT)) D
65 .. I 'GMRCACT Q
66 .. S GMRCLOG=$O(^GMR(123.6,"AC",GMRCDA,GMRCACT,1,0)) Q:'GMRCLOG
67 .. I $P(^GMR(123.6,GMRCLOG,0),U,8)<900 Q ;re-send 901 & 902 immed.
68 .. D TRIGR^GMRCIEVT(GMRCDA,GMRCACT)
69 . Q
70 I $P(^TMP("GMRCIF",$J,"MSA"),"|")="AR" D
71 . N MSGID,MSGLOG,FDA,GMRCERR,GMRCE
72 . S MSGID=$P(^TMP("GMRCIF",$J,"MSA"),"|",2)
73 . S MSGLOG=$O(^GMR(123.6,"AM",MSGID,0)) Q:'MSGLOG
74 . S GMRCE=$P(^TMP("GMRCIF",$J,"MSA"),"|",3)
75 . S FDA(1,123.6,MSGLOG_",",.08)=GMRCE
76 . I GMRCE=802 S FDA(1,123.6,MSGLOG_",",.06)="@"
77 . D UPDATE^DIE("","FDA(1)",,"GMRCERR")
78 . I GMRCE=901!(GMRCE=902) Q ;no alerts on these probs (yet)
79 . I GMRCE=201 D Q
80 .. I '$$GET^XPAR("SYS","GMRC IFC ALERT IMMED ON PT ERR",1) Q
81 .. D SNDALRT^GMRCIERR(MSGLOG,"C","IFC patient error at remote facility")
82 . D SNDALRT^GMRCIERR(MSGLOG,"C")
83 K ^TMP("GMRCIF",$J)
84 I $T(ORRIN^MAGDTR01)'="" D ;invoke Imaging code if tag^routine exists
85 . D ORRIN^MAGDTR01
86 Q
87 ;
88VALMSG(GMRCORC) ;check to make sure placer and filler # match current entry
89 ; Input:
90 ; GMRCORC = ORC segment from incoming HL7 msg
91 ;
92 I $P(GMRCORC,"|")="NW" Q 1 ; no #'s to match on new order
93 N GMRCPDA,GMRCFDA,GMRCPSIT,GMRCFSIT,GMRCROL,GMRCOK
94 S GMRCPDA=+$P(GMRCORC,"|",2)
95 S GMRCPSIT=$$IEN^XUAF4($P($P(GMRCORC,"|",2),U,2))
96 S GMRCFDA=+$P(GMRCORC,"|",3)
97 S GMRCFSIT=$$IEN^XUAF4($P($P(GMRCORC,"|",3),U,2))
98 I $$KSP^XUPARAM("INST")=GMRCPSIT S GMRCROL="P"
99 I $$KSP^XUPARAM("INST")=GMRCFSIT S GMRCROL="F"
100 S GMRCOK=1
101 I '$D(GMRCROL) S GMRCOK=0,GMRCROL="" ;bad institutions in msg
102 I GMRCROL="P" D
103 . I '$D(^GMR(123,GMRCPDA,0)) S GMRCOK=0 Q ;no such cslt #
104 . I $P(^GMR(123,GMRCPDA,0),U,22)'=GMRCFDA S GMRCOK=0 Q ;cslt # prob
105 . I $P(^GMR(123,GMRCPDA,0),U,23)'=GMRCFSIT S GMRCOK=0 Q ;routing facil.
106 I GMRCROL="F" D
107 . I '$D(^GMR(123,GMRCFDA,0)) S GMRCOK=0 Q ;no such cslt #
108 . I $P(^GMR(123,GMRCFDA,0),U,22)'=GMRCPDA S GMRCOK=0 Q ;cslt # prob
109 . I $P(^GMR(123,GMRCFDA,0),U,23)'=GMRCPSIT S GMRCOK=0 Q ;routing facil.
110 I 'GMRCOK D ;return a 101 error to sending site
111 . N GMRCRSLT
112 . D RESP^GMRCIUTL("AR",HL("MID"),,,101) ;build HLA(
113 . D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT) ;-(
114 Q GMRCOK
115 ;
Note: See TracBrowser for help on using the repository browser.