Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPFHLQ4

DGPFHLQ4.m

Go to the documentation of this file.
  1. DGPFHLQ4 ;ALB/RPM - PRF HL7 ORF PROCESSING ; 12/13/04
  1. ;;5.3;Registration;**425,650,951**;Aug 13, 1993;Build 135
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. PARSORF(DGWRK,DGHL,DGROOT,DGMSG) ;Parse ORF~R04 Message/Segments
  1. ;
  1. ; Input:
  1. ; DGWRK - Closed root work global reference
  1. ; DGHL - HL7 environment array
  1. ; DGROOT - Closed root ORF results array
  1. ;
  1. ; Output:
  1. ; DGROOT - array of ORF results
  1. ; OBRsetID,assigndt,"ACTION"
  1. ; OBRsetID,assigndt,"COMMENT",line#
  1. ; OBRsetID,"FLAG"
  1. ; OBRsetID,"NARR",line#
  1. ; OBRsetID,"OWNER"
  1. ; "ACKCODE" - acknowledgment code ("AA","AE","AR")
  1. ; "ICN" - patient's Integrated Control Number
  1. ; "MSGDTM" - message creation date/time in FileMan format
  1. ; "MSGID" -
  1. ; "QID" - query ID (DFN)
  1. ; "RCVFAC" - receiving facility
  1. ; "SNDFAC" - sending facility
  1. ;
  1. ; DGMSG - undefined on success, array of MailMan text on failure
  1. ;
  1. N DGFS ;field separator
  1. N DGCS ;component separator
  1. N DGRS ;repetition separator
  1. N DGSS ;sub-component separator
  1. N DGCURLIN ;current line
  1. ;
  1. S DGFS=DGHL("FS")
  1. S DGCS=$E(DGHL("ECH"),1)
  1. S DGRS=$E(DGHL("ECH"),2)
  1. S DGSS=$E(DGHL("ECH"),4)
  1. S HLECH=DGHL("ECH"),HLFS=DGHL("FS")
  1. S DGCURLIN=0
  1. ;
  1. ;loop through the message segments and retrieve the field data
  1. F D Q:'DGCURLIN
  1. . N DGSEG
  1. . S DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)
  1. . Q:'DGCURLIN
  1. . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,DGROOT,.DGMSG)")
  1. Q
  1. ;
  1. MSH(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
  1. ;
  1. ; Input:
  1. ; DGSEG - MSH segment field array
  1. ; DGCS - HL7 component separator
  1. ; DGRS - HL7 repetition separator
  1. ; DGSS - HL7 sub-component separator
  1. ;
  1. ; Output:
  1. ; DGORF - array of ORF results
  1. ; "SNDFAC" - sending facility
  1. ; "RCVFAC" - receiving facility
  1. ; "MSGDTM" - message creation date/time in FileMan format
  1. ; DGERR - undefined on success, error array on failure
  1. ;
  1. N DGARR
  1. D MSH^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
  1. I $D(DGARR) M @DGORF=DGARR
  1. Q
  1. ;
  1. MSA(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
  1. ;
  1. ; Input:
  1. ; DGSEG - MSH segment field array
  1. ; DGCS - HL7 component separator
  1. ; DGRS - HL7 repetition separator
  1. ; DGSS - HL7 sub-component separator
  1. ;
  1. ; Output:
  1. ; DGORF - array of ORF results
  1. ; "ACKCODE" - Acknowledgment code
  1. ; "MSGID" - Message Control ID of the message being ACK'ed
  1. ; DGERR - undefined on success, error array on failure
  1. ;
  1. N DGARR
  1. D MSA^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
  1. I $D(DGARR) M @DGORF=DGARR
  1. Q
  1. ;
  1. ERR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
  1. ;
  1. ; Input:
  1. ; DGSEG - MSH segment field array
  1. ; DGCS - HL7 component separator
  1. ; DGRS - HL7 repetition separator
  1. ; DGSS - HL7 sub-component separator
  1. ;
  1. ; Output:
  1. ; DGORF - array of ORF results
  1. ; DGERR - undefined on success, error array on failure
  1. ;
  1. N DGARR
  1. D ERR^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
  1. I $D(DGARR) M @DGORF=DGARR
  1. Q
  1. ;
  1. QRD(DGSEG,DGCS,DGRS,DGSS,DGQRY,DGERR) ;
  1. ;
  1. ; Input:
  1. ; DGSEG - MSH segment field array
  1. ; DGCS - HL7 component separator
  1. ; DGRS - HL7 repetition separator
  1. ; DGSS - HL7 sub-component separator
  1. ;
  1. ; Output:
  1. ; DGQRY("ICN") - Patient's Integrated Control Number
  1. ; DGQRY("QID") - Query ID
  1. ; DGERR - undefined on success, error array on failure
  1. ; format: DGERR(seg_id,sequence,fld_pos)=error code
  1. ;
  1. S @DGQRY@("QID")=$G(DGSEG(4))
  1. S @DGQRY@("ICN")=+$P($G(DGSEG(8)),DGCS,1)
  1. Q
  1. ;
  1. OBR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
  1. ;
  1. ; Input:
  1. ; DGSEG - OBR segment field array
  1. ; DGCS - HL7 component separator
  1. ; DGRS - HL7 repetition separator
  1. ; DGSS - HL7 sub-component separator
  1. ;
  1. ; Output:
  1. ; DGORF(setid,"FLAG") - FLAG NAME (.02) field, file #26.13
  1. ; DGORF(setid,"OWNER") - OWNER SITE (.04) field, file #26.13
  1. ; DGORF(setid,"ORIGSITE") - ORIGINATING SITE (.05) field, file #26.13
  1. ; DGORF("SETID") - OBR segment Set ID
  1. ; DGERR - undefined on success, error array on failure
  1. ; format: DGERR(seg_id,sequence,fld_pos)=error code
  1. N DGSETID ;OBR segment Set ID
  1. N PRFFLG ; ien of received PRF flag in file 26.15
  1. ;
  1. S (@DGORF@("SETID"),DGSETID)=+$G(DGSEG(1))
  1. I DGSETID>0 D
  1. .S PRFFLG=+$$FIND1^DIC(26.15,,"X",$$DECHL7^DGPFHLUT($P($G(DGSEG(4)),DGCS,2)))
  1. .I 'PRFFLG S DGSTAT="RJ",DGERR($O(DGERR(""),-1)+1)=261120 Q ; bail out with "Unable to file" error
  1. .S @DGORF@(DGSETID,"FLAG")=PRFFLG_";DGPF(26.15,"
  1. .S @DGORF@(DGSETID,"OWNER")=$$IEN^XUAF4($G(DGSEG(20)))
  1. .S @DGORF@(DGSETID,"ORIGSITE")=$$IEN^XUAF4($G(DGSEG(21)))
  1. .Q
  1. Q
  1. ;
  1. OBX(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
  1. ;
  1. ; Input:
  1. ; DGSEG - OBX segment field array
  1. ; DGCS - HL7 component separator
  1. ; DGRS - HL7 repetition separator
  1. ; DGSS - HL7 sub-component separator
  1. ;
  1. ; Output:
  1. ; DGORF(setid,"NARR",line) - ASSIGNMENT NARRATIVE (1) field,
  1. ; file #26.13
  1. ; DGORF(setid,assigndt,"ACTION") - ACTION (.03) field,
  1. ; file #26.14
  1. ; DGORF(setid,assigndt,"COMMENT",line) - HISTORY COMMENTS (1) field,
  1. ; file #26.14
  1. ; DGERR - undefined on success, error array on failure
  1. ; format: DGERR(seg_id,sequence,fld_pos)=error code
  1. ;
  1. N DGADT ;assignment date
  1. N DGI
  1. N DGLINE ;text line counter
  1. N DGRSLT
  1. N DGSETID ;OBR segment Set ID
  1. N DGRSLT,DBRSACT,DBRSDT,DBRSNUM,DBRSOTH,DBRSSITE
  1. ;
  1. S DGSETID=+$G(@DGORF@("SETID"))
  1. Q:(DGSETID'>0)
  1. ; Narrative Observation Identifier
  1. I $P(DGSEG(3),DGCS,1)="N" D
  1. .S DGLINE=$O(@DGORF@(DGSETID,"NARR",""),-1)
  1. .F DGI=1:1:$L(DGSEG(5),DGRS) S @DGORF@(DGSETID,"NARR",DGLINE+DGI,0)=$$DECHL7^DGPFHLUT($P(DGSEG(5),DGRS,DGI))
  1. .Q
  1. ; Status Observation Identifier
  1. I $P(DGSEG(3),DGCS,1)="S" D
  1. .S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")
  1. .Q:(+DGADT'>0)
  1. .D CHK^DIE(26.14,.03,,$$DECHL7^DGPFHLUT(DGSEG(5)),.DGRSLT) S @DGORF@(DGSETID,DGADT,"ACTION")=+DGRSLT
  1. .Q
  1. ; Comment Observation Identifier
  1. I $P(DGSEG(3),DGCS,1)="C" D
  1. .S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")
  1. .Q:(+DGADT'>0)
  1. .S DGLINE=$O(@DGORF@(DGSETID,DGADT,"COMMENT",""),-1)
  1. .F DGI=1:1:$L(DGSEG(5),DGRS) D
  1. ..S @DGORF@(DGSETID,DGADT,"COMMENT",DGLINE+DGI,0)=$$DECHL7^DGPFHLUT($P(DGSEG(5),DGRS,DGI))
  1. ..Q
  1. .S @DGORF@(DGSETID,DGADT,"ORIGFAC")=$$IEN^XUAF4($P($G(DGSEG(23)),DGCS,3))
  1. .Q
  1. ; DBRS Observation Identifier
  1. I $P(DGSEG(3),DGCS,1)="D" D
  1. .S DBRSACT=$S($P(DGSEG(3),DGCS,2)="DBRS-Delete":"D",1:"U") ; "U" = add/update, "D" = delete
  1. .S DBRSNUM=$$DECHL7^DGPFHLUT($P(DGSEG(5),DGRS,1)) Q:DBRSNUM="" ; DBRS #
  1. .S DBRSOTH=$$DECHL7^DGPFHLUT($P(DGSEG(5),DGRS,2)) ; DBRS OTHER
  1. .S DBRSDT=+$$HL7TFM^XLFDT(DGSEG(14),"L") ; DBRS date
  1. .S DBRSSITE=$$IEN^XUAF4($P($G(DGSEG(23)),DGCS,3)) ; DBRS creating site
  1. .S @DGORF@(DGSETID,"DBRS",DBRSNUM,"ACTION")=DBRSACT
  1. .S @DGORF@(DGSETID,"DBRS",DBRSNUM,"OTHER")=DBRSOTH
  1. .S @DGORF@(DGSETID,"DBRS",DBRSNUM,"DATE")=DBRSDT
  1. .S @DGORF@(DGSETID,"DBRS",DBRSNUM,"SITE")=$S(DBRSSITE>0:DBRSSITE,1:"")
  1. .Q
  1. Q