source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDUXMLM.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1MDUXMLM ; HOIFO/WAA -Utilities for XML text ; 7/26/00
2 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
3 ; This routine will loop throught the HL7 Message as sent
4 ; by the vendor and convert that message into XML for
5 ; Processing by the gateway.
6 ;
7MSH ; Parse the MSH
8 N MSGDATE
9 D XML^MDUXMLU1("<MESSAGE_HEADER>")
10 D BLDXML^MDUXMLU1("INTERNAL_APPLICATION","CLOB")
11 S DEVICE=$P(LINE,DL,4)
12 D BLDXML^MDUXMLU1("INSTRUMENT_INSTANCE_ID",DEVICE)
13 S MSGDATE=$P(LINE,DL,7) I MSGDATE="" D
14 . D NOW^%DTC
15 . S MSGDATE=%
16 . S MSGDATE=$$FTOHL7^MDHL7U2(MSGDATE)
17 . Q
18 D DATE^MDUXMLU1("TRANSMISSION_DATE_TIME",MSGDATE)
19 D BLDXML^MDUXMLU1("MESSAGE_CONTROL_ID",$P(LINE,DL,10))
20 D BLDXML^MDUXMLU1("MESSAGE_TYPE",$P(LINE,DL,9))
21 D BLDXML^MDUXMLU1("PRODUCTION_MODE",$S($P(LINE,DL,11)="P":"Y",1:"N"))
22 D BLDXML^MDUXMLU1("HL7_VERSION",$P(LINE,DL,12))
23 D XML^MDUXMLU1("</MESSAGE_HEADER>")
24 Q
25PID ; Parse the PID
26 N SSN
27 D XML^MDUXMLU1("<PATIENT_INFORMATION>")
28 D BLDXML^MDUXMLU1("PATIENT_ID",$P(LINE,DL,4))
29 D XML^MDUXMLU1("<PATIENT_NAME>")
30 D NAME^MDUXMLU1($P(LINE,DL,6))
31 D XML^MDUXMLU1("</PATIENT_NAME>")
32 D DATE^MDUXMLU1("DATE_OF_BIRTH",$P(LINE,DL,8))
33 D BLDXML^MDUXMLU1("SEX",$P(LINE,DL,9))
34 S SSN=$P(LINE,DL,20) I SSN="" S SSN=$P(LINE,DL,4)
35 D BLDXML^MDUXMLU1("SSN",$P(LINE,DL,20))
36 D XML^MDUXMLU1("</PATIENT_INFORMATION>")
37 Q
38PV1 ; Parse the PV1
39 D BLDXML^MDUXMLU1("PATIENT_CLASS",$P(LINE,DL,3))
40 D BLDXML^MDUXMLU1("PATIENT_LOCATION",$P(LINE,DL,4))
41 Q
42ORC ; Parse the ORC
43 S ORDER=1
44 D XML^MDUXMLU1("<ORDER_INFORMATION>")
45 D BLDXML^MDUXMLU1("ORDER_CONTROL",$P(LINE,DL,2))
46 D BLDXML^MDUXMLU1("PLACER_ORDER_NUMBER",$P(LINE,DL,3))
47 D DATE^MDUXMLU1("TRANSACTION_DATE_TIME",$P(LINE,DL,10))
48 Q
49OBR ; Parse the OBR
50 D XML^MDUXMLU1("<RESULTS>")
51 D BLDXML^MDUXMLU1("FILLER_ORDER_NUMBER",$P(LINE,DL,4))
52 D BLDXML^MDUXMLU1("PROCEDURE_INSTANCE_ID",$P(LINE,DL,4))
53 I $P(LINE,DL,5)'="" D ; Get the procedure type if there is one.
54 . N LINX
55 . S LINX=$P($P(LINE,DL,5),"^")
56 . I LINX="" S LINX=$P($P(LINE,DL,5),"^",2)
57 . D BLDXML^MDUXMLU1("PROCEDURE_TYPE",LINX)
58 . Q
59 D DATE^MDUXMLU1("DATE_OBSERVED",$P(LINE,DL,8))
60 I $P(LINE,DL,14)'="" D ; Pick up ICD9 code
61 . D XML^MDUXMLU1("<RELEVENT_CLINICAL>")
62 . D CODING^MDUXMLU1("ICD",$P(LINE,DL,14))
63 . D XML^MDUXMLU1("</RELEVENT_CLINICAL>")
64 . Q
65 I $P(LINE,DL,17)'="" D
66 . D XML^MDUXMLU1("<ORDERING_PROVIDER>")
67 . D NAME^MDUXMLU1($P(LINE,DL,17))
68 . D XML^MDUXMLU1("</ORDERING_PROVIDER>")
69 . Q
70 D BLDXML^MDUXMLU1("STATUS",$P(LINE,DL,26))
71 D BLDXML^MDUXMLU1("QUALITY_TIMING",$P(LINE,DL,28))
72 I $P(LINE,DL,37)'="" D DATE^MDUXMLU1("DATE_SCHEDULED",$P(LINE,DL,37))
73 I $P(LINE,DL,45)'="" D ; Pick up CPT code
74 . D XML^MDUXMLU1("<PROCEDURE_CODE>")
75 . D CODING^MDUXMLU1("CPT",$P(LINE,DL,45))
76 . D XML^MDUXMLU1("</PROCEDURE_CODE>")
77 . Q
78 Q
79OBX ; Parse the OBX
80 D OBX^MDUXMLOX
81 Q
Note: See TracBrowser for help on using the repository browser.