| 1 | MDUXMLM ; 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 |         ;
 | 
|---|
| 7 | MSH     ; 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
 | 
|---|
| 25 | PID     ; 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
 | 
|---|
| 38 | PV1     ; 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
 | 
|---|
| 42 | ORC     ; 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
 | 
|---|
| 49 | OBR     ; 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
 | 
|---|
| 79 | OBX     ; Parse the OBX
 | 
|---|
| 80 |         D OBX^MDUXMLOX
 | 
|---|
| 81 |         Q
 | 
|---|