MDUXML ; HOIFO/WAA -Utilities for XML text ; 7/26/00
;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
; This routine will loop throught the HL7 Message as sent
; by the vendor and convert that message into XML for
; Processing by the gateway.
;
EN1 ;
N NUM,LBL,XMLCNT,XMLLINE,DL,DEVICE,Q,ORDER
K ^TMP($J,"MDHL7XML")
S DL="|",QUOT=""""
S (XMLCNT,ORDER,NUM)=0
D HEAD^MDUXMLU1
F S NUM=$O(^TMP($J,"MDHL7A",NUM)) Q:NUM<1 D
. N LINE,LBL
. S LINE=$G(^TMP($J,"MDHL7A",NUM)) Q:LINE=""
. I $P(LINE,DL,1)="OBX" D
. . I LINE["//" S LINE=$TR(LINE,"/","\")
. . I LINE["\E\" D
. . . N Y,Z,I S Z="" F I=1:1:$L(LINE) S Y=$E(LINE,I) D:Y="\" S Z=Z_Y
. . . . I $E(LINE,I+1)="E",$E(LINE,I+2)="\" S I=I+2
. . . . Q
. . . S LINE=Z
. . . Q
. . I $P(LINE,DL,6)["\\" D
. . . N I
. . . S I=$O(^TMP($J,"MDHL7A",NUM),-1)
. . . S ^TMP($J,"MDHL7A",(NUM+1))="OBX||ST|PROCEDURE STATUS||DONE"
. . . Q
. . Q
. S LINE=$$VAL^MDUXMLU1(LINE)
. S LBL=$P(LINE,DL,1)
. Q:'($S(LBL="MSH":1,LBL="PID":1,LBL="PV1":1,LBL="ORC":1,LBL="OBR":1,LBL="OBX":1,1:0))
. S LBL=LBL_"^MDUXMLM"
. D @LBL
. Q
D TAIL^MDUXMLU1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDUXML 1148 printed Sep 23, 2025@19:20:25 Page 2
MDUXML ; HOIFO/WAA -Utilities for XML text ; 7/26/00
+1 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
+2 ; This routine will loop throught the HL7 Message as sent
+3 ; by the vendor and convert that message into XML for
+4 ; Processing by the gateway.
+5 ;
EN1 ;
+1 NEW NUM,LBL,XMLCNT,XMLLINE,DL,DEVICE,Q,ORDER
+2 KILL ^TMP($JOB,"MDHL7XML")
+3 SET DL="|"
SET QUOT=""""
+4 SET (XMLCNT,ORDER,NUM)=0
+5 DO HEAD^MDUXMLU1
+6 FOR
SET NUM=$ORDER(^TMP($JOB,"MDHL7A",NUM))
if NUM<1
QUIT
Begin DoDot:1
+7 NEW LINE,LBL
+8 SET LINE=$GET(^TMP($JOB,"MDHL7A",NUM))
if LINE=""
QUIT
+9 IF $PIECE(LINE,DL,1)="OBX"
Begin DoDot:2
+10 IF LINE["//"
SET LINE=$TRANSLATE(LINE,"/","\")
+11 IF LINE["\E\"
Begin DoDot:3
+12 NEW Y,Z,I
SET Z=""
FOR I=1:1:$LENGTH(LINE)
SET Y=$EXTRACT(LINE,I)
if Y="\"
Begin DoDot:4
+13 IF $EXTRACT(LINE,I+1)="E"
IF $EXTRACT(LINE,I+2)="\"
SET I=I+2
+14 QUIT
End DoDot:4
SET Z=Z_Y
+15 SET LINE=Z
+16 QUIT
End DoDot:3
+17 IF $PIECE(LINE,DL,6)["\\"
Begin DoDot:3
+18 NEW I
+19 SET I=$ORDER(^TMP($JOB,"MDHL7A",NUM),-1)
+20 SET ^TMP($JOB,"MDHL7A",(NUM+1))="OBX||ST|PROCEDURE STATUS||DONE"
+21 QUIT
End DoDot:3
+22 QUIT
End DoDot:2
+23 SET LINE=$$VAL^MDUXMLU1(LINE)
+24 SET LBL=$PIECE(LINE,DL,1)
+25 if '($SELECT(LBL="MSH"
QUIT
+26 SET LBL=LBL_"^MDUXMLM"
+27 DO @LBL
+28 QUIT
End DoDot:1
+29 DO TAIL^MDUXMLU1
+30 QUIT
