source: WorldVistAEHR/trunk/r/VISTA_OFFICE_EHR-VEPE/VEPERI0.m@ 1389

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1VEPERI0 ;DAOU/WCJ - Incoming HL7 messages ;2-MAY-2005
2 ;;1.0;VOEB;;Jun 12, 2005
3 ;;;VISTA OFFICE/EHR;
4 ;;Per VHA Directive 10-93-142, this routine should not be modified.
5 ;
6 ;**Program Description**
7 ; This program parses each incoming HL7 message.
8 ;
9 Q
10 ;
11 ; Starting points - put message into a TMP global and also HLI array
12 ; The first is when called from protocol.
13 ; The second is when called from the PENDING tag below
14 ;
15EN N DFN,ADDPFLG,FE
16EN2 N SEGCNT,CNT,DUZ,FE,HLI,EVENT,EVENTS,I,DEL,DELIM,SYS
17 N SEGMT,PRTCL,HL,HLECH,HLFS,HLEID,HLEIDS,MSGEVNT,IEN
18 N HLF,HLP
19 ;
20 S FE=0
21 K ^TMP($J,"VEPERI0")
22 F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
23 . S CNT=0
24 . S (^TMP($J,"VEPERI0",SEGCNT,CNT),HLI(SEGCNT,CNT))=HLNODE
25 . F S CNT=$O(HLNODE(CNT)) Q:'CNT D
26 .. S (^TMP($J,"VEPERI0",SEGCNT,CNT),HLI(SEGCNT,CNT))=HLNODE(CNT)
27 ;
28TEP ; Test Entry Point will remove later
29 ;
30 ; Get the user responsible for the interface
31 D GETUSER^VEPERI4(.DUZ,.FE,HLMTIEN)
32 ;
33 ; Determine which protocol to use
34 S SEGMT=$G(HLI(1,0))
35 I $E(SEGMT,1,3)'="MSH" D Q
36 . S FE=$$FATALERR^VEPERI6(1,"HL7","MSH Segment is not the first segment found",HLMTIEN)
37 S DEL(1)=$E(SEGMT,4)
38 S DELIM=$P(SEGMT,DEL(1),2)
39 F I=1:1:$L(DELIM) S DEL(I+1)=$E(DELIM,I)
40 ;
41 D INIT
42 I FE D CLEANUP Q
43 ;
44 S EVENT=$P(SEGMT,DEL(1),9) S:EVENT="" EVENT=" "
45 ; The event type determines protocol
46 I '$D(EVENTS(EVENT)) S FE=$$FATALERR^VEPERI6(1,"HL7","Unsupported Event = "_EVENT,HLMTIEN) Q
47 S PRTCL=EVENTS(EVENT)
48 S MSGEVNT=$P(EVENT,DEL(2),2)
49 S HLEID=$O(^ORD(101,"B",PRTCL,0))
50 ;
51 ; Initialize the HL7 variables
52 D INIT^HLFNC2(HLEID,.HL)
53 ;
54 ; Get the subscriber
55 S HLEIDS=$O(^ORD(101,HLEID,775,"B",0))
56 ;
57 D LOADTBL^VEPERI1A(SYS,.FE,.HLF)
58 I FE D CLEANUP Q
59 ;
60 D PARSE^VEPERI1(.HLI,.HLP,.HLF,.DEL,.FE,MSGEVNT,HLMTIEN)
61 I FE D CLEANUP Q
62 ;
63 D VALIDATE^VEPERI1(.HLP,.HLF,.FE,.DEL,HLMTIEN)
64 I FE D CLEANUP Q
65 ;
66 ; Find the patient if it wasn't already identified from the pending file
67 I '$G(DFN) D FINDPAT^VEPERI3(.HLP,.FE,.DFN,ADDPTFLG,HLMTIEN)
68 I FE D CLEANUP Q
69 ;
70 ; If DFN was not returned, then we have no business continuing.
71 I '$G(DFN) D CLEANUP Q
72 ;
73 ; Returns IEN array of insurances
74 D FILEINS^VEPERI2(.HLP,.HLF,DFN,.IEN,.FE,HLMTIEN)
75 I FE D CLEANUP Q
76 ;
77 D FILEPAT^VEPERI5(.HLP,.HLF,DFN,.IEN,.FE,HLMTIEN)
78 I FE D CLEANUP Q
79 ;
80CLEANUP ;
81 K ^TMP($J,"VEPERIO"),HL,HLNEXT,HLNODE,HLQUIT
82 Q
83 ;
84 ; Returns
85 ; SYS
86 ; EVENT ARRAY
87 ; ADDPTLFG
88INIT ;
89 N SCREEN,TAR,MSG
90 S SCREEN="I $P(^(0),U,2)=1"
91 D LIST^DIC(19904,,".01;.03",,,,,,SCREEN,,"TAR","MSG")
92 I $D(MSG) S FE=$$FATALERR^VEPERI6(1,"SETUP","NO ACTIVE SYSTEMS SET UP IN 19904") Q
93 I TAR("DILIST",0)>1 S FE=$$FATALERR^VEPERI6(1,"SETUP","TOO MANY ACTIVE SYSTEMS SET UP IN 19904") Q
94 S SYS=TAR("DILIST",1,1)
95 S ADDPTFLG=+TAR("DILIST","ID",1,.03)
96 S IEN=","_TAR("DILIST",2,1)_","
97 ;
98 D LIST^DIC(19904.01,IEN,".01;.02",,,,,,,,"TAR","MSG")
99 I $D(MSG) S FE=$$FATALERR^VEPERI6(1,"SETUP","PROBLEM RETRIEVING PROTOCOLS FROM 19904") Q
100 F I=1:1 Q:'$D(TAR("DILIST",1,I)) D
101 .S EVENT=TAR("DILIST","ID",I,".02")
102 .S EVENT=$TR(EVENT,"~","^")
103 .S EVENT(EVENT)=TAR("DILIST","ID",I,".01")
104 Q
105 ;
106 ; IENS is a string of internal entry numbers from file 772
107 ; and DFN is an existing patient. If DFN does not exist, it is a new
108 ; patient. We will need to pass that back to update the pending file
109 ; This is called from VEPERI7
110 ;
111PENDING(IENS772,DFN) ;
112 N HLQUIT,HLNODE,HLNEXT,HLMTIEN,IENSLOOP,ADDPTFLG,FE
113 S FE=0
114 I '$G(DFN) S ADDPTFLG=1 ; allow new patients to be added
115 F IENSLOOP=1:1 S HLMTIEN=$P(IENS772,",",IENSLOOP) Q:'+HLMTIEN!(FE) D
116 . S HLQUIT=0,HLNODE="",HLNEXT="D HLNEXT^HLCSUTL"
117 . D EN2
118 Q
Note: See TracBrowser for help on using the repository browser.