source: WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDHL7A.m@ 1150

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

revised back to 6/30/08 version

File size: 6.4 KB
Line 
1MDHL7A ; HOIFO/WAA - Routine to Decode HL7 for CP ; [05-07-2001 10:38]
2 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
3 ; Reference DBIA #10035 [Supported] for DPT calls.
4 ; Reference DBIA #10106 [Supported] for HLFNC calls.
5 ; Reference DBIA #10062 [Supported] for VADPT6 calls.
6 ; Reference DBIA #2701 [Supported] for MPIF001 Calls
7EN ; [Procedure] Entry Point for Message Array in MSG
8 N %,BID,CODE,CPT,DA,DATE,DFN,DIK,DLCO,DTO,DZ,ERRTX,EXAM,EXE,MDFLAG,FIL
9 N I,ICNT,ID,IMP,J,K,LBL,LINO,LINE,LN,MDAPP,MDRTN,MG,MSG,N,NAM,NEXT,NUM
10 N ORIFN,P,PID,PIEN,S,SEG,SET,SEP,MDSSN,STR,STYP,SUB,TCNT,TXT,UNIQ,SEC
11 N UNITS,VA,VAL,X,XMBODY,XMDUZ,XMSUBJ,XMTO,Z,ZZ,Z1,Z2,MDERROR
12 N ECODE,MDIEN,MDOBX,NUMZ,PNAM,ZCODE,MDDEV,MDD702,DEVNAME,DEVIEN,MDQFLG
13 N MDIORD
14 K ^TMP($J,"MDHL7A"),^TMP($J,"MDHL7")
15 S MDFLAG=0,MDERROR=0,MDQFLG=0
16 F I=1:1 X HLNEXT Q:MDQFLG S ^TMP($J,"MDHL7A",I)=$TR(HLNODE,$C(10),""),J=0 S:HLQUIT<1 MDQFLG=1 F S J=$O(HLNODE(J)) Q:J<1 S ^TMP($J,"MDHL7A",I,J)=$TR(HLNODE(J),$C(10),"")
17 K HLNODE
18 ;
19EN2 ; [Procedure] No Description
20 S (DEVIEN,DEVNAME)=""
21 F I=1:1 S X=$G(^TMP($J,"MDHL7A",I)) Q:X="" Q:$E(X,1,3)="OBX" D
22 . S:$E(X,1,3)="MSH" DEVNAME=$P(X,"|",4)
23 . I $E(X,1,3)="MSH",DEVNAME'="Instrument Manager" S DEVIEN=$O(^MDS(702.09,"B",DEVNAME,0))
24 . I $E(X,1,3)="OBR" D
25 .. I DEVNAME="Instrument Manager" D
26 ... S DEVNAME=$P(X,"|",25)
27 ... Q
28 .. S MDIORD=$P(X,"|",4)
29 .. S MDD702=$S(+MDIORD<1:"",1:$$GETSTDY^MDRPCOT1(MDIORD))
30 .. I MDD702<1 S MDD702="" Q
31 .. I MDD702>0 D ;Validate the entry from 702 is good.
32 ... I $G(^MDD(702,MDD702,0))="" S MDD702="" Q
33 ... S DEVIEN=$$GET1^DIQ(702,MDD702,.11,"I")
34 ... I DEVIEN<1 S DEVIEN="" ; No device defined
35 ... Q
36 .. Q
37 . Q
38 I DEVIEN="",DEVNAME'="" S DEVIEN=$O(^MDS(702.09,"B",DEVNAME,0))
39 I DEVNAME="" S ERRTX="Invalid device Code" D ^MDHL7X Q
40 I DEVIEN="" S ERRTX="Invalid device entry" D ^MDHL7X Q
41 S ZCODE=$P($G(^MDS(702.09,DEVIEN,.1)),"^",2)
42 S ECODE=0,INST=DEVIEN,MDAPP=DEVNAME
43 I 'INST S ERRTX="Invalid Application Code" D ^MDHL7X Q
44 D INST^MDHL7U2(DEVIEN,.ECODE) I 'ECODE D Q
45 . S ERRTX="Device Error" D ^MDHL7X
46 . Q
47 I (ZCODE="M")!(ZCODE="B") D Q:MDERROR Q:ZCODE="M" ;
48 . S MDFLAG=1,MDERROR=0 ; Tell Medicine that CP is talking to HL7
49 . ;S MSG(1)=^TMP($J,"MDHL7A",1)
50 . ;S MSG(2)=^TMP($J,"MDHL7A",2)
51 . D ^MDHL7MCA ; Run the Medicine routines
52 . Q:MDERROR ; Medicine found an error and sent an error back
53 . ;;I ZCODE="M" D GENACK^MDHL7X
54 . Q
55 S NUMZ=$O(^TMP($J,"MDHL7A",""),-1)
56 S NUM=0,MDOBX=0
57 F NUM=1:1:NUMZ D Q:$G(ERRTX)'=""
58 . S LINO=^TMP($J,"MDHL7A",NUM)
59 . S SEC=$P(LINO,"|")
60 . I SEC="MSH" D MSH Q
61 . I SEC="PID" D PID Q
62 . I SEC="OBR" D OBR Q
63 . I SEC="PV1" Q
64 . I SEC="ORC" Q
65 . I SEC="OBX" S MDOBX=1 Q
66 . Q
67 Q:$G(ERRTX)'=""
68 I 'MDOBX S ERRTX="OBX not found when expected" D ^MDHL7X Q
69 D OBX
70 D STATUS(MDIEN,"P")
71 K ^TMP($J,"MDHL7A"),^TMP($J,"MDHL7")
72 Q
73STATUS(DA,STAT) ; Update the status of the report in 703.1
74 Q:$G(ERRTX)'=""
75 S $P(^MDD(703.1,DA,0),U,9)=STAT
76 S DIK="^MDD(703.1," D IX1^DIK
77 Q
78IM ;Instrument Manager Interface
79 Q:DEVNAME'="Instrument Manager"
80 I $E(X,1,3)'="OBR" Q
81 S DEVNAME=$P(X,"|",25)
82 S DEVIEN=$O(^MDS(702.09,"B",DEVNAME,0))
83 Q
84 ;
85MSH ; [Procedure] Decode MSH
86 N SEG
87 I '$D(^TMP($J,"MDHL7A",NUM)) Q
88 S X=$G(^TMP($J,"MDHL7A",NUM)),SEG("MSH")=X
89 I $E(X,1,3)'="MSH" S ERRTX="MSH not first record" D ^MDHL7X Q
90 Q
91 ;
92OBR ; [Procedure] Check OBR
93 N MDGMRC
94 S X=$G(^TMP($J,"MDHL7A",NUM)) I $E(X,1,3)'="OBR" S ERRTX="OBR not found when expected" D ^MDHL7X Q
95 S SEG("OBR")=X
96 S MDIORD=$P(X,"|",4)
97 S MDD702=$S(+MDIORD<1:"",1:$$GETSTDY^MDRPCOT1(MDIORD))
98 S ORIFN=$P(X,"|",3),(EXAM,%)=$P(X,"|",5) I EXAM'="" S EXAM=$P(%,"^",2) I EXAM="" S EXAM=$P(%,"^",1)
99 S CPT=$P(X,"|",5) I $P(CPT,"^",3)["CPT" S CPT=$P(CPT,"^",1)
100 S DTO="",DATE=$P(X,"|",8) I DATE'="" S:$L(DATE)>14 DATE=$E(DATE,1,14) S DTO=$$FMDATE^HLFNC(DATE)
101 ; vvv== Added to address the issues of mismatch
102 I $G(MDD702)>0 I DFN'=$$GET1^DIQ(702,MDD702,.01,"I") S ERRTX="Patient name Mismatch. Name in PID doesn't match the name in the CP Order #"_MDD702_"." D ^MDHL7X Q
103 I DTO="" S ERRTX="Missing required Date/Time of Procedure in OBR" D ^MDHL7X Q
104 ;;S UNIQ=$TR($H,",","-")
105 S UNIQ=$$NEWID(DFN,DATE,INST,$G(MDD702),HLMTIEN)
106 I +UNIQ="-1" S ERRTX="Unable to Create or Lock 703.1" D ^MDHL7X Q
107 S MDIEN=$P(UNIQ,"^",1) ; Got the IEN for 703.1
108 N SET S SET=DTO_"^"_$P(UNIQ,U,2),ICNT=0 N IMP
109 S MDRTN=$P($G(^MDS(702.09,INST,.1)),"^",1) S:MDRTN'["^" MDRTN="^"_MDRTN
110 S X=MDRTN S:X["^" X=$P(X,"^",2) X ^%ZOSF("TEST") I '$T S ERRTX="Processing routine not found" D ^MDHL7X Q ; IA %10096
111 Q
112 ;
113PID ; [Procedure] Check PID
114 S X=$G(^TMP($J,"MDHL7A",NUM)) I $E(X,1,3)'="PID" S ERRTX="PID not second record" D ^MDHL7X Q
115 S SEG("PID")=X
116 I $L($P(X,"|",4))'<16 D I +DFN=-1 Q
117 . N ICN
118 . S ICN=$P(X,"|",4)
119 . S DFN=$$GETDFN^MPIF001(ICN)
120 . I +DFN=-1 S ERRTX=$P(DFN,U,2)
121 . D MDSSN I DFN<1 S ERRTX="SSN not found" D ^MDHL7X Q
122 . I DFN>0 K ERRTX
123 . S MDSSN=$$GET1^DIQ(2,DFN,.09,"I") I MDSSN="" S MDSSN=" ",DFN=0
124 . Q
125 E D MDSSN
126 I 'DFN S ERRTX="SSN not found" D ^MDHL7X Q
127 S Z1=$P($G(^DPT(DFN,0)),",",1),Z2=$P(NAM,"^",1)
128 S Z1=$TR(Z1,"abcdefghijklmnopqrstuvwxyz- '","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
129 S Z2=$TR(Z2,"abcdefghijklmnopqrstuvwxyz- '","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
130 I $E(Z1,1,3)'=$E(Z2,1,3) S ERRTX="Last Name MisMatch" D ^MDHL7X Q
131 S PNAM=$TR(NAM,"^",",")
132 D PID^VADPT6 S PID=$G(VA("PID")),BID=$G(VA("BID")) N VA
133 Q
134MDSSN ; This subroutine is to match up the SSN for a patient.
135 S NAM=$P(X,"|",6),MDSSN=$P(X,"|",20) I $L(MDSSN)<9 S MDSSN=$P(X,"|",4)
136 S MDSSN=$P(MDSSN,"^",1) I MDSSN'?9N S MDSSN=$TR(MDSSN,"- ","")
137 I $E(MDSSN,$L(MDSSN))="P" S MDSSN=$E(MDSSN,1,9)
138 S:MDSSN'?9N MDSSN=" " S DFN=$O(^DPT("SSN",MDSSN,0))
139 I 'DFN S DFN=$O(^DPT("SSN",MDSSN_"P",0))
140 Q
141 ;
142OBX ; [Observation]
143 ;Q:$P(^TMP($J,"MDHL7A",NUM),"|")'="OBX"
144 D @MDRTN
145 Q
146NEWID(DFN,DATE,INST,MDD702,HLMTIEN) ; Generate a new entry and ID of 703.1
147 N NEWID,MDFDA,MDIEN
148 S NEWID=$TR($H,",","-") ; Create inital ID
149 L +(^MDD(703.1,"B")):60 E Q "-1"
150 ;^^--- Unable to get an lock in the file
151 F Q:'$D(^MDD(703.1,"B",NEWID)) H 1 S NEWID=$TR($H,",","-")
152 ;^^--- Search to create an new ID in current ID is in use
153 S MDFDA(703.1,"+1,",.01)=NEWID
154 S MDFDA(703.1,"+1,",.02)=DFN
155 S MDFDA(703.1,"+1,",.03)=$$HL7TFM^MDHL7U(DATE)
156 S MDFDA(703.1,"+1,",.04)=INST
157 S MDFDA(703.1,"+1,",.05)=MDD702
158 S MDFDA(703.1,"+1,",.06)=HLMTIEN
159 D UPDATE^DIE("","MDFDA","MDIEN")
160 L -(^MDD(703.1,"B"))
161 I $G(MDIEN(1))>0 S ^MDD(703.1,MDIEN(1),.1,0)="^703.11S^0^0" Q MDIEN(1)_U_NEWID
162 ; ^^--- Create Subfile and quit
163 Q "-1" ; Unable to create file
164 ;
165PROC ; [Procedure] Create report entry in file (703.1)
166 D PROC^MDHL7U
167 Q
Note: See TracBrowser for help on using the repository browser.