DGPFHLU4.m

DGPFHLU4 ;ALB/RPM - PRF HL7 ACK PROCESSING ; 3/04/03

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

 ;

BLDACK(DGACK,DGROOT,DGHL,DGSEGERR,DGSTOERR) ;Build ACK Message/Segments

 ;

 ;  Input:

 ;      DGACK - (required) Acknowledment code

 ;     DGROOT - (required) Segment array name

 ;       DGHL - (required) HL7 environment array

 ;   DGSEGERR - (optional) defined only if errors during parsing

 ;   DGSTOERR - (optional) defined only if errors during filing

 ;

 ;  Output:

 ;   Function Value - 1 on success, 0 on failure

 ;   ^TMP("HLA",$J) - Array of ACK segments

 ;

 N DGCNT   ;segment counter

 N DGMSA   ;formatted MSA segment

 N DGRSLT  ;function value

 ;

 S DGRSLT=0

 I $G(DGACK)]"",$G(DGROOT)]"" D

 . S DGCNT=0

 . ;

 . ;build MSA segment

 . S DGMSA=$$MSA^DGPFHLU3(DGACK,DGHL("MID"),.DGSTOERR,"1,2",.DGHL)

 . Q:(DGMSA="")

 . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGMSA

 . ;

 . ;build ERR segments

 . Q:($D(DGSEGERR)&('$$BLDERR(DGROOT,.DGSEGERR,.DGHL,.DGCNT)))

 . ;

 . ;success

 . S DGRSLT=1

 Q DGRSLT

 ;

PARSACK(DGWRK,DGHL,DGACK,DGMSG) ;Parse ACK Message/Segments

 ;

 ;  Input:

 ;    DGWRK - Closed root work global reference

 ;     DGHL - HL7 environment array

 ;

 ;  Output:

 ;    DGACK - array of ACK results

 ;    DGMSG - undefined on success, array of MailMan text on failure

 ;

 N DGFS

 N DGCS

 N DGRS

 N DGSS

 N DGCURLIN

 ;

 S DGFS=DGHL("FS")

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

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

 S DGSS=$E(DGHL("ECH"),4)

 S DGCURLIN=0

 ;

 ;loop through the message segments and retrieve the field data

 F  D  Q:'DGCURLIN

 . N DGSEG

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

 . Q:'DGCURLIN

 . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,.DGACK,.DGMSG)")

 Q

 ;

MSH(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ;

 ;

 ;  Input:

 ;    DGSEG - MSH segment field array

 ;     DGCS - HL7 component separator

 ;     DGRS - HL7 repetition separator

 ;     DGSS - HL7 sub-component separator

 ;

 ;  Output:

 ;    DGACK - array of ACK results

 ;            "SNDFAC" - sending facility

 ;            "RCVFAC" - receiving facility

 ;            "MSGDTM" - message creation date/time in FileMan format

 ;    DGERR - undefined on success, error array on failure

 ;

 S DGACK("SNDFAC")=$P($G(DGSEG(4)),DGCS,1)

 S DGACK("RCVFAC")=$P($G(DGSEG(6)),DGCS,1)

 S DGACK("MSGDTM")=$$HL7TFM^XLFDT($G(DGSEG(7)))

 Q

 ;

MSA(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ;

 ;

 ;  Input:

 ;    DGSEG - MSH segment field array

 ;     DGCS - HL7 component separator

 ;     DGRS - HL7 repetition separator

 ;     DGSS - HL7 sub-component separator

 ;

 ;  Output:

 ;    DGACK - array of ACK results

 ;            "ACKCODE" - Acknowledgment code

 ;            "MSGID" - Message Control ID of the message being ACK'ed

 ;    DGERR - undefined on success, error array on failure

 ;

 N DGCNT

 ;

 S DGACK("ACKCODE")=$G(DGSEG(1))

 S DGACK("MSGID")=$G(DGSEG(2))

 I DGACK("ACKCODE")'="AA",$G(DGSEG(6))]"" D

 . S DGCNT=$O(DGERR(""),-1),DGCNT=DGCNT+1

 . S DGERR(DGCNT)=$P(DGSEG(6),DGCS,1)

 Q

 ;

ERR(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ;

 ;

 ;  Input:

 ;    DGSEG - MSH segment field array

 ;     DGCS - HL7 component separator

 ;     DGRS - HL7 repetition separator

 ;     DGSS - HL7 sub-component separator

 ;

 ;  Output:

 ;    DGACK - array of ACK results

 ;    DGERR - undefined on success, error array on failure

 ;

 N DGCNT

 N DGCOD

 ;

 I $G(DGSEG(1))]"" D

 . S DGCOD=$P($P(DGSEG(1),DGCS,4),DGSS,1)

 . I DGCOD]"" D

 . . S DGCNT=$O(DGERR(""),-1),DGCNT=DGCNT+1

 . . S DGERR(DGCNT)=DGCOD

 Q

 ;

BLDERR(DGROOT,DGSEGERR,DGHL,DGCNT) ;build all ERR segments

 ;This function builds a formatted ERR segment for each entry in the

 ;segment error array (DGSEGERR).

 ;

 ;  Input:

 ;     DGROOT - (required) Closed root array or global name for segment

 ;              storage

 ;   DGSEGERR - (required) Array of segment errors

 ;              Format: DGSEGERR(segment name,sequence,field)=error code

 ;       DGHL - (required) VistA HL7 environment array

 ;      DGCNT - (optional) Previous segment # in DGROOT

 ;

 ;  Output:

 ;   Function Value - 1 on success, 0 on failure

 ;

 N DGCOD   ;error code

 N DGERR   ;formatted ERR segment

 N DGPOS   ;field positions containing error

 N DGSEG   ;segment name containing error

 N DGSEQ   ;sequence of segment containing error

 N DGRSLT  ;function value

 ;

 S DGRSLT=0

 I $G(DGROOT)]"",$D(DGSEGERR) D

 . S DGCNT=$G(DGCNT,0)

 . S DGSEG=""

 . F  S DGSEG=$O(DGSEGERR(DGSEG)) Q:(DGSEG="")  D  Q:(DGERR="")

 . . S DGSEQ=0

 . . F  S DGSEQ=$O(DGSEGERR(DGSEG,DGSEQ)) Q:'DGSEQ  D  Q:(DGERR="")

 . . . S DGPOS=0

 . . . F  S DGPOS=$O(DGSEGERR(DGSEG,DGSEQ,DGPOS)) Q:'DGPOS  D  Q:(DGERR="")

 . . . . S DGCOD=DGSEGERR(DGSEG,DGSEQ,DGPOS)

 . . . . S DGERR=$$ERR^DGPFHLU3(DGSEG,DGSEQ,DGPOS,DGCOD,"1",.DGHL)

 . . . . Q:(DGERR="")

 . . . . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGERR

 . Q:(DGERR="")

 . S DGRSLT=1

 Q DGRSLT

DGPFHLU4  ;ALB/RPM - PRF HL7 ACK PROCESSING ; 3/04/03

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

 +2       ;

BLDACK(DGACK,DGROOT,DGHL,DGSEGERR,DGSTOERR) ;Build ACK Message/Segments

 +1       ;

 +2       ;  Input:

 +3       ;      DGACK - (required) Acknowledment code

 +4       ;     DGROOT - (required) Segment array name

 +5       ;       DGHL - (required) HL7 environment array

 +6       ;   DGSEGERR - (optional) defined only if errors during parsing

 +7       ;   DGSTOERR - (optional) defined only if errors during filing

 +8       ;

 +9       ;  Output:

 +10      ;   Function Value - 1 on success, 0 on failure

 +11      ;   ^TMP("HLA",$J) - Array of ACK segments

 +12      ;

 +13      ;segment counter

           NEW DGCNT

 +14      ;formatted MSA segment

           NEW DGMSA

 +15      ;function value

           NEW DGRSLT

 +16      ;

 +17       SET DGRSLT=0

 +18       IF $GET(DGACK)]""

               IF $GET(DGROOT)]""

                   Begin DoDot:1

 +19                   SET DGCNT=0

 +20      ;

 +21      ;build MSA segment

 +22                   SET DGMSA=$$MSA^DGPFHLU3(DGACK,DGHL("MID"),.DGSTOERR,"1,2",.DGHL)

 +23                   IF (DGMSA="")

                           QUIT 

 +24                   SET DGCNT=DGCNT+1

                       SET @DGROOT@(DGCNT)=DGMSA

 +25      ;

 +26      ;build ERR segments

 +27                   IF ($DATA(DGSEGERR)&('$$BLDERR(DGROOT,.DGSEGERR,.DGHL,.DGCNT)))

                           QUIT 

 +28      ;

 +29      ;success

 +30                   SET DGRSLT=1

                   End DoDot:1

 +31       QUIT DGRSLT

 +32      ;

PARSACK(DGWRK,DGHL,DGACK,DGMSG) ;Parse ACK Message/Segments

 +1       ;

 +2       ;  Input:

 +3       ;    DGWRK - Closed root work global reference

 +4       ;     DGHL - HL7 environment array

 +5       ;

 +6       ;  Output:

 +7       ;    DGACK - array of ACK results

 +8       ;    DGMSG - undefined on success, array of MailMan text on failure

 +9       ;

 +10       NEW DGFS

 +11       NEW DGCS

 +12       NEW DGRS

 +13       NEW DGSS

 +14       NEW DGCURLIN

 +15      ;

 +16       SET DGFS=DGHL("FS")

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

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

 +19       SET DGSS=$EXTRACT(DGHL("ECH"),4)

 +20       SET DGCURLIN=0

 +21      ;

 +22      ;loop through the message segments and retrieve the field data

 +23       FOR 

               Begin DoDot:1

 +24               NEW DGSEG

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

 +26               IF 'DGCURLIN

                       QUIT 

 +27               DO @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,.DGACK,.DGMSG)")

               End DoDot:1

               IF 'DGCURLIN

                   QUIT 

 +28       QUIT 

 +29      ;

MSH(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ;

 +1       ;

 +2       ;  Input:

 +3       ;    DGSEG - MSH segment field array

 +4       ;     DGCS - HL7 component separator

 +5       ;     DGRS - HL7 repetition separator

 +6       ;     DGSS - HL7 sub-component separator

 +7       ;

 +8       ;  Output:

 +9       ;    DGACK - array of ACK results

 +10      ;            "SNDFAC" - sending facility

 +11      ;            "RCVFAC" - receiving facility

 +12      ;            "MSGDTM" - message creation date/time in FileMan format

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

 +14      ;

 +15       SET DGACK("SNDFAC")=$PIECE($GET(DGSEG(4)),DGCS,1)

 +16       SET DGACK("RCVFAC")=$PIECE($GET(DGSEG(6)),DGCS,1)

 +17       SET DGACK("MSGDTM")=$$HL7TFM^XLFDT($GET(DGSEG(7)))

 +18       QUIT 

 +19      ;

MSA(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ;

 +1       ;

 +2       ;  Input:

 +3       ;    DGSEG - MSH segment field array

 +4       ;     DGCS - HL7 component separator

 +5       ;     DGRS - HL7 repetition separator

 +6       ;     DGSS - HL7 sub-component separator

 +7       ;

 +8       ;  Output:

 +9       ;    DGACK - array of ACK results

 +10      ;            "ACKCODE" - Acknowledgment code

 +11      ;            "MSGID" - Message Control ID of the message being ACK'ed

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

 +13      ;

 +14       NEW DGCNT

 +15      ;

 +16       SET DGACK("ACKCODE")=$GET(DGSEG(1))

 +17       SET DGACK("MSGID")=$GET(DGSEG(2))

 +18       IF DGACK("ACKCODE")'="AA"

               IF $GET(DGSEG(6))]""

                   Begin DoDot:1

 +19                   SET DGCNT=$ORDER(DGERR(""),-1)

                       SET DGCNT=DGCNT+1

 +20                   SET DGERR(DGCNT)=$PIECE(DGSEG(6),DGCS,1)

                   End DoDot:1

 +21       QUIT 

 +22      ;

ERR(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ;

 +1       ;

 +2       ;  Input:

 +3       ;    DGSEG - MSH segment field array

 +4       ;     DGCS - HL7 component separator

 +5       ;     DGRS - HL7 repetition separator

 +6       ;     DGSS - HL7 sub-component separator

 +7       ;

 +8       ;  Output:

 +9       ;    DGACK - array of ACK results

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

 +11      ;

 +12       NEW DGCNT

 +13       NEW DGCOD

 +14      ;

 +15       IF $GET(DGSEG(1))]""

               Begin DoDot:1

 +16               SET DGCOD=$PIECE($PIECE(DGSEG(1),DGCS,4),DGSS,1)

 +17               IF DGCOD]""

                       Begin DoDot:2

 +18                       SET DGCNT=$ORDER(DGERR(""),-1)

                           SET DGCNT=DGCNT+1

 +19                       SET DGERR(DGCNT)=DGCOD

                       End DoDot:2

               End DoDot:1

 +20       QUIT 

 +21      ;

BLDERR(DGROOT,DGSEGERR,DGHL,DGCNT) ;build all ERR segments

 +1       ;This function builds a formatted ERR segment for each entry in the

 +2       ;segment error array (DGSEGERR).

 +3       ;

 +4       ;  Input:

 +5       ;     DGROOT - (required) Closed root array or global name for segment

 +6       ;              storage

 +7       ;   DGSEGERR - (required) Array of segment errors

 +8       ;              Format: DGSEGERR(segment name,sequence,field)=error code

 +9       ;       DGHL - (required) VistA HL7 environment array

 +10      ;      DGCNT - (optional) Previous segment # in DGROOT

 +11      ;

 +12      ;  Output:

 +13      ;   Function Value - 1 on success, 0 on failure

 +14      ;

 +15      ;error code

           NEW DGCOD

 +16      ;formatted ERR segment

           NEW DGERR

 +17      ;field positions containing error

           NEW DGPOS

 +18      ;segment name containing error

           NEW DGSEG

 +19      ;sequence of segment containing error

           NEW DGSEQ

 +20      ;function value

           NEW DGRSLT

 +21      ;

 +22       SET DGRSLT=0

 +23       IF $GET(DGROOT)]""

               IF $DATA(DGSEGERR)

                   Begin DoDot:1

 +24                   SET DGCNT=$GET(DGCNT,0)

 +25                   SET DGSEG=""

 +26                   FOR 

                           SET DGSEG=$ORDER(DGSEGERR(DGSEG))

                           IF (DGSEG="")

                               QUIT 

                           Begin DoDot:2

 +27                           SET DGSEQ=0

 +28                           FOR 

                                   SET DGSEQ=$ORDER(DGSEGERR(DGSEG,DGSEQ))

                                   IF 'DGSEQ

                                       QUIT 

                                   Begin DoDot:3

 +29                                   SET DGPOS=0

 +30                                   FOR 

                                           SET DGPOS=$ORDER(DGSEGERR(DGSEG,DGSEQ,DGPOS))

                                           IF 'DGPOS

                                               QUIT 

                                           Begin DoDot:4

 +31                                           SET DGCOD=DGSEGERR(DGSEG,DGSEQ,DGPOS)

 +32                                           SET DGERR=$$ERR^DGPFHLU3(DGSEG,DGSEQ,DGPOS,DGCOD,"1",.DGHL)

 +33                                           IF (DGERR="")

                                                   QUIT 

 +34                                           SET DGCNT=DGCNT+1

                                               SET @DGROOT@(DGCNT)=DGERR

                                           End DoDot:4

                                           IF (DGERR="")

                                               QUIT 

                                   End DoDot:3

                                   IF (DGERR="")

                                       QUIT 

                           End DoDot:2

                           IF (DGERR="")

                               QUIT 

 +35                   IF (DGERR="")

                           QUIT 

 +36                   SET DGRSLT=1

                   End DoDot:1

 +37       QUIT DGRSLT