| 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
|
|---|
