MDUXML.m

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 ---MDUXML   1148     printed  Apr 09, 2024@20:48:13                                                                                                                                                                                                      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