DGPFHLU3 ;ALB/RPM - PRF HL7 BUILD MSA/ERR SEGMENTS ; 3/03/03
;;5.3;Registration;**425,650,951,1005**;Aug 13, 1993;Build 57
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
MSA(DGACK,DGID,DGERR,DGFLD,DGHL) ;MSA Segment API
;This function wraps the data retrieval and segment creation APIs and
;returns a formatted MSA segment.
;
; Input:
; DGACK - (required) MSA segment Acknowledgment code
; DGID - (required) Message Control ID
; DGERR - (optional) Error condition
; DGFLD - (optional) List of comma-separated fields (sequence #'s)
; to include. Defaults to all required fields (1,2).
; DGHL - (required) HL7 environment array
;
; Output:
; Function Value - MSA segment on success, "" on failure
;
N DGMSA
N DGVAL
;
S HLECH=DGHL("ECH"),HLFS=DGHL("FS")
S DGMSA=""
;DG*5.3*1005 - DGID may be alphanumeric
I $G(DGACK)]"",$G(DGID)'="" D
. S DGERR=$G(DGERR)
. S DGFLD=$$CKSTR^DGPFHLUT("1,2",DGFLD) ;validate field string
. I DGERR]"" S DGFLD=DGFLD_",6"
. S DGFLD=","_DGFLD_","
. I $$MSAVAL(DGFLD,DGACK,DGID,"","","",DGERR,.DGVAL) D
. . S DGMSA=$$BLDSEG^DGPFHLUT("MSA",.DGVAL,.DGHL)
Q DGMSA
;
MSAVAL(DGFLD,DGACK,DGID,DGTEXT,DGESN,DGDAT,DGERR,DGVAL) ;build MSA value array
;
; Input:
; DGFLD - (required) fields string
; DGACK - (required) MSA segment Acknowledgment code
; DGID - (required) Message Control ID
; DGTEXT - (optional) Text message
; DGESN - (optional) Expected sequence number
; DGDAT - (optional) Delayed acknowledgment type
; DGERR - (optional) Error condition
;
; Output:
; Function Value - 1 on success, 0 on failure
; DGVAL - MSA field array [SUB1:field, SUB2:repetition,
; SUB3:component, SUB4:sub-component]
;
N DGRSLT ;function value
N DGACKS ;array of valid ACK codes
N DGCOD ;ACK code string
;
S DGRSLT=0
;DG*5.3*1005 - DGID may be alphanumeric
I $G(DGFLD)]"",$G(DGACK)]"",$G(DGID)'="" D
.F DGCOD="AA","AE","AR","CA","CE","CR" S DGACKS(DGCOD)=""
.; seq 1 Acknowledgment Code
.I DGFLD[",1," S DGVAL(1)=$S($D(DGACKS(DGACK)):DGACK,1:"")
.Q:(DGVAL(1)="") ;required field
.; seq 2 Message Control ID
.I DGFLD[",2," S DGVAL(2)=DGID
.Q:(DGVAL(2)="") ;required field
.; seq 3 Text Message
.I DGFLD[",3," S DGVAL(3)=$$ENCHL7^DGPFHLUT($G(DGTEXT))
.; seq 4 Expected Sequence Number
.I DGFLD[",4," S DGVAL(4)=$G(DGESN)
.; seq 5 Delayed Acknowledgment Type
.I DGFLD[",5," D
..S DGDAT=$G(DGDAT)
..S DGVAL(5)=$S(DGDAT="D":DGDAT,DGDAT="F":DGDAT,1:"")
..Q
.; seq 6 Error Condition
.I DGFLD[",6," D
..S DGVAL(6,1,1)=$$ENCHL7^DGPFHLUT(DGERR)
..S DGVAL(6,1,2)=$$ENCHL7^DGPFHLUT($$EZBLD^DIALOG(DGERR))
..S DGVAL(6,1,3)="L"
..Q
.S DGRSLT=1
I 'DGRSLT K DGVAL
Q DGRSLT
;
ERR(DGSEG,DGSEQ,DGPOS,DGCOD,DGFLD,DGHL) ;ERR segment API
;
; Input:
; DGSEG - (required) Segment ID
; DGSEQ - (required) Sequence
; DGPOS - (required) Field position
; DGCOD - (required) Error code
; DGFLD - (optional) List of comma-separated fields (sequence #'s)
; to include. Defaults to all required fields (1).
; DGHL - (required) HL7 Environment array
;
; Output:
; Function value - ERR segment on success, "" on failure
;
N DGERR
N DGVAL
;
S DGERR=""
I $G(DGSEG)]"",+$G(DGSEQ),+$G(DGPOS),$G(DGCOD)]"",$G(DGHL("ECH"))]"" D
. S DGFLD=$$CKSTR^DGPFHLUT("1",DGFLD) ;validate field string
. S DGFLD=","_DGFLD_","
. I $$ERRVAL(DGFLD,DGSEG,DGSEQ,DGPOS,DGCOD,.DGVAL) D
. . S DGERR=$$BLDSEG^DGPFHLUT("ERR",.DGVAL,.DGHL)
Q DGERR
;
ERRVAL(DGFLD,DGSEG,DGSEQ,DGPOS,DGCOD,DGVAL) ;build ERR value array
;
; Input:
; DGFLD - (required) Field string
; DGSEG - (required) Segment ID
; DGSEQ - (required) Sequence
; DGPOS - (required) Field position
; DGCOD - (required) Error code
;
; Output:
; Function value - 1 on success, 0 on failure
; DGVAL - ERR field array [SUB1:field, SUB2:repetition,
; SUB3:component, SUB4:sub-component]
N DGRSLT
;
S DGRSLT=0
I $G(DGFLD)]"",$G(DGSEG)]"",+$G(DGSEQ),+$G(DGPOS),$G(DGCOD)]"" D
. I DGFLD[",1," D
. . S DGVAL(1,1,1)=DGSEG
. . S DGVAL(1,1,2)=DGSEQ
. . S DGVAL(1,1,3)=DGPOS
. . S DGVAL(1,1,4,1)=DGCOD
. . S DGVAL(1,1,4,2)=$$EZBLD^DIALOG(DGCOD)
. . S DGVAL(1,1,4,3)="L"
. S DGRSLT=1
Q DGRSLT
;
BLDVA086(DGTBL) ;build error code/text array for table VA086
;
; Input:
; none
;
; Output:
; DGTBL - error code array subscripted by code containing error text
;
N DGI
N DGLINE
N DGCOD
N DGTXT
N DGDESC
;
F DGI=1:1 S DGLINE=$T(ERRTBL+DGI) Q:DGLINE="" D
. S DGCOD=$P(DGLINE,";",3)
. S DGTXT=$P(DGLINE,";",4)
. S DGDESC=$P(DGLINE,";",5)
. S DGTBL(DGCOD)=DGTXT
. S DGTBL(DGCOD,"DESC")=DGDESC
Q
;
ERRTBL ;VA086 Error Code Table;error code;error text
;;FE;Filer Error;An error occurred at the remote site when attempting to add, update or retrieve assignment data.
;;IF;Invalid Patient Record Flag;The transmitted Patient Record Flag is not defined at the remote site.
;;IID;Invalid Observation ID;The transmitted observation ID is not "N"arrative, "S"tatus or "C"omment.
;;IOR;Invalid Originating Site;The originating site of the transmission is not defined at the remote site.
;;IOW;Invalid Owner Site;The transmitted owning site is not defined at the remote site.
;;NM;No Match;No patient was found that correlates to the transmitted ICN, DOB and SSN.
;;UU;Unauthorized Update;The originating site of the transmission is not defined as the owning site of the assignment or an invalid action was transmitted (i.e. Reactivate an already active assignment).
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFHLU3 5829 printed Sep 11, 2024@03:07:50 Page 2
DGPFHLU3 ;ALB/RPM - PRF HL7 BUILD MSA/ERR SEGMENTS ; 3/03/03
+1 ;;5.3;Registration;**425,650,951,1005**;Aug 13, 1993;Build 57
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
MSA(DGACK,DGID,DGERR,DGFLD,DGHL) ;MSA Segment API
+1 ;This function wraps the data retrieval and segment creation APIs and
+2 ;returns a formatted MSA segment.
+3 ;
+4 ; Input:
+5 ; DGACK - (required) MSA segment Acknowledgment code
+6 ; DGID - (required) Message Control ID
+7 ; DGERR - (optional) Error condition
+8 ; DGFLD - (optional) List of comma-separated fields (sequence #'s)
+9 ; to include. Defaults to all required fields (1,2).
+10 ; DGHL - (required) HL7 environment array
+11 ;
+12 ; Output:
+13 ; Function Value - MSA segment on success, "" on failure
+14 ;
+15 NEW DGMSA
+16 NEW DGVAL
+17 ;
+18 SET HLECH=DGHL("ECH")
SET HLFS=DGHL("FS")
+19 SET DGMSA=""
+20 ;DG*5.3*1005 - DGID may be alphanumeric
+21 IF $GET(DGACK)]""
IF $GET(DGID)'=""
Begin DoDot:1
+22 SET DGERR=$GET(DGERR)
+23 ;validate field string
SET DGFLD=$$CKSTR^DGPFHLUT("1,2",DGFLD)
+24 IF DGERR]""
SET DGFLD=DGFLD_",6"
+25 SET DGFLD=","_DGFLD_","
+26 IF $$MSAVAL(DGFLD,DGACK,DGID,"","","",DGERR,.DGVAL)
Begin DoDot:2
+27 SET DGMSA=$$BLDSEG^DGPFHLUT("MSA",.DGVAL,.DGHL)
End DoDot:2
End DoDot:1
+28 QUIT DGMSA
+29 ;
MSAVAL(DGFLD,DGACK,DGID,DGTEXT,DGESN,DGDAT,DGERR,DGVAL) ;build MSA value array
+1 ;
+2 ; Input:
+3 ; DGFLD - (required) fields string
+4 ; DGACK - (required) MSA segment Acknowledgment code
+5 ; DGID - (required) Message Control ID
+6 ; DGTEXT - (optional) Text message
+7 ; DGESN - (optional) Expected sequence number
+8 ; DGDAT - (optional) Delayed acknowledgment type
+9 ; DGERR - (optional) Error condition
+10 ;
+11 ; Output:
+12 ; Function Value - 1 on success, 0 on failure
+13 ; DGVAL - MSA field array [SUB1:field, SUB2:repetition,
+14 ; SUB3:component, SUB4:sub-component]
+15 ;
+16 ;function value
NEW DGRSLT
+17 ;array of valid ACK codes
NEW DGACKS
+18 ;ACK code string
NEW DGCOD
+19 ;
+20 SET DGRSLT=0
+21 ;DG*5.3*1005 - DGID may be alphanumeric
+22 IF $GET(DGFLD)]""
IF $GET(DGACK)]""
IF $GET(DGID)'=""
Begin DoDot:1
+23 FOR DGCOD="AA","AE","AR","CA","CE","CR"
SET DGACKS(DGCOD)=""
+24 ; seq 1 Acknowledgment Code
+25 IF DGFLD[",1,"
SET DGVAL(1)=$SELECT($DATA(DGACKS(DGACK)):DGACK,1:"")
+26 ;required field
if (DGVAL(1)="")
QUIT
+27 ; seq 2 Message Control ID
+28 IF DGFLD[",2,"
SET DGVAL(2)=DGID
+29 ;required field
if (DGVAL(2)="")
QUIT
+30 ; seq 3 Text Message
+31 IF DGFLD[",3,"
SET DGVAL(3)=$$ENCHL7^DGPFHLUT($GET(DGTEXT))
+32 ; seq 4 Expected Sequence Number
+33 IF DGFLD[",4,"
SET DGVAL(4)=$GET(DGESN)
+34 ; seq 5 Delayed Acknowledgment Type
+35 IF DGFLD[",5,"
Begin DoDot:2
+36 SET DGDAT=$GET(DGDAT)
+37 SET DGVAL(5)=$SELECT(DGDAT="D":DGDAT,DGDAT="F":DGDAT,1:"")
+38 QUIT
End DoDot:2
+39 ; seq 6 Error Condition
+40 IF DGFLD[",6,"
Begin DoDot:2
+41 SET DGVAL(6,1,1)=$$ENCHL7^DGPFHLUT(DGERR)
+42 SET DGVAL(6,1,2)=$$ENCHL7^DGPFHLUT($$EZBLD^DIALOG(DGERR))
+43 SET DGVAL(6,1,3)="L"
+44 QUIT
End DoDot:2
+45 SET DGRSLT=1
End DoDot:1
+46 IF 'DGRSLT
KILL DGVAL
+47 QUIT DGRSLT
+48 ;
ERR(DGSEG,DGSEQ,DGPOS,DGCOD,DGFLD,DGHL) ;ERR segment API
+1 ;
+2 ; Input:
+3 ; DGSEG - (required) Segment ID
+4 ; DGSEQ - (required) Sequence
+5 ; DGPOS - (required) Field position
+6 ; DGCOD - (required) Error code
+7 ; DGFLD - (optional) List of comma-separated fields (sequence #'s)
+8 ; to include. Defaults to all required fields (1).
+9 ; DGHL - (required) HL7 Environment array
+10 ;
+11 ; Output:
+12 ; Function value - ERR segment on success, "" on failure
+13 ;
+14 NEW DGERR
+15 NEW DGVAL
+16 ;
+17 SET DGERR=""
+18 IF $GET(DGSEG)]""
IF +$GET(DGSEQ)
IF +$GET(DGPOS)
IF $GET(DGCOD)]""
IF $GET(DGHL("ECH"))]""
Begin DoDot:1
+19 ;validate field string
SET DGFLD=$$CKSTR^DGPFHLUT("1",DGFLD)
+20 SET DGFLD=","_DGFLD_","
+21 IF $$ERRVAL(DGFLD,DGSEG,DGSEQ,DGPOS,DGCOD,.DGVAL)
Begin DoDot:2
+22 SET DGERR=$$BLDSEG^DGPFHLUT("ERR",.DGVAL,.DGHL)
End DoDot:2
End DoDot:1
+23 QUIT DGERR
+24 ;
ERRVAL(DGFLD,DGSEG,DGSEQ,DGPOS,DGCOD,DGVAL) ;build ERR value array
+1 ;
+2 ; Input:
+3 ; DGFLD - (required) Field string
+4 ; DGSEG - (required) Segment ID
+5 ; DGSEQ - (required) Sequence
+6 ; DGPOS - (required) Field position
+7 ; DGCOD - (required) Error code
+8 ;
+9 ; Output:
+10 ; Function value - 1 on success, 0 on failure
+11 ; DGVAL - ERR field array [SUB1:field, SUB2:repetition,
+12 ; SUB3:component, SUB4:sub-component]
+13 NEW DGRSLT
+14 ;
+15 SET DGRSLT=0
+16 IF $GET(DGFLD)]""
IF $GET(DGSEG)]""
IF +$GET(DGSEQ)
IF +$GET(DGPOS)
IF $GET(DGCOD)]""
Begin DoDot:1
+17 IF DGFLD[",1,"
Begin DoDot:2
+18 SET DGVAL(1,1,1)=DGSEG
+19 SET DGVAL(1,1,2)=DGSEQ
+20 SET DGVAL(1,1,3)=DGPOS
+21 SET DGVAL(1,1,4,1)=DGCOD
+22 SET DGVAL(1,1,4,2)=$$EZBLD^DIALOG(DGCOD)
+23 SET DGVAL(1,1,4,3)="L"
End DoDot:2
+24 SET DGRSLT=1
End DoDot:1
+25 QUIT DGRSLT
+26 ;
BLDVA086(DGTBL) ;build error code/text array for table VA086
+1 ;
+2 ; Input:
+3 ; none
+4 ;
+5 ; Output:
+6 ; DGTBL - error code array subscripted by code containing error text
+7 ;
+8 NEW DGI
+9 NEW DGLINE
+10 NEW DGCOD
+11 NEW DGTXT
+12 NEW DGDESC
+13 ;
+14 FOR DGI=1:1
SET DGLINE=$TEXT(ERRTBL+DGI)
if DGLINE=""
QUIT
Begin DoDot:1
+15 SET DGCOD=$PIECE(DGLINE,";",3)
+16 SET DGTXT=$PIECE(DGLINE,";",4)
+17 SET DGDESC=$PIECE(DGLINE,";",5)
+18 SET DGTBL(DGCOD)=DGTXT
+19 SET DGTBL(DGCOD,"DESC")=DGDESC
End DoDot:1
+20 QUIT
+21 ;
ERRTBL ;VA086 Error Code Table;error code;error text
+1 ;;FE;Filer Error;An error occurred at the remote site when attempting to add, update or retrieve assignment data.
+2 ;;IF;Invalid Patient Record Flag;The transmitted Patient Record Flag is not defined at the remote site.
+3 ;;IID;Invalid Observation ID;The transmitted observation ID is not "N"arrative, "S"tatus or "C"omment.
+4 ;;IOR;Invalid Originating Site;The originating site of the transmission is not defined at the remote site.
+5 ;;IOW;Invalid Owner Site;The transmitted owning site is not defined at the remote site.
+6 ;;NM;No Match;No patient was found that correlates to the transmitted ICN, DOB and SSN.
+7 ;;UU;Unauthorized Update;The originating site of the transmission is not defined as the owning site of the assignment or an invalid action was transmitted (i.e. Reactivate an already active assignment).
