Routine: DGPFHLU5

DGPFHLU5 ;ALB/RPM - PRF HL7 ACK PROCESSING ; 6/21/06 10:18am

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

PROCERR(DGLIEN,DGACK,DGERR) ;process errors returned from ACK

 ;  Input:

 ;    DGLIEN - IEN of PRF HL7 TRANSMISSION LOG (#26.17) file

 ;     DGACK - array of ACK parse data

 ;     DGERR - array of parsed errors (ex: DGERR(1)=error_code)

 ; Output: none

 N DGPFA   ;assignment array

 N DGPFAH  ;assignment history array

 N DGPFL   ;HL7 transmission log array

 N DGXMTXT ;mailman msg text array

 I +$G(DGLIEN),$D(DGACK),$D(DGERR) D

. ;

 . ;retrieve the HL7 transmission log values

 . Q:'$$GETLOG^DGPFHLL(DGLIEN,.DGPFL)

. ;

 . ;retrieve assignment history values

 . Q:'$$GETHIST^DGPFAAH(+$G(DGPFL("ASGNHIST")),.DGPFAH)

. ;

 . ;retransmit and quit if dialog error code "Assignment not found"

 . I $$FNDDIA(261102,.DGERR) D  Q

 . . ;transmit all assignment records to rejecting site

 . . Q:'$$XMIT^DGPFLMT5(+$G(DGPFAH("ASSIGN")),$P($G(DGPFL("SITE")),U))

 . . ;update HL7 transmission log status (RE-TRANSMITTED)

 . . D STOSTAT^DGPFHLL(26.17,DGLIEN,"RT")

. ;

 . ;retrieve assignment values

 . Q:'$$GETASGN^DGPFAA(+$G(DGPFAH("ASSIGN")),.DGPFA)

. ;

 . S DGXMTXT=$NA(^TMP("DGPFERR",$J))

 . K @DGXMTXT

. ;

 . ;create message text array

 . D BLDMSG(.DGPFA,.DGACK,.DGERR,DGXMTXT)

. ;

 . ;send the notification message

 . D SEND(DGXMTXT)

. ;

 . ;cleanup

 . K @DGXMTXT

BLDMSG(DGPFA,DGACK,DGERR,DGXMTXT) ;build MailMan message array

 ;  Supported DBIA #2171:  The supported DBIA is uses to access Kernel

 ;                         APIs for retrieving Station numbers and names

 ;                         from the INSTITUTION (#4) file.

 ;  Supported DBIA #2701:  The supported DBIA is used to access MPI APIs

 ;                         for retrieving an ICN for a given DFN.

 ;  Input:

 ;    DGPFA - assignment data array

 ;    DGACK - array of ACK data

 ;    DGERR - array of parsed errors (ex: DGERR(1)=error_code)

 ;  Output:

 ;    DGXMTXT - array of MailMan text lines

 N DGCNT   ;error count

 N DGCOD   ;error code

 N DGDEM   ;patient demographics array

 N DGDFN   ;pointer to PATIENT (#2) file

 N DGDLG   ;DIALOG array

 N DGFAC   ;facility data array from XUAF4 call

 N DGI     ;generic counter

 N DGICN   ;integrated control number

 N DGLIN   ;line counter

 N DGMAX   ;maximum line length

 N DGSITE  ;results of VASITE call

 N DGSNDSTA  ;sending station number

 N DGSNDNAM  ;sending station name

 N DGTBL   ;error code table array

 S DGDFN=+$G(DGPFA("DFN"))

 Q:(DGDFN'>0)

 ;retrieve patient demographics

 Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM)

 S DGICN=$$GETICN^MPIF001(DGDFN)

 S DGICN=$S(+DGICN>0:DGICN,1:$P(DGICN,U,2))

 ;load error code table

 D BLDVA086^DGPFHLU3(.DGTBL)

 S DGLIN=0

 S DGMAX=65

 S DGSITE=$$SITE^VASITE()

 S DGSNDSTA=$G(DGACK("SNDFAC"))

 D F4^XUAF4(DGSNDSTA,.DGFAC,"","")

 S DGSNDNAM=$S(DGFAC>0:$G(DGFAC("NAME")),1:"")

 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("* * * *  P R F  H L 7  E R R O R  E N C O U N T E R E D  * * * *",0,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("A facility could not process the following Patient Record Flag assignment on "_$$FMTE^XLFDT($G(DGACK("MSGDTM")))_".",0,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("Message Control ID#: "_$G(DGACK("MSGID")),4,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("Receiving Facility name: "_DGSNDNAM_" ("_DGSNDSTA_")",0,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("Flag Name: "_$P($G(DGPFA("FLAG")),U,2),14,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("Patient Name: "_DGDEM("NAME"),11,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("Social Security #: "_DGDEM("SSN"),6,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("Date of Birth: "_$$FMTE^XLFDT(DGDEM("DOB"),"2D"),10,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("Integrated Control #: "_DGICN,3,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("Owning Site: "_$P($G(DGPFA("OWNER")),U,2)_" ("_$$STA^XUAF4($P($G(DGPFA("OWNER")),U))_")",12,DGMAX,.DGLIN,DGXMTXT)

 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 ;loop through each error

 S DGCNT=0

 F  S DGCNT=$O(DGERR(DGCNT)) Q:'DGCNT  D

 . K DGDLG

 . S DGCOD=DGERR(DGCNT)

. ;

 . ;assume numeric error code is a DIALOG

 . I DGCOD?1N.N D BLD^DIALOG(DGCOD,"","","DGDLG","S")

 . I $D(DGDLG) D FORMAT^DGPFLMT4(.DGDLG,DGMAX-12)

. ;

 . ;if not a DIALOG, then is it a table entry?

 . I '$D(DGDLG),DGCOD]"",$D(DGTBL(DGCOD,"DESC")) S DGDLG(1)=DGTBL(DGCOD,"DESC")

. ;

 . ;not a DIALOG or table entry - then error is unknown

 . I '$D(DGDLG) S DGDLG(1)="Unknown Error code: '"_DGCOD_"'"

. ;

 . ;error header

 . D ADDLINE("Reason#: "_DGCNT,0,DGMAX,.DGLIN,DGXMTXT)

. ;

 . ;loop through error text array

 . S DGI=0

 . F  S DGI=$O(DGDLG(DGI)) Q:'DGI  D

 . . D ADDLINE(DGDLG(DGI),12,DGMAX,.DGLIN,DGXMTXT)

. ;

 . ;error separator

 . D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array

 ;  Input:

 ;     DGTEXT - text string

 ;   DGINDENT - number of spaces to insert at start of line

 ;   DGMAXLEN - maximum desired line length (default: 60)

 ;      DGCNT - line number passed by reference

 ;  Output:

 ;    DGXMTXT - array of text strings

 N DGAVAIL  ;available space for text

 N DGLINE   ;truncated text

 N DGLOC    ;location of space character

 N DGPAD    ;space indent

 S DGTEXT=$G(DGTEXT)

 S DGINDENT=+$G(DGINDENT)

 S DGMAXLEN=+$G(DGMAXLEN)

 S:'DGMAXLEN DGMAXLEN=60

 I DGINDENT>(DGMAXLEN-1) S DGINDENT=0

 S DGCNT=$G(DGCNT,0)  ;default to 0

 S DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT)

 ;determine available space for text

 S DGAVAIL=(DGMAXLEN-DGINDENT)

 F  D  Q:('$L(DGTEXT))

. ;

 . ;find potential line break

 . S DGLOC=$L($E(DGTEXT,1,DGAVAIL)," ")

. ;

 . ;break a line that is too long when it has potential line breaks

 . I $L(DGTEXT)>DGAVAIL,DGLOC D

 . . S DGLINE=$P(DGTEXT," ",1,$S(DGLOC>1:DGLOC-1,1:1))

 . . S DGTEXT=$P(DGTEXT," ",$S(DGLOC>1:DGLOC,1:DGLOC+1),$L(DGTEXT," "))

 . E  D

 . . S DGLINE=DGTEXT,DGTEXT=""

. ;

 . S DGCNT=DGCNT+1

 . S @DGXMTXT@(DGCNT)=DGPAD_DGLINE

SEND(DGXMTXT) ;send the MailMan message

 ;  Input:

 ;    DGXMTXT - name of message text array in closed format

 ;  Output:

 ;    none

 N DIFROM  ;protect FM package

 N XMDUZ   ;sender

 N XMSUB   ;message subject

 N XMTEXT  ;name of message text array in open format

 N XMY     ;recipient array

 N XMZ     ;returned message number

 S XMDUZ="Patient Record Flag Module"

 S XMSUB="PRF MESSAGE TRANSMISSION ERROR"

 S XMTEXT=$$OREF^DILF(DGXMTXT)

 S XMY("G.DGPF HL7 TRANSMISSION ERRORS")=""

 D ^XMD

FNDDIA(DGDIA,DGERR) ;find dialog code

 ;This function searches an array for a specific DIALOG (#.84) code.

 ;  Input: (required)

 ;     DGDIA - dialog error code

 ;     DGERR - array of parsed errors (ex: DGERR(1)=error_code)

 ; Output:

 ;   Function value - 1 on success; 0 on failure

 N DGI      ;generic counter

 N DGRSLT   ;function value

 S (DGI,DGRSLT)=0

 I +$G(DGDIA),$D(DGERR) D

 . F  S DGI=$O(DGERR(DGI)) Q:'DGI  D  Q:DGRSLT

 . . I $G(DGERR(DGI))=DGDIA S DGRSLT=1

 Q DGRSLT

DGPFHLU5  ;ALB/RPM - PRF HL7 ACK PROCESSING ; 6/21/06 10:18am

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

 +2       ;

 +3        QUIT

 +4       ;

PROCERR(DGLIEN,DGACK,DGERR) ;process errors returned from ACK

 +1       ;

 +2       ;  Input:

 +3       ;    DGLIEN - IEN of PRF HL7 TRANSMISSION LOG (#26.17) file

 +4       ;     DGACK - array of ACK parse data

 +5       ;     DGERR - array of parsed errors (ex: DGERR(1)=error_code)

 +6       ;

 +7       ; Output: none

 +8       ;

 +9       ;assignment array

           NEW DGPFA

 +10      ;assignment history array

           NEW DGPFAH

 +11      ;HL7 transmission log array

           NEW DGPFL

 +12      ;mailman msg text array

           NEW DGXMTXT

 +13      ;

 +14       IF +$GET(DGLIEN)

               IF $DATA(DGACK)

                   IF $DATA(DGERR)

                       Begin DoDot:1

 +15      ;

 +16      ;retrieve the HL7 transmission log values

 +17                       IF '$$GETLOG^DGPFHLL(DGLIEN,.DGPFL)

                               QUIT

 +18      ;

 +19      ;retrieve assignment history values

 +20                       IF '$$GETHIST^DGPFAAH(+$GET(DGPFL("ASGNHIST")),.DGPFAH)

                               QUIT

 +21      ;

 +22      ;retransmit and quit if dialog error code "Assignment not found"

 +23                       IF $$FNDDIA(261102,.DGERR)

                               Begin DoDot:2

 +24      ;transmit all assignment records to rejecting site

 +25                               IF '$$XMIT^DGPFLMT5(+$GET(DGPFAH("ASSIGN")),$PIECE($GET(DGPFL("SITE")),U))

                                       QUIT

 +26      ;update HL7 transmission log status (RE-TRANSMITTED)

 +27                               DO STOSTAT^DGPFHLL(26.17,DGLIEN,"RT")

                               End DoDot:2

                               QUIT

 +28      ;

 +29      ;retrieve assignment values

 +30                       IF '$$GETASGN^DGPFAA(+$GET(DGPFAH("ASSIGN")),.DGPFA)

                               QUIT

 +31      ;

 +32                       SET DGXMTXT=$NAME(^TMP("DGPFERR",$JOB))

 +33                       KILL @DGXMTXT

 +34      ;

 +35      ;create message text array

 +36                       DO BLDMSG(.DGPFA,.DGACK,.DGERR,DGXMTXT)

 +37      ;

 +38      ;send the notification message

 +39                       DO SEND(DGXMTXT)

 +40      ;

 +41      ;cleanup

 +42                       KILL @DGXMTXT

                       End DoDot:1

 +43       QUIT

 +44      ;

BLDMSG(DGPFA,DGACK,DGERR,DGXMTXT) ;build MailMan message array

 +1       ;

 +2       ;  Supported DBIA #2171:  The supported DBIA is uses to access Kernel

 +3       ;                         APIs for retrieving Station numbers and names

 +4       ;                         from the INSTITUTION (#4) file.

 +5       ;  Supported DBIA #2701:  The supported DBIA is used to access MPI APIs

 +6       ;                         for retrieving an ICN for a given DFN.

 +7       ;

 +8       ;  Input:

 +9       ;    DGPFA - assignment data array

 +10      ;    DGACK - array of ACK data

 +11      ;    DGERR - array of parsed errors (ex: DGERR(1)=error_code)

 +12      ;

 +13      ;  Output:

 +14      ;    DGXMTXT - array of MailMan text lines

 +15      ;

 +16      ;error count

           NEW DGCNT

 +17      ;error code

           NEW DGCOD

 +18      ;patient demographics array

           NEW DGDEM

 +19      ;pointer to PATIENT (#2) file

           NEW DGDFN

 +20      ;DIALOG array

           NEW DGDLG

 +21      ;facility data array from XUAF4 call

           NEW DGFAC

 +22      ;generic counter

           NEW DGI

 +23      ;integrated control number

           NEW DGICN

 +24      ;line counter

           NEW DGLIN

 +25      ;maximum line length

           NEW DGMAX

 +26      ;results of VASITE call

           NEW DGSITE

 +27      ;sending station number

           NEW DGSNDSTA

 +28      ;sending station name

           NEW DGSNDNAM

 +29      ;error code table array

           NEW DGTBL

 +30      ;

 +31       SET DGDFN=+$GET(DGPFA("DFN"))

 +32       IF (DGDFN'>0)

               QUIT

 +33      ;

 +34      ;retrieve patient demographics

 +35       IF '$$GETPAT^DGPFUT2(DGDFN,.DGDEM)

               QUIT

 +36       SET DGICN=$$GETICN^MPIF001(DGDFN)

 +37       SET DGICN=$SELECT(+DGICN>0:DGICN,1:$PIECE(DGICN,U,2))

 +38      ;

 +39      ;load error code table

 +40       DO BLDVA086^DGPFHLU3(.DGTBL)

 +41      ;

 +42       SET DGLIN=0

 +43       SET DGMAX=65

 +44       SET DGSITE=$$SITE^VASITE()

 +45       SET DGSNDSTA=$GET(DGACK("SNDFAC"))

 +46       DO F4^XUAF4(DGSNDSTA,.DGFAC,"","")

 +47       SET DGSNDNAM=$SELECT(DGFAC>0:$GET(DGFAC("NAME")),1:"")

 +48      ;

 +49       DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 +50       DO ADDLINE("* * * *  P R F  H L 7  E R R O R  E N C O U N T E R E D  * * * *",0,DGMAX,.DGLIN,DGXMTXT)

 +51       DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 +52       DO ADDLINE("A facility could not process the following Patient Record Flag assignment on "_$$FMTE^XLFDT($GET(DGACK("MSGDTM")))_".",0,DGMAX,.DGLIN,DGXMTXT)

 +53       DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 +54       DO ADDLINE("Message Control ID#: "_$GET(DGACK("MSGID")),4,DGMAX,.DGLIN,DGXMTXT)

 +55       DO ADDLINE("Receiving Facility name: "_DGSNDNAM_" ("_DGSNDSTA_")",0,DGMAX,.DGLIN,DGXMTXT)

 +56       DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 +57       DO ADDLINE("Flag Name: "_$PIECE($GET(DGPFA("FLAG")),U,2),14,DGMAX,.DGLIN,DGXMTXT)

 +58       DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 +59       DO ADDLINE("Patient Name: "_DGDEM("NAME"),11,DGMAX,.DGLIN,DGXMTXT)

 +60       DO ADDLINE("Social Security #: "_DGDEM("SSN"),6,DGMAX,.DGLIN,DGXMTXT)

 +61       DO ADDLINE("Date of Birth: "_$$FMTE^XLFDT(DGDEM("DOB"),"2D"),10,DGMAX,.DGLIN,DGXMTXT)

 +62       DO ADDLINE("Integrated Control #: "_DGICN,3,DGMAX,.DGLIN,DGXMTXT)

 +63       DO ADDLINE("Owning Site: "_$PIECE($GET(DGPFA("OWNER")),U,2)_" ("_$$STA^XUAF4($PIECE($GET(DGPFA("OWNER")),U))_")",12,DGMAX,.DGLIN,DGXMTXT)

 +64       DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

 +65      ;

 +66      ;loop through each error

 +67       SET DGCNT=0

 +68       FOR

               SET DGCNT=$ORDER(DGERR(DGCNT))

               IF 'DGCNT

                   QUIT

               Begin DoDot:1

 +69               KILL DGDLG

 +70               SET DGCOD=DGERR(DGCNT)

 +71      ;

 +72      ;assume numeric error code is a DIALOG

 +73               IF DGCOD?1N.N

                       DO BLD^DIALOG(DGCOD,"","","DGDLG","S")

 +74               IF $DATA(DGDLG)

                       DO FORMAT^DGPFLMT4(.DGDLG,DGMAX-12)

 +75      ;

 +76      ;if not a DIALOG, then is it a table entry?

 +77               IF '$DATA(DGDLG)

                       IF DGCOD]""

                           IF $DATA(DGTBL(DGCOD,"DESC"))

                               SET DGDLG(1)=DGTBL(DGCOD,"DESC")

 +78      ;

 +79      ;not a DIALOG or table entry - then error is unknown

 +80               IF '$DATA(DGDLG)

                       SET DGDLG(1)="Unknown Error code: '"_DGCOD_"'"

 +81      ;

 +82      ;error header

 +83               DO ADDLINE("Reason#: "_DGCNT,0,DGMAX,.DGLIN,DGXMTXT)

 +84      ;

 +85      ;loop through error text array

 +86               SET DGI=0

 +87               FOR

                       SET DGI=$ORDER(DGDLG(DGI))

                       IF 'DGI

                           QUIT

                       Begin DoDot:2

 +88                       DO ADDLINE(DGDLG(DGI),12,DGMAX,.DGLIN,DGXMTXT)

                       End DoDot:2

 +89      ;

 +90      ;error separator

 +91               DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)

               End DoDot:1

 +92      ;

 +93       QUIT

 +94      ;

ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array

 +1       ;

 +2       ;  Input:

 +3       ;     DGTEXT - text string

 +4       ;   DGINDENT - number of spaces to insert at start of line

 +5       ;   DGMAXLEN - maximum desired line length (default: 60)

 +6       ;      DGCNT - line number passed by reference

 +7       ;

 +8       ;  Output:

 +9       ;    DGXMTXT - array of text strings

 +10      ;

 +11      ;available space for text

           NEW DGAVAIL

 +12      ;truncated text

           NEW DGLINE

 +13      ;location of space character

           NEW DGLOC

 +14      ;space indent

           NEW DGPAD

 +15      ;

 +16       SET DGTEXT=$GET(DGTEXT)

 +17       SET DGINDENT=+$GET(DGINDENT)

 +18       SET DGMAXLEN=+$GET(DGMAXLEN)

 +19       IF 'DGMAXLEN

               SET DGMAXLEN=60

 +20       IF DGINDENT>(DGMAXLEN-1)

               SET DGINDENT=0

 +21      ;default to 0

           SET DGCNT=$GET(DGCNT,0)

 +22      ;

 +23       SET DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT)

 +24      ;

 +25      ;determine available space for text

 +26       SET DGAVAIL=(DGMAXLEN-DGINDENT)

 +27       FOR

               Begin DoDot:1

 +28      ;

 +29      ;find potential line break

 +30               SET DGLOC=$LENGTH($EXTRACT(DGTEXT,1,DGAVAIL)," ")

 +31      ;

 +32      ;break a line that is too long when it has potential line breaks

 +33               IF $LENGTH(DGTEXT)>DGAVAIL

                       IF DGLOC

                           Begin DoDot:2

 +34                           SET DGLINE=$PIECE(DGTEXT," ",1,$SELECT(DGLOC>1:DGLOC-1,1:1))

 +35                           SET DGTEXT=$PIECE(DGTEXT," ",$SELECT(DGLOC>1:DGLOC,1:DGLOC+1),$LENGTH(DGTEXT," "))

                           End DoDot:2

 +36              IF '$TEST

                       Begin DoDot:2

 +37                       SET DGLINE=DGTEXT

                           SET DGTEXT=""

                       End DoDot:2

 +38      ;

 +39               SET DGCNT=DGCNT+1

 +40               SET @DGXMTXT@(DGCNT)=DGPAD_DGLINE

               End DoDot:1

               IF ('$LENGTH(DGTEXT))

                   QUIT

 +41       QUIT

 +42      ;

SEND(DGXMTXT) ;send the MailMan message

 +1       ;

 +2       ;  Input:

 +3       ;    DGXMTXT - name of message text array in closed format

 +4       ;

 +5       ;  Output:

 +6       ;    none

 +7       ;

 +8       ;protect FM package

           NEW DIFROM

 +9       ;sender

           NEW XMDUZ

 +10      ;message subject

           NEW XMSUB

 +11      ;name of message text array in open format

           NEW XMTEXT

 +12      ;recipient array

           NEW XMY

 +13      ;returned message number

           NEW XMZ

 +14      ;

 +15       SET XMDUZ="Patient Record Flag Module"

 +16       SET XMSUB="PRF MESSAGE TRANSMISSION ERROR"

 +17       SET XMTEXT=$$OREF^DILF(DGXMTXT)

 +18       SET XMY("G.DGPF HL7 TRANSMISSION ERRORS")=""

 +19       DO ^XMD

 +20       QUIT

 +21      ;

FNDDIA(DGDIA,DGERR) ;find dialog code

 +1       ;This function searches an array for a specific DIALOG (#.84) code.

 +2       ;

 +3       ;  Input: (required)

 +4       ;     DGDIA - dialog error code

 +5       ;     DGERR - array of parsed errors (ex: DGERR(1)=error_code)

 +6       ;

 +7       ; Output:

 +8       ;   Function value - 1 on success; 0 on failure

 +9       ;

 +10      ;generic counter

           NEW DGI

 +11      ;function value

           NEW DGRSLT

 +12       SET (DGI,DGRSLT)=0

 +13      ;

 +14       IF +$GET(DGDIA)

               IF $DATA(DGERR)

                   Begin DoDot:1

 +15                   FOR

                           SET DGI=$ORDER(DGERR(DGI))

                           IF 'DGI

                               QUIT

                           Begin DoDot:2

 +16                           IF $GET(DGERR(DGI))=DGDIA

                                   SET DGRSLT=1

                           End DoDot:2

                           IF DGRSLT

                               QUIT

                   End DoDot:1

 +17      ;

 +18       QUIT DGRSLT

DGPFHLU5.m