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,1015**;Aug 13, 1993;Build 21
  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      ;repitition 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 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.  ;
  1.  S (@DGORF@("SETID"),DGSETID)=+$G(DGSEG(1))
  1.  I DGSETID>0 D
  1.  . S @DGORF@(DGSETID,"FLAG")=$P($G(DGSEG(4)),DGCS,1)_";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.  ;
  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.  ;
  1.  S DGSETID=+$G(@DGORF@("SETID"))
  1.  Q:(DGSETID'>0)
  1.  ;
  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) D
  1.  . . S @DGORF@(DGSETID,"NARR",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI)
  1.  ;
  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,,DGSEG(5),.DGRSLT)
  1.  . S @DGORF@(DGSETID,DGADT,"ACTION")=+DGRSLT
  1.  ;
  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)=$P(DGSEG(5),DGRS,DGI)
  1.  Q