- 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 Feb 19, 2025@00:13:58 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).