DGPFHLU4 ;ALB/RPM - PRF HL7 ACK PROCESSING ; 3/04/03
;;5.3;Registration;**425,951**;Aug 13, 1993;Build 135
;;Per VA Directive 6402, this routine should not be modified.
;
BLDACK(DGACK,DGROOT,DGHL,DGSEGERR,DGSTOERR) ;Build ACK Message/Segments
;
; Input:
; DGACK - (required) Acknowledgement 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 HLECH=DGHL("ECH"),HLFS=DGHL("FS")
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)=$$DECHL7^DGPFHLUT($P(DGSEG(6),DGCS,1))
.Q
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFHLU4 5089 printed Nov 22, 2024@17:57:55 Page 2
DGPFHLU4 ;ALB/RPM - PRF HL7 ACK PROCESSING ; 3/04/03
+1 ;;5.3;Registration;**425,951**;Aug 13, 1993;Build 135
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
BLDACK(DGACK,DGROOT,DGHL,DGSEGERR,DGSTOERR) ;Build ACK Message/Segments
+1 ;
+2 ; Input:
+3 ; DGACK - (required) Acknowledgement 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 HLECH=DGHL("ECH")
SET HLFS=DGHL("FS")
+21 SET DGCURLIN=0
+22 ;
+23 ;loop through the message segments and retrieve the field data
+24 FOR
Begin DoDot:1
+25 NEW DGSEG
+26 SET DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)
+27 if 'DGCURLIN
QUIT
+28 DO @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,.DGACK,.DGMSG)")
End DoDot:1
if 'DGCURLIN
QUIT
+29 QUIT
+30 ;
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)=$$DECHL7^DGPFHLUT($PIECE(DGSEG(6),DGCS,1))
+21 QUIT
End DoDot:1
+22 QUIT
+23 ;
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
