MDUXMLU1 ; HOIFO/WAA -Utilities for XML text ; 7/26/00
;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
; Utilities for the XML Parser
;
FILTER(DATA) ;Filter out the bad chars.
Q:$G(DATA)'?.E1C.E DATA
N RESULTS
S RESULTS=""
F Q:'$L(DATA) S:$E(DATA)'?1C RESULTS=RESULTS_$E(DATA) S DATA=$E(DATA,2,$L(DATA))
Q RESULTS
VAL(DATA) ;Convert any special charcters to standard XML format
N DATA2,RESULT,CHAR,CHAR1,CHAR2,CNT,I
S RESULT="",CNT=0,I=0,DATA2=""
S DATA=$$FILTER(DATA)
F CHAR="&,amp","<,lt",">,gt","',apos",""",quot" D
. S CNT=$L(DATA,$P(CHAR,","))
. S CHAR1=$P(CHAR,","),CHAR2=$P(CHAR,",",2)
. S RESULT=""
. I CNT>1 F I=1:1:CNT D
. . S RESULT=RESULT_$P(DATA,CHAR1,I)
. . I CNT'=I S RESULT=RESULT_"&"_CHAR2_";"
. . Q
. I RESULT'="" S DATA=RESULT
. Q
I RESULT="" S RESULT=DATA
Q RESULT
;
CODING(TYPE,DATA) ; Coding of both CPT and ICD9
Q:TYPE=""
Q:DATA=""
N DATAC,I,DEFF
S DATAC=$L(DATA,"~")
S DEFF=$S(TYPE="CPT":"PROCEDURE",TYPE="ICD":"DIAGNOSIS",1:0)
Q:'DEFF
F I=1:1:DATAC D
. D BLDXML^MDUXMLU1(TYPE_"_CODE",$P($P(DATA,"~",I),"^",1))
. D BLDXML^MDUXMLU1(TYPE_"_"_DEFF,$P($P(DATA,"~",I),"^",2))
. D BLDXML^MDUXMLU1(TYPE_"_CODE_TYPE",$P($P(DATA,"~",I),"^",3))
. Q
Q
HEAD ;Creat the header of the XML message
D XML^MDUXMLU1("<?xml version="_QUOT_"1.0"_QUOT_" encoding="_QUOT_"UTF-8"_QUOT_" ?>")
D XML^MDUXMLU1("<HL7_MESSAGE xmlns:xsi="_QUOT_"http://www.w3.org/2001/XMLSchema-instance"_QUOT_" xsi:noNamespaceSchemaLocation="_QUOT_"CLOB.xsd"_QUOT_">")
Q
TAIL ; Complete the message
D XML^MDUXMLU1("</RESULTS>")
I ORDER=1 D XML^MDUXMLU1("</ORDER_INFORMATION>")
D XML^MDUXMLU1("</HL7_MESSAGE>")
Q
NAME(NAME) ; Convert name
I NAME="" Q
D BLDXML^MDUXMLU1("LAST_NAME",$P(NAME,"^",1))
D BLDXML^MDUXMLU1("FIRST_NAME",$P(NAME,"^",2))
D BLDXML^MDUXMLU1("MIDDLE_NAME",$P(NAME,"^",3))
Q
DATE(FIELD,DATE) ; Convert date and post as xml
I FIELD="" Q
I DATE="" Q
D XML^MDUXMLU1("<"_FIELD_">")
D BLDXML^MDUXMLU1("YEAR",$E(DATE,1,4))
D BLDXML^MDUXMLU1("MONTH",$E(DATE,5,6))
D BLDXML^MDUXMLU1("DAY",$E(DATE,7,8))
I $E(DATE,9,10)?2N D BLDXML^MDUXMLU1("HOUR",$E(DATE,9,10))
I $E(DATE,11,12)?2N D BLDXML^MDUXMLU1("MINUTE",$E(DATE,11,12))
I $E(DATE,13,14)?2N D BLDXML^MDUXMLU1("SECOND",$E(DATE,13,14))
D XML^MDUXMLU1("</"_FIELD_">")
Q
BLDXML(HEAD,DATA) ;
Q:HEAD=""
Q:DATA=""
D XML^MDUXMLU1("<"_HEAD_">"_DATA_"</"_HEAD_">")
Q
XML(XMLLINE) ; create the XML Line in the temp file to be passed
Q:XMLLINE=""
S XMLCNT=XMLCNT+1
S ^TMP($J,"MDHL7XML",XMLCNT)=XMLLINE
Q
FILE(MDIEN) ; File off the XML data into 703.1
N CNT,MDDZ,LINE,LN
S CNT=0,CCNT=0
S MDDZ=$$UPDATE^MDHL7U(MDIEN)
Q:'MDDZ
F S CNT=$O(^TMP($J,"MDHL7XML",CNT)) Q:CNT<1 D
. S LINE=$G(^TMP($J,"MDHL7XML",CNT)) Q:LINE=""
. S ^MDD(703.1,MDIEN,.4,CNT,0)=LINE,CCNT=CCNT+1
. Q
S ^MDD(703.1,MDIEN,.4,0)="^^"_CCNT_"^"_CCNT_"^"_DT_"^"
K ^TMP($J,"MDHL7XML")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDUXMLU1 2957 printed Apr 09, 2024@20:48:47 Page 2
MDUXMLU1 ; HOIFO/WAA -Utilities for XML text ; 7/26/00
+1 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
+2 ; Utilities for the XML Parser
+3 ;
FILTER(DATA) ;Filter out the bad chars.
+1 if $GET(DATA)'?.E1C.E
QUIT DATA
+2 NEW RESULTS
+3 SET RESULTS=""
+4 FOR
if '$LENGTH(DATA)
QUIT
if $EXTRACT(DATA)'?1C
SET RESULTS=RESULTS_$EXTRACT(DATA)
SET DATA=$EXTRACT(DATA,2,$LENGTH(DATA))
+5 QUIT RESULTS
VAL(DATA) ;Convert any special charcters to standard XML format
+1 NEW DATA2,RESULT,CHAR,CHAR1,CHAR2,CNT,I
+2 SET RESULT=""
SET CNT=0
SET I=0
SET DATA2=""
+3 SET DATA=$$FILTER(DATA)
+4 FOR CHAR="&,amp","<,lt",">,gt","',apos",""",quot"
Begin DoDot:1
+5 SET CNT=$LENGTH(DATA,$PIECE(CHAR,","))
+6 SET CHAR1=$PIECE(CHAR,",")
SET CHAR2=$PIECE(CHAR,",",2)
+7 SET RESULT=""
+8 IF CNT>1
FOR I=1:1:CNT
Begin DoDot:2
+9 SET RESULT=RESULT_$PIECE(DATA,CHAR1,I)
+10 IF CNT'=I
SET RESULT=RESULT_"&"_CHAR2_";"
+11 QUIT
End DoDot:2
+12 IF RESULT'=""
SET DATA=RESULT
+13 QUIT
End DoDot:1
+14 IF RESULT=""
SET RESULT=DATA
+15 QUIT RESULT
+16 ;
CODING(TYPE,DATA) ; Coding of both CPT and ICD9
+1 if TYPE=""
QUIT
+2 if DATA=""
QUIT
+3 NEW DATAC,I,DEFF
+4 SET DATAC=$LENGTH(DATA,"~")
+5 SET DEFF=$SELECT(TYPE="CPT":"PROCEDURE",TYPE="ICD":"DIAGNOSIS",1:0)
+6 if 'DEFF
QUIT
+7 FOR I=1:1:DATAC
Begin DoDot:1
+8 DO BLDXML^MDUXMLU1(TYPE_"_CODE",$PIECE($PIECE(DATA,"~",I),"^",1))
+9 DO BLDXML^MDUXMLU1(TYPE_"_"_DEFF,$PIECE($PIECE(DATA,"~",I),"^",2))
+10 DO BLDXML^MDUXMLU1(TYPE_"_CODE_TYPE",$PIECE($PIECE(DATA,"~",I),"^",3))
+11 QUIT
End DoDot:1
+12 QUIT
HEAD ;Creat the header of the XML message
+1 DO XML^MDUXMLU1("<?xml version="_QUOT_"1.0"_QUOT_" encoding="_QUOT_"UTF-8"_QUOT_" ?>")
+2 DO XML^MDUXMLU1("<HL7_MESSAGE xmlns:xsi="_QUOT_"http://www.w3.org/2001/XMLSchema-instance"_QUOT_" xsi:noNamespaceSchemaLocation="_QUOT_"CLOB.xsd"_QUOT_">")
+3 QUIT
TAIL ; Complete the message
+1 DO XML^MDUXMLU1("</RESULTS>")
+2 IF ORDER=1
DO XML^MDUXMLU1("</ORDER_INFORMATION>")
+3 DO XML^MDUXMLU1("</HL7_MESSAGE>")
+4 QUIT
NAME(NAME) ; Convert name
+1 IF NAME=""
QUIT
+2 DO BLDXML^MDUXMLU1("LAST_NAME",$PIECE(NAME,"^",1))
+3 DO BLDXML^MDUXMLU1("FIRST_NAME",$PIECE(NAME,"^",2))
+4 DO BLDXML^MDUXMLU1("MIDDLE_NAME",$PIECE(NAME,"^",3))
+5 QUIT
DATE(FIELD,DATE) ; Convert date and post as xml
+1 IF FIELD=""
QUIT
+2 IF DATE=""
QUIT
+3 DO XML^MDUXMLU1("<"_FIELD_">")
+4 DO BLDXML^MDUXMLU1("YEAR",$EXTRACT(DATE,1,4))
+5 DO BLDXML^MDUXMLU1("MONTH",$EXTRACT(DATE,5,6))
+6 DO BLDXML^MDUXMLU1("DAY",$EXTRACT(DATE,7,8))
+7 IF $EXTRACT(DATE,9,10)?2N
DO BLDXML^MDUXMLU1("HOUR",$EXTRACT(DATE,9,10))
+8 IF $EXTRACT(DATE,11,12)?2N
DO BLDXML^MDUXMLU1("MINUTE",$EXTRACT(DATE,11,12))
+9 IF $EXTRACT(DATE,13,14)?2N
DO BLDXML^MDUXMLU1("SECOND",$EXTRACT(DATE,13,14))
+10 DO XML^MDUXMLU1("</"_FIELD_">")
+11 QUIT
BLDXML(HEAD,DATA) ;
+1 if HEAD=""
QUIT
+2 if DATA=""
QUIT
+3 DO XML^MDUXMLU1("<"_HEAD_">"_DATA_"</"_HEAD_">")
+4 QUIT
XML(XMLLINE) ; create the XML Line in the temp file to be passed
+1 if XMLLINE=""
QUIT
+2 SET XMLCNT=XMLCNT+1
+3 SET ^TMP($JOB,"MDHL7XML",XMLCNT)=XMLLINE
+4 QUIT
FILE(MDIEN) ; File off the XML data into 703.1
+1 NEW CNT,MDDZ,LINE,LN
+2 SET CNT=0
SET CCNT=0
+3 SET MDDZ=$$UPDATE^MDHL7U(MDIEN)
+4 if 'MDDZ
QUIT
+5 FOR
SET CNT=$ORDER(^TMP($JOB,"MDHL7XML",CNT))
if CNT<1
QUIT
Begin DoDot:1
+6 SET LINE=$GET(^TMP($JOB,"MDHL7XML",CNT))
if LINE=""
QUIT
+7 SET ^MDD(703.1,MDIEN,.4,CNT,0)=LINE
SET CCNT=CCNT+1
+8 QUIT
End DoDot:1
+9 SET ^MDD(703.1,MDIEN,.4,0)="^^"_CCNT_"^"_CCNT_"^"_DT_"^"
+10 KILL ^TMP($JOB,"MDHL7XML")
+11 QUIT
