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

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1MDHL7U2 ; HOIFO/WAA -Utilities for CP PROCESSING OBX text ; 7/26/00
2 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
3 ; Supported IA #2263 for XPAR parameter calls.
4 ; Supported IA #3006 for XMXAPIG calls.
5 ; Supported IA #10106 for HL7 calls.
6 ;
7GET123(MDD702) ; return the IEN for an entry in 123 based on the 702
8 ; This subroutine will return -1 if no entry is found
9 N CONSULT
10 S CONSULT=-1
11 I $G(^MDD(702,MDD702,0))'="" D ; Entry in 702 does exist
12 . S CONSULT=$$GET1^DIQ(702,MDD702,.05,"I") ; Grab pointer to consults
13 . I CONSULT'>0 S CONSULT=-1 Q ; Bad consult
14 . Q
15 Q CONSULT
16GETREF(CONSULT) ; Return the physician and pointer to 200
17 ; in the format pointer200^last^first
18 N NREF,REF,PHY
19 S PHY=-1
20 S REF=$$GET1^DIQ(123,CONSULT,10,"I") D
21 . Q:REF=""
22 . S NREF=$$GET1^DIQ(123,CONSULT,10,"E") Q:NREF=""
23 . S NREF=$$HLNAME^HLFNC(NREF,"^~\&")
24 . S PHY=REF_"^"_NREF
25 . Q
26 Q PHY
27 ;
28MG(MG) ; This function is to validate that a mailgroup
29 ; and that there is someone in it
30 ;
31 ; Input:
32 ; MG the Mailgroup IEN in the file
33 ;
34 ; Output:
35 ; 1 = Valid mail group with people in it
36 ; 0 = Invalid group with No people in it
37 ;
38 N X,MGU
39 S X=0 I '$G(MG) Q X
40 S MGU=$$GET1^DIQ(3.8,+MG_",",.01)
41 I MGU'="" D
42 . I $$GOTLOCAL^XMXAPIG(MGU) S X=1
43 . Q
44 Q X
45INST(DEV,X) ; Process Device and determine if the device Functioning
46 ; DEV = Name of the device from the .01 field
47 ; X = 1 is true that the device cleared to process
48 ; 0 is false the device is not allowed to process
49 ; X(0) = The device name^IEN^Print name if one^
50 ; Processing routine^Routine Checksum^Patch Level
51 ; X(I) = The reasons why it is OR is not allowed to process
52 N LINE,I,J,Y
53 S I=0
54 S X=0
55 I DEV'?1N.N S DEV=$O(^MDS(702.09,"B",DEV,0)) I DEV<1 S DEV=0
56 S LINE=$G(^MDS(702.09,DEV,0))
57 S X(I)=$S($P(LINE,U)'="":$P(LINE,U),1:"UNKNOWN")_U_DEV_U_$S($P(LINE,U)'="":$P(LINE,U,6),1:"Device Unknown")
58 I LINE="" S I=I+1,X(I)="No Device Found." Q
59 I $P(LINE,U,6)="" S I=I+1,X(I)="No Print Name Defined."
60 I $P(LINE,U,9)="" S I=I+1,X(I)="Active switch is not set for this device."
61 I $P(LINE,U,9)'=1 S I=I+1,X(I)="Device is set to Inactive."
62 I $P(LINE,U,2)="" S I=I+1,X(I)="No Mail Group Defined in the instrument file."
63 E D
64 . Q:$$MG^MDHL7U2($P(LINE,U,2))
65 . N MGU
66 . I $$FIND1^DIC(3.8,"","BX","MD DEVICE ERRORS")'=+$P(LINE,U,2) S I=I+1,X(I)="No Mail Group Defined in VISTA." Q
67 . S MGU=$$GET1^DIQ(3.8,+$P(LINE,U,2)_",",.01)
68 . I '$$GOTLOCAL^XMXAPIG(MGU) S I=I+1,X(I)="No User are defined in the "_MGU_" Mail Group."
69 . Q
70 S LINE=$G(^MDS(702.09,DEV,.1))
71 I $P(LINE,U,1)="" S I=I+1,X(I)="No Processing routine indicated."
72 E D
73 . N ROU,ROUTINE
74 . S ROUTINE=$P(LINE,U,1)
75 . S ROU=$$VALRTN^MDHL7U2($P(LINE,U,1))
76 . I 'ROU S I=I+1,X(I)="Processing routine does not exist."
77 . E D ; Plug in the needed information about the routine
78 . . N LINE,SCND,HOLD
79 . . S LINE=X(0)
80 . . S $P(LINE,U,4)=ROU ; processing routine
81 . . S X(0)=LINE
82 . . I $E(ROUTINE,1,2)="MD" Q
83 . . I $E(ROUTINE,1,2)="MC" Q
84 . . S X(10)=" ***WARNING***"
85 . . S X(11)=" This will not stop the processing of instrument."
86 . . S X(12)=" Processing routine "_ROUTINE_" is not in CP Namespace."
87 . . S X(13)=" "
88 . . S X(14)=" ***WARNING***"
89 . . Q
90 . Q
91 I $P(LINE,U,2)="" S I=I+1,X(I)="No Package Code."
92 I $P(LINE,U,2)'="M" D
93 . N J,VLD
94 . S VLD=0
95 . I $P(LINE,U,3) D
96 . . I $P(LINE,U,6)="" S I=I+1,X(I)="No HL7 Instrument ID."
97 . . I '$P(LINE,U,8) S I=I+1,X(I)="No HL7 Link."
98 . . Q
99 . S LINE=$G(^MDS(702.09,DEV,.3))
100 . F J=1:1:7 S VLD=$P(LINE,U,J) I VLD Q
101 . I 'VLD S I=I+1,X(I)="No Valid Attachment Types indicated."
102 . Q
103 I $$GET^XPAR("SYS","MD IMAGING XFER")="" S I=I+1,X(I)="No Imaging Share indicated in the Systems Parameters"
104 I I=0 S X="1",X(1)="Cleared to Process HL7 Messages"
105 Q
106VALRTN(RTN) ; Function to check Validity
107 N X
108 S X=RTN X ^%ZOSF("TEST") S X=$T
109 Q X
110TEXT ;;PROCESS TEXT;.302
111 N CNT,LN,DEL
112 S SEP=$G(SEP,"^")
113 S CNT=0,LN=0,DEL=0
114 S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
115 Q:'MDDZ
116 S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
117 S ^MDD(703.1,MDIEN,.1,MDDZ,.2,0)="^^"_LN_"^"_LN_"^"_DT_"^"
118 F S CNT=$O(^TMP($J,"MDHL7","TEXT",CNT)) Q:CNT<1 D
119 . N LINE
120 . S LINE=$G(^TMP($J,"MDHL7","TEXT",CNT)) Q:LINE=""
121 . I $P(LINE,"|",1)'="OBX" Q
122 . I $S($P(LINE,"|",3)="TX":0,$P(LINE,"|",3)="FT":0,1:1) Q
123 . I $E($P(LINE,"|",6),1,2)="\\" Q
124 . I $E($P(LINE,"|",6),1,2)="//" Q
125 . ; ^-- Quit if the line is not a text line or a freetext line.
126 . S TEXT=$P(LINE,"|",6) Q:TEXT=""
127 . I $D(^TMP($J,"MDHL7","TEXT",CNT))=11 D Q
128 . . ; Process the first line then go move on the the sub line
129 . . D PROCESS(.TEXT)
130 . . N CNT2
131 . . S CNT2=0
132 . . F S CNT2=$O(^TMP($J,"MDHL7","TEXT",CNT,CNT2)) Q:CNT2<1 D
133 . . . N MSG1
134 . . . S MSG1=^TMP($J,"MDHL7","TEXT",CNT,CNT2)
135 . . . ; get the next message continution
136 . . . S TEXT=TEXT_$P(MSG1,SEP)
137 . . . D SAVE(TEXT)
138 . . . S TEXT=$P(MSG1,SEP,2,($L(MSG1,SEP)))
139 . . . D PROCESS(.TEXT)
140 . . . Q
141 . . I TEXT'="" S:TEXT["|" TEXT=$P(TEXT,"|") D SAVE(TEXT)
142 . . Q
143 . E D SAVE(TEXT)
144 . Q
145 S ^MDD(703.1,MDIEN,.1,MDDZ,.2,0)="^^"_LN_"^"_LN_"^"_DT_"^"
146 Q
147SAVE(TEXT) ; Save the data to the file 703.1
148 S LN=LN+1
149 S TEXT=$P(TEXT,SEP)
150 S ^MDD(703.1,MDIEN,.1,MDDZ,.2,LN,0)=TEXT
151 Q
152PROCESS(TEXT) ; Long lines
153 N I,LN2,DEL
154 S DEL=$L(TEXT,SEP)
155 I DEL'>1 D Q
156 . D SAVE(TEXT)
157 . S TEXT=""
158 F I=1:1:(DEL-1) D
159 . S LN2=$P(TEXT,SEP,I)
160 . D SAVE(LN2)
161 . ; Process the text and save the data up to the last del piece
162 . Q
163 ; This is to reset TEXT
164 S TEXT=$P(TEXT,SEP,DEL)
165 Q
166FTOHL7(DATE) ; This subroutine will make a file manager date an HL7 date
167 N HLDATE,YYYY,MM,DD,HMS
168 S HLDATE=($E(DATE,1,3)+1700)_$E(DATE,4,7)_$P(DATE,".",2)
169 I $L(HLDATE)<14 S HLDATE=HLDATE_"00000000000000",HLDATE=$E(HLDATE,1,14)
170 Q HLDATE
Note: See TracBrowser for help on using the repository browser.