Routine: DGPFHLU

DGPFHLU ;ALB/RPM - PRF HL7 ORU/ACK PROCESSING ; 6/21/06 10:27am

 ;;5.3;Registration;**425,718,650,1015**;Aug 13, 1993;Build 21

BLDORU(DGPFA,DGHARR,DGHL,DGROOT) ;Build ORU~R01 Message/Segments

 ;  Input:

 ;      DGPFA - (required) Assignment data array

 ;     DGHARR - (required) Assignment history IENs array

 ;       DGHL - (required) HL7 Kernel array passed by reference

 ;     DGROOT - (required) Closed root segment storage array name

 ;  Output:

 ;   Function Value - IEN of last assignment history included in

 ;                    message segments, 0 on failure

 ;           DGROOT - array of HL7 segments

 N DGADT     ;assignment date

 N DGHIEN    ;function value

 N DGLDT     ;last assignment date

 N DGPFAH    ;assignment history data array

 N DGSEG     ;segment counter

 N DGSEGSTR  ;formatted segment string

 N DGSET     ;set id

 N DGSTR     ;field string

 N DGTROOT   ;text root

 S DGHIEN=0

 S DGSEG=0

 I $D(DGPFA),$D(DGHARR),$G(DGROOT)]"" D

. ;

 . ;build PID

 . S DGSTR="1,2,3,5,7,8,19"

 . S DGSEGSTR=$$EN^VAFHLPID(+DGPFA("DFN"),DGSTR,1,1)

 . Q:(DGSEGSTR="")

 . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR

. ;

 . ;build OBR

 . S DGLDT=+$O(DGHARR(""),-1)  ;get last assignment date

 . Q:'$$GETHIST^DGPFAAH(DGHARR(DGLDT),.DGPFAH)  ;load asgn hx array

 . S DGSET=1

 . S DGSTR="1,4,7,20,21"

 . S DGSEGSTR=$$OBR^DGPFHLU1(DGSET,.DGPFA,.DGPFAH,DGSTR,.DGHL)

 . Q:(DGSEGSTR="")

 . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR

. ;

 . ;start OBX segments

 . S DGSET=0

. ;

 . ;build narrative OBX segments

 . S DGTROOT="DGPFA(""NARR"")"

 . Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"N",.DGPFAH,.DGHL,.DGSEG,.DGSET)

. ;

 . ;for each history build status & comment OBX segments

 . S DGADT=0

 . F  S DGADT=$O(DGHARR(DGADT)) Q:'DGADT  D  Q:'DGHIEN

 . . N DGPFAH

 . . S DGHIEN=0

 . . Q:'$$GETHIST^DGPFAAH(DGHARR(DGADT),.DGPFAH)

 . . ;

 . . ;build status OBX segment

 . . S DGSTR="1,2,3,5,11,14"

 . . S DGSET=DGSET+1

 . . S DGSEGSTR=$$OBX^DGPFHLU2(DGSET,"S","",$P($G(DGPFAH("ACTION")),U,2),.DGPFAH,DGSTR,.DGHL)

 . . Q:(DGSEGSTR="")

 . . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR

 . . ;

 . . ;build review comment OBX segments

 . . S DGTROOT="DGPFAH(""COMMENT"")"

 . . Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"C",.DGPFAH,.DGHL,.DGSEG,.DGSET)

 . . ;

 . . ;success

 . . S DGHIEN=DGHARR(DGADT)

 Q DGHIEN

PARSORU(DGWRK,DGHL,DGROOT,DGPFERR) ;Parse ORU~R01 Message/Segments

 ;  Input:

 ;     DGWRK - Closed root work global reference

 ;      DGHL - HL7 environment array

 ;    DGROOT - Closed root ORU results array name

 ;  Output:

 ;    DGROOT - ORU results array

 ;     Subscript                Field name            Fld# File#

 ;     -----------------------  --------------------  ---- -----

 ;     "SNDFAC"                 N/A                   N/A  N/A

 ;     "DFN"                    PATIENT NAME          .01  26.13

 ;     "FLAG"                   FLAG NAME             .02  26.13

 ;     "OWNER"                  OWNER SITE            .04  26.13

 ;     "ORIGSITE"               ORIGINATING SITE      .05  26.13

 ;     "NARR",line              ASSIGNMENT NARRATIVE   1   26.13

 ;     assigndt,"ACTION"        ACTION                .03  26.13

 ;     assigndt,"COMMENT",line  HISTORY COMMENTS       1   26.14

 ;   DGPFERR - Undefined on success, ERR segment data array on failure

 ;             Format:  DGPFERR(seg_id,sequence,fld_pos)=error_code

 N DGFS      ;field separator

 N DGCS      ;component separator

 N DGRS      ;repetition separator

 N DGCURLIN  ;current segment line

 N DGSEG     ;segment field data array

 N DGERR     ;error processing array

 S DGFS=DGHL("FS")

 S DGCS=$E(DGHL("ECH"),1)

 S DGRS=$E(DGHL("ECH"),2)

 S DGCURLIN=0

 ;loop through message segments and retrieve field data

 F  D  Q:'DGCURLIN

 . N DGSEG

 . S DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)

 . Q:'DGCURLIN

 . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGROOT,.DGPFERR)")

MSH(DGSEG,DGCS,DGRS,DGORU,DGERR) ;

 ;  Input:

 ;    DGSEG - MSH segment field array

 ;     DGCS - HL7 component separator

 ;     DGRS - HL7 repetition separator

 ;    DGORU - Closed root ORU results array name

 ;  Output:

 ;    DGORU - ORU results array

 ;            Subscript

 ;            ---------

 ;            "SNDFAC"

 ;    DGERR - undefined on success, error array on failure

 ;            format: DGERR(seg_id,sequence,fld_pos)=error code

 S @DGORU@("SNDFAC")=$$IEN^XUAF4($P(DGSEG(4),DGCS,1))

PID(DGSEG,DGCS,DGRS,DGORU,DGERR) ;

 ;  Input:

 ;    DGSEG - PID segment field array

 ;     DGCS - HL7 component separator

 ;     DGRS - HL7 repetition separator

 ;    DGORU - Closed root ORU results array name

 ;  Output:

 ;    DGORU - ORU results array

 ;            Subscript

 ;            ---------

 ;            "DFN"

 ;    DGERR - undefined on success, error array on failure

 ;            format: DGERR(seg_id,sequence,fld_pos)=error code

 N DGARR

 N DGDFNERR

 N DGICN

 S DGICN=+$P(DGSEG(3),DGCS,1)

 S DGARR("DFN")=$$GETDFN^DGPFUT2(DGICN,"DGDFNERR")

 I 'DGARR("DFN"),$G(DGDFNERR("DIERR",1))]"" D

 . S DGERR("PID",DGSEG(1),3)=DGDFNERR("DIERR",1)  ;no match

 ;load results array

 S @DGORU@("DFN")=DGARR("DFN")

OBR(DGSEG,DGCS,DGRS,DGORU,DGERR) ;

 ;  Input:

 ;    DGSEG - OBR segment field array

 ;     DGCS - HL7 component separator

 ;     DGRS - HL7 repetition separator

 ;    DGORU - Closed root ORU results array name

 ;  Output:

 ;    DGORU - ORU results array

 ;            Subscript

 ;            ----------------

 ;            "FLAG"

 ;            "OWNER"

 ;            "ORIGSITE"

 ;    DGERR - undefined on success, error array on failure

 ;            format: DGERR(seg_id,sequence,fld_pos)=error code

 N DGARR

 S DGARR("FLAG")=$P($G(DGSEG(4)),DGCS,1)_";DGPF(26.15,"

 I '$$TESTVAL^DGPFUT(26.13,.02,DGARR("FLAG")) D

 . S DGERR("OBR",DGSEG(1),4)=261111   ;invalid flag

 S DGARR("OWNER")=$$IEN^XUAF4(DGSEG(20))

 I (DGARR("OWNER")="")!('$$TESTVAL^DGPFUT(26.13,.04,DGARR("OWNER"))) D

 . S DGERR("OBR",DGSEG(1),20)=261126  ;invalid owner site

 S DGARR("ORIGSITE")=$$IEN^XUAF4($G(DGSEG(21)))

 I DGARR("ORIGSITE")="" S DGARR("ORIGSITE")=@DGORU@("SNDFAC")

 I (DGARR("ORIGSITE")="")!('$$TESTVAL^DGPFUT(26.13,.05,DGARR("ORIGSITE"))) D

 . S DGERR("OBR",DGSEG(1),21)=261125  ;invalid originating site

 ;load results array

 M @DGORU=DGARR

OBX(DGSEG,DGCS,DGRS,DGORU,DGERR) ;

 ;  Input:

 ;    DGSEG - OBX segment field array

 ;     DGCS - HL7 component separator

 ;     DGRS - HL7 repetition separator

 ;    DGORU - Closed root ORU results array name

 ;  Output:

 ;    DGORU - ORU results array

 ;            Subscript

 ;            -----------------------

 ;            "NARR",line

 ;            assigndt,"ACTION"

 ;            assigndt,"COMMENT",line

 ;   DGERR - undefined on success, error array on failure

 ;           format: DGERR(seg_id,sequence,fld_pos)=error code

 N DGADT    ;assignment date

 N DGI

 N DGLINE   ;word processing line count

 N DGRSLT

 ; Narrative Observation Identifier

 I $P(DGSEG(3),DGCS,1)="N" D

 . S DGLINE=$O(@DGORU@("NARR",""),-1)

 . F DGI=1:1:$L(DGSEG(5),DGRS) D

 . . S @DGORU@("NARR",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI)

 ; Status Observation Identifier

 I $P(DGSEG(3),DGCS,1)="S" D

 . S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")

 . Q:+DGADT'>0

 . D CHK^DIE(26.14,.03,,DGSEG(5),.DGRSLT)

 . S @DGORU@(DGADT,"ACTION")=+DGRSLT

 ; Comment Observation Identifier

 I $P(DGSEG(3),DGCS,1)="C" D

 . S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")

 . Q:+DGADT'>0

 . S DGLINE=$O(@DGORU@(DGADT,"COMMENT",""),-1)

 . F DGI=1:1:$L(DGSEG(5),DGRS) D

 . . S @DGORU@(DGADT,"COMMENT",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI)

DGPFHLU   ;ALB/RPM - PRF HL7 ORU/ACK PROCESSING ; 6/21/06 10:27am

 +1       ;;5.3;Registration;**425,718,650,1015**;Aug 13, 1993;Build 21

 +2       ;

BLDORU(DGPFA,DGHARR,DGHL,DGROOT) ;Build ORU~R01 Message/Segments

 +1       ;

 +2       ;  Input:

 +3       ;      DGPFA - (required) Assignment data array

 +4       ;     DGHARR - (required) Assignment history IENs array

 +5       ;       DGHL - (required) HL7 Kernel array passed by reference

 +6       ;     DGROOT - (required) Closed root segment storage array name

 +7       ;

 +8       ;  Output:

 +9       ;   Function Value - IEN of last assignment history included in

 +10      ;                    message segments, 0 on failure

 +11      ;           DGROOT - array of HL7 segments

 +12      ;

 +13      ;assignment date

           NEW DGADT

 +14      ;function value

           NEW DGHIEN

 +15      ;last assignment date

           NEW DGLDT

 +16      ;assignment history data array

           NEW DGPFAH

 +17      ;segment counter

           NEW DGSEG

 +18      ;formatted segment string

           NEW DGSEGSTR

 +19      ;set id

           NEW DGSET

 +20      ;field string

           NEW DGSTR

 +21      ;text root

           NEW DGTROOT

 +22      ;

 +23       SET DGHIEN=0

 +24       SET DGSEG=0

 +25      ;

 +26       IF $DATA(DGPFA)

               IF $DATA(DGHARR)

                   IF $GET(DGROOT)]""

                       Begin DoDot:1

 +27      ;

 +28      ;build PID

 +29                       SET DGSTR="1,2,3,5,7,8,19"

 +30                       SET DGSEGSTR=$$EN^VAFHLPID(+DGPFA("DFN"),DGSTR,1,1)

 +31                       IF (DGSEGSTR="")

                               QUIT

 +32                       SET DGSEG=DGSEG+1

                           SET @DGROOT@(DGSEG)=DGSEGSTR

 +33      ;

 +34      ;build OBR

 +35      ;get last assignment date

                           SET DGLDT=+$ORDER(DGHARR(""),-1)

 +36      ;load asgn hx array

                           IF '$$GETHIST^DGPFAAH(DGHARR(DGLDT),.DGPFAH)

                               QUIT

 +37                       SET DGSET=1

 +38                       SET DGSTR="1,4,7,20,21"

 +39                       SET DGSEGSTR=$$OBR^DGPFHLU1(DGSET,.DGPFA,.DGPFAH,DGSTR,.DGHL)

 +40                       IF (DGSEGSTR="")

                               QUIT

 +41                       SET DGSEG=DGSEG+1

                           SET @DGROOT@(DGSEG)=DGSEGSTR

 +42      ;

 +43      ;start OBX segments

 +44                       SET DGSET=0

 +45      ;

 +46      ;build narrative OBX segments

 +47                       SET DGTROOT="DGPFA(""NARR"")"

 +48                       IF '$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"N",.DGPFAH,.DGHL,.DGSEG,.DGSET)

                               QUIT

 +49      ;

 +50      ;for each history build status & comment OBX segments

 +51                       SET DGADT=0

 +52                       FOR

                               SET DGADT=$ORDER(DGHARR(DGADT))

                               IF 'DGADT

                                   QUIT

                               Begin DoDot:2

 +53                               NEW DGPFAH

 +54                               SET DGHIEN=0

 +55                               IF '$$GETHIST^DGPFAAH(DGHARR(DGADT),.DGPFAH)

                                       QUIT

 +56      ;

 +57      ;build status OBX segment

 +58                               SET DGSTR="1,2,3,5,11,14"

 +59                               SET DGSET=DGSET+1

 +60                               SET DGSEGSTR=$$OBX^DGPFHLU2(DGSET,"S","",$PIECE($GET(DGPFAH("ACTION")),U,2),.DGPFAH,DGSTR,.DGHL)

 +61                               IF (DGSEGSTR="")

                                       QUIT

 +62                               SET DGSEG=DGSEG+1

                                   SET @DGROOT@(DGSEG)=DGSEGSTR

 +63      ;

 +64      ;build review comment OBX segments

 +65                               SET DGTROOT="DGPFAH(""COMMENT"")"

 +66                               IF '$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"C",.DGPFAH,.DGHL,.DGSEG,.DGSET)

                                       QUIT

 +67      ;

 +68      ;success

 +69                               SET DGHIEN=DGHARR(DGADT)

                               End DoDot:2

                               IF 'DGHIEN

                                   QUIT

                       End DoDot:1

 +70      ;

 +71       QUIT DGHIEN

 +72      ;

PARSORU(DGWRK,DGHL,DGROOT,DGPFERR) ;Parse ORU~R01 Message/Segments

 +1       ;

 +2       ;  Input:

 +3       ;     DGWRK - Closed root work global reference

 +4       ;      DGHL - HL7 environment array

 +5       ;    DGROOT - Closed root ORU results array name

 +6       ;

 +7       ;  Output:

 +8       ;    DGROOT - ORU results array

 +9       ;     Subscript                Field name            Fld# File#

 +10      ;     -----------------------  --------------------  ---- -----

 +11      ;     "SNDFAC"                 N/A                   N/A  N/A

 +12      ;     "DFN"                    PATIENT NAME          .01  26.13

 +13      ;     "FLAG"                   FLAG NAME             .02  26.13

 +14      ;     "OWNER"                  OWNER SITE            .04  26.13

 +15      ;     "ORIGSITE"               ORIGINATING SITE      .05  26.13

 +16      ;     "NARR",line              ASSIGNMENT NARRATIVE   1   26.13

 +17      ;     assigndt,"ACTION"        ACTION                .03  26.13

 +18      ;     assigndt,"COMMENT",line  HISTORY COMMENTS       1   26.14

 +19      ;   DGPFERR - Undefined on success, ERR segment data array on failure

 +20      ;             Format:  DGPFERR(seg_id,sequence,fld_pos)=error_code

 +21      ;

 +22      ;field separator

           NEW DGFS

 +23      ;component separator

           NEW DGCS

 +24      ;repetition separator

           NEW DGRS

 +25      ;current segment line

           NEW DGCURLIN

 +26      ;segment field data array

           NEW DGSEG

 +27      ;error processing array

           NEW DGERR

 +28      ;

 +29       SET DGFS=DGHL("FS")

 +30       SET DGCS=$EXTRACT(DGHL("ECH"),1)

 +31       SET DGRS=$EXTRACT(DGHL("ECH"),2)

 +32       SET DGCURLIN=0

 +33      ;

 +34      ;loop through message segments and retrieve field data

 +35       FOR

               Begin DoDot:1

 +36               NEW DGSEG

 +37               SET DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)

 +38               IF 'DGCURLIN

                       QUIT

 +39               DO @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGROOT,.DGPFERR)")

               End DoDot:1

               IF 'DGCURLIN

                   QUIT

 +40      ;

MSH(DGSEG,DGCS,DGRS,DGORU,DGERR) ;

 +1       ;

 +2       ;  Input:

 +3       ;    DGSEG - MSH segment field array

 +4       ;     DGCS - HL7 component separator

 +5       ;     DGRS - HL7 repetition separator

 +6       ;    DGORU - Closed root ORU results array name

 +7       ;

 +8       ;  Output:

 +9       ;    DGORU - ORU results array

 +10      ;            Subscript

 +11      ;            ---------

 +12      ;            "SNDFAC"

 +13      ;    DGERR - undefined on success, error array on failure

 +14      ;            format: DGERR(seg_id,sequence,fld_pos)=error code

 +15      ;

 +16       SET @DGORU@("SNDFAC")=$$IEN^XUAF4($PIECE(DGSEG(4),DGCS,1))

 +17       QUIT

 +18      ;

PID(DGSEG,DGCS,DGRS,DGORU,DGERR) ;

 +1       ;

 +2       ;  Input:

 +3       ;    DGSEG - PID segment field array

 +4       ;     DGCS - HL7 component separator

 +5       ;     DGRS - HL7 repetition separator

 +6       ;    DGORU - Closed root ORU results array name

 +7       ;

 +8       ;  Output:

 +9       ;    DGORU - ORU results array

 +10      ;            Subscript

 +11      ;            ---------

 +12      ;            "DFN"

 +13      ;    DGERR - undefined on success, error array on failure

 +14      ;            format: DGERR(seg_id,sequence,fld_pos)=error code

 +15      ;

 +16       NEW DGARR

 +17       NEW DGDFNERR

 +18       NEW DGICN

 +19      ;

 +20       SET DGICN=+$PIECE(DGSEG(3),DGCS,1)

 +21       SET DGARR("DFN")=$$GETDFN^DGPFUT2(DGICN,"DGDFNERR")

 +22       IF 'DGARR("DFN")

               IF $GET(DGDFNERR("DIERR",1))]""

                   Begin DoDot:1

 +23      ;no match

                       SET DGERR("PID",DGSEG(1),3)=DGDFNERR("DIERR",1)

                   End DoDot:1

 +24      ;

 +25      ;load results array

 +26       SET @DGORU@("DFN")=DGARR("DFN")

 +27       QUIT

 +28      ;

OBR(DGSEG,DGCS,DGRS,DGORU,DGERR) ;

 +1       ;

 +2       ;  Input:

 +3       ;    DGSEG - OBR segment field array

 +4       ;     DGCS - HL7 component separator

 +5       ;     DGRS - HL7 repetition separator

 +6       ;    DGORU - Closed root ORU results array name

 +7       ;

 +8       ;  Output:

 +9       ;    DGORU - ORU results array

 +10      ;            Subscript

 +11      ;            ----------------

 +12      ;            "FLAG"

 +13      ;            "OWNER"

 +14      ;            "ORIGSITE"

 +15      ;    DGERR - undefined on success, error array on failure

 +16      ;            format: DGERR(seg_id,sequence,fld_pos)=error code

 +17      ;

 +18       NEW DGARR

 +19      ;

 +20       SET DGARR("FLAG")=$PIECE($GET(DGSEG(4)),DGCS,1)_";DGPF(26.15,"

 +21       IF '$$TESTVAL^DGPFUT(26.13,.02,DGARR("FLAG"))

               Begin DoDot:1

 +22      ;invalid flag

                   SET DGERR("OBR",DGSEG(1),4)=261111

               End DoDot:1

 +23      ;

 +24       SET DGARR("OWNER")=$$IEN^XUAF4(DGSEG(20))

 +25       IF (DGARR("OWNER")="")!('$$TESTVAL^DGPFUT(26.13,.04,DGARR("OWNER")))

               Begin DoDot:1

 +26      ;invalid owner site

                   SET DGERR("OBR",DGSEG(1),20)=261126

               End DoDot:1

 +27      ;

 +28       SET DGARR("ORIGSITE")=$$IEN^XUAF4($GET(DGSEG(21)))

 +29       IF DGARR("ORIGSITE")=""

               SET DGARR("ORIGSITE")=@DGORU@("SNDFAC")

 +30       IF (DGARR("ORIGSITE")="")!('$$TESTVAL^DGPFUT(26.13,.05,DGARR("ORIGSITE")))

               Begin DoDot:1

 +31      ;invalid originating site

                   SET DGERR("OBR",DGSEG(1),21)=261125

               End DoDot:1

 +32      ;

 +33      ;load results array

 +34       MERGE @DGORU=DGARR

 +35       QUIT

 +36      ;

OBX(DGSEG,DGCS,DGRS,DGORU,DGERR) ;

 +1       ;

 +2       ;  Input:

 +3       ;    DGSEG - OBX segment field array

 +4       ;     DGCS - HL7 component separator

 +5       ;     DGRS - HL7 repetition separator

 +6       ;    DGORU - Closed root ORU results array name

 +7       ;

 +8       ;  Output:

 +9       ;    DGORU - ORU results array

 +10      ;            Subscript

 +11      ;            -----------------------

 +12      ;            "NARR",line

 +13      ;            assigndt,"ACTION"

 +14      ;            assigndt,"COMMENT",line

 +15      ;   DGERR - undefined on success, error array on failure

 +16      ;           format: DGERR(seg_id,sequence,fld_pos)=error code

 +17      ;

 +18      ;assignment date

           NEW DGADT

 +19       NEW DGI

 +20      ;word processing line count

           NEW DGLINE

 +21       NEW DGRSLT

 +22      ;

 +23      ; Narrative Observation Identifier

 +24       IF $PIECE(DGSEG(3),DGCS,1)="N"

               Begin DoDot:1

 +25               SET DGLINE=$ORDER(@DGORU@("NARR",""),-1)

 +26               FOR DGI=1:1:$LENGTH(DGSEG(5),DGRS)

                       Begin DoDot:2

 +27                       SET @DGORU@("NARR",DGLINE+DGI,0)=$PIECE(DGSEG(5),DGRS,DGI)

                       End DoDot:2

               End DoDot:1

 +28      ;

 +29      ; Status Observation Identifier

 +30       IF $PIECE(DGSEG(3),DGCS,1)="S"

               Begin DoDot:1

 +31               SET DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")

 +32               IF +DGADT'>0

                       QUIT

 +33               DO CHK^DIE(26.14,.03,,DGSEG(5),.DGRSLT)

 +34               SET @DGORU@(DGADT,"ACTION")=+DGRSLT

               End DoDot:1

 +35      ;

 +36      ; Comment Observation Identifier

 +37       IF $PIECE(DGSEG(3),DGCS,1)="C"

               Begin DoDot:1

 +38               SET DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")

 +39               IF +DGADT'>0

                       QUIT

 +40               SET DGLINE=$ORDER(@DGORU@(DGADT,"COMMENT",""),-1)

 +41               FOR DGI=1:1:$LENGTH(DGSEG(5),DGRS)

                       Begin DoDot:2

 +42                       SET @DGORU@(DGADT,"COMMENT",DGLINE+DGI,0)=$PIECE(DGSEG(5),DGRS,DGI)

                       End DoDot:2

               End DoDot:1

 +43       QUIT

DGPFHLU.m