DGPFHLQ4 ;ALB/RPM - PRF HL7 ORF PROCESSING ; 12/13/04
;;5.3;Registration;**425,650,1015**;Aug 13, 1993;Build 21
;
PARSORF(DGWRK,DGHL,DGROOT,DGMSG) ;Parse ORF~R04 Message/Segments
;
; Input:
; DGWRK - Closed root work global reference
; DGHL - HL7 environment array
; DGROOT - Closed root ORF results array
;
; Output:
; DGROOT - array of ORF results
; OBRsetID,assigndt,"ACTION"
; OBRsetID,assigndt,"COMMENT",line#
; OBRsetID,"FLAG"
; OBRsetID,"NARR",line#
; OBRsetID,"OWNER"
; "ACKCODE" - acknowledgment code ("AA","AE","AR")
; "ICN" - patient's Integrated Control Number
; "MSGDTM" - message creation date/time in FileMan format
; "MSGID" -
; "QID" - query ID (DFN)
; "RCVFAC" - receiving facility
; "SNDFAC" - sending facility
;
; DGMSG - undefined on success, array of MailMan text on failure
;
N DGFS ;field separator
N DGCS ;component separator
N DGRS ;repitition separator
N DGSS ;sub-component separator
N DGCURLIN ;current line
;
S DGFS=DGHL("FS")
S DGCS=$E(DGHL("ECH"),1)
S DGRS=$E(DGHL("ECH"),2)
S DGSS=$E(DGHL("ECH"),4)
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,DGROOT,.DGMSG)")
Q
;
MSH(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
;
; Input:
; DGSEG - MSH segment field array
; DGCS - HL7 component separator
; DGRS - HL7 repetition separator
; DGSS - HL7 sub-component separator
;
; Output:
; DGORF - array of ORF results
; "SNDFAC" - sending facility
; "RCVFAC" - receiving facility
; "MSGDTM" - message creation date/time in FileMan format
; DGERR - undefined on success, error array on failure
;
N DGARR
D MSH^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
I $D(DGARR) M @DGORF=DGARR
Q
;
MSA(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
;
; Input:
; DGSEG - MSH segment field array
; DGCS - HL7 component separator
; DGRS - HL7 repetition separator
; DGSS - HL7 sub-component separator
;
; Output:
; DGORF - array of ORF results
; "ACKCODE" - Acknowledgment code
; "MSGID" - Message Control ID of the message being ACK'ed
; DGERR - undefined on success, error array on failure
;
N DGARR
D MSA^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
I $D(DGARR) M @DGORF=DGARR
Q
;
ERR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
;
; Input:
; DGSEG - MSH segment field array
; DGCS - HL7 component separator
; DGRS - HL7 repetition separator
; DGSS - HL7 sub-component separator
;
; Output:
; DGORF - array of ORF results
; DGERR - undefined on success, error array on failure
;
N DGARR
D ERR^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
I $D(DGARR) M @DGORF=DGARR
Q
;
QRD(DGSEG,DGCS,DGRS,DGSS,DGQRY,DGERR) ;
;
; Input:
; DGSEG - MSH segment field array
; DGCS - HL7 component separator
; DGRS - HL7 repetition separator
; DGSS - HL7 sub-component separator
;
; Output:
; DGQRY("ICN") - Patient's Integrated Control Number
; DGQRY("QID") - Query ID
; DGERR - undefined on success, error array on failure
; format: DGERR(seg_id,sequence,fld_pos)=error code
;
S @DGQRY@("QID")=$G(DGSEG(4))
S @DGQRY@("ICN")=+$P($G(DGSEG(8)),DGCS,1)
Q
;
OBR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
;
; Input:
; DGSEG - OBR segment field array
; DGCS - HL7 component separator
; DGRS - HL7 repetition separator
; DGSS - HL7 sub-component separator
;
; Output:
; DGORF(setid,"FLAG") - FLAG NAME (.02) field, file #26.13
; DGORF(setid,"OWNER") - OWNER SITE (.04) field, file #26.13
; DGORF(setid,"ORIGSITE") - ORIGINATING SITE (.05) field, file #26.13
; DGORF("SETID") - OBR segment Set ID
; DGERR - undefined on success, error array on failure
; format: DGERR(seg_id,sequence,fld_pos)=error code
N DGSETID ;OBR segment Set ID
;
S (@DGORF@("SETID"),DGSETID)=+$G(DGSEG(1))
I DGSETID>0 D
. S @DGORF@(DGSETID,"FLAG")=$P($G(DGSEG(4)),DGCS,1)_";DGPF(26.15,"
. S @DGORF@(DGSETID,"OWNER")=$$IEN^XUAF4($G(DGSEG(20)))
. S @DGORF@(DGSETID,"ORIGSITE")=$$IEN^XUAF4($G(DGSEG(21)))
Q
;
OBX(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
;
; Input:
; DGSEG - OBX segment field array
; DGCS - HL7 component separator
; DGRS - HL7 repetition separator
; DGSS - HL7 sub-component separator
;
; Output:
; DGORF(setid,"NARR",line) - ASSIGNMENT NARRATIVE (1) field,
; file #26.13
; DGORF(setid,assigndt,"ACTION") - ACTION (.03) field,
; file #26.14
; DGORF(setid,assigndt,"COMMENT",line) - HISTORY COMMENTS (1) field,
; file #26.14
; DGERR - undefined on success, error array on failure
; format: DGERR(seg_id,sequence,fld_pos)=error code
;
N DGADT ;assignment date
N DGI
N DGLINE ;text line counter
N DGRSLT
N DGSETID ;OBR segment Set ID
;
S DGSETID=+$G(@DGORF@("SETID"))
Q:(DGSETID'>0)
;
; Narrative Observation Identifier
I $P(DGSEG(3),DGCS,1)="N" D
. S DGLINE=$O(@DGORF@(DGSETID,"NARR",""),-1)
. F DGI=1:1:$L(DGSEG(5),DGRS) D
. . S @DGORF@(DGSETID,"NARR",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI)
;
; Status Observation Identifier
I $P(DGSEG(3),DGCS,1)="S" D
. S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")
. Q:(+DGADT'>0)
. D CHK^DIE(26.14,.03,,DGSEG(5),.DGRSLT)
. S @DGORF@(DGSETID,DGADT,"ACTION")=+DGRSLT
;
; Comment Observation Identifier
I $P(DGSEG(3),DGCS,1)="C" D
. S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")
. Q:(+DGADT'>0)
. S DGLINE=$O(@DGORF@(DGSETID,DGADT,"COMMENT",""),-1)
. F DGI=1:1:$L(DGSEG(5),DGRS) D
. . S @DGORF@(DGSETID,DGADT,"COMMENT",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI)
Q
DGPFHLQ4 ;ALB/RPM - PRF HL7 ORF PROCESSING ; 12/13/04
+1 ;;5.3;Registration;**425,650,1015**;Aug 13, 1993;Build 21
+2 ;
PARSORF(DGWRK,DGHL,DGROOT,DGMSG) ;Parse ORF~R04 Message/Segments
+1 ;
+2 ; Input:
+3 ; DGWRK - Closed root work global reference
+4 ; DGHL - HL7 environment array
+5 ; DGROOT - Closed root ORF results array
+6 ;
+7 ; Output:
+8 ; DGROOT - array of ORF results
+9 ; OBRsetID,assigndt,"ACTION"
+10 ; OBRsetID,assigndt,"COMMENT",line#
+11 ; OBRsetID,"FLAG"
+12 ; OBRsetID,"NARR",line#
+13 ; OBRsetID,"OWNER"
+14 ; "ACKCODE" - acknowledgment code ("AA","AE","AR")
+15 ; "ICN" - patient's Integrated Control Number
+16 ; "MSGDTM" - message creation date/time in FileMan format
+17 ; "MSGID" -
+18 ; "QID" - query ID (DFN)
+19 ; "RCVFAC" - receiving facility
+20 ; "SNDFAC" - sending facility
+21 ;
+22 ; DGMSG - undefined on success, array of MailMan text on failure
+23 ;
+24 ;field separator
NEW DGFS
+25 ;component separator
NEW DGCS
+26 ;repitition separator
NEW DGRS
+27 ;sub-component separator
NEW DGSS
+28 ;current line
NEW DGCURLIN
+29 ;
+30 SET DGFS=DGHL("FS")
+31 SET DGCS=$EXTRACT(DGHL("ECH"),1)
+32 SET DGRS=$EXTRACT(DGHL("ECH"),2)
+33 SET DGSS=$EXTRACT(DGHL("ECH"),4)
+34 SET DGCURLIN=0
+35 ;
+36 ;loop through the message segments and retrieve the field data
+37 FOR
Begin DoDot:1
+38 NEW DGSEG
+39 SET DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)
+40 IF 'DGCURLIN
QUIT
+41 DO @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,DGROOT,.DGMSG)")
End DoDot:1
IF 'DGCURLIN
QUIT
+42 QUIT
+43 ;
MSH(DGSEG,DGCS,DGRS,DGSS,DGORF,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 ; DGORF - array of ORF 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 NEW DGARR
+16 DO MSH^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
+17 IF $DATA(DGARR)
MERGE @DGORF=DGARR
+18 QUIT
+19 ;
MSA(DGSEG,DGCS,DGRS,DGSS,DGORF,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 ; DGORF - array of ORF 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 DGARR
+15 DO MSA^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
+16 IF $DATA(DGARR)
MERGE @DGORF=DGARR
+17 QUIT
+18 ;
ERR(DGSEG,DGCS,DGRS,DGSS,DGORF,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 ; DGORF - array of ORF results
+10 ; DGERR - undefined on success, error array on failure
+11 ;
+12 NEW DGARR
+13 DO ERR^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
+14 IF $DATA(DGARR)
MERGE @DGORF=DGARR
+15 QUIT
+16 ;
QRD(DGSEG,DGCS,DGRS,DGSS,DGQRY,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 ; DGQRY("ICN") - Patient's Integrated Control Number
+10 ; DGQRY("QID") - Query ID
+11 ; DGERR - undefined on success, error array on failure
+12 ; format: DGERR(seg_id,sequence,fld_pos)=error code
+13 ;
+14 SET @DGQRY@("QID")=$GET(DGSEG(4))
+15 SET @DGQRY@("ICN")=+$PIECE($GET(DGSEG(8)),DGCS,1)
+16 QUIT
+17 ;
OBR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
+1 ;
+2 ; Input:
+3 ; DGSEG - OBR segment field array
+4 ; DGCS - HL7 component separator
+5 ; DGRS - HL7 repetition separator
+6 ; DGSS - HL7 sub-component separator
+7 ;
+8 ; Output:
+9 ; DGORF(setid,"FLAG") - FLAG NAME (.02) field, file #26.13
+10 ; DGORF(setid,"OWNER") - OWNER SITE (.04) field, file #26.13
+11 ; DGORF(setid,"ORIGSITE") - ORIGINATING SITE (.05) field, file #26.13
+12 ; DGORF("SETID") - OBR segment Set ID
+13 ; DGERR - undefined on success, error array on failure
+14 ; format: DGERR(seg_id,sequence,fld_pos)=error code
+15 ;OBR segment Set ID
NEW DGSETID
+16 ;
+17 SET (@DGORF@("SETID"),DGSETID)=+$GET(DGSEG(1))
+18 IF DGSETID>0
Begin DoDot:1
+19 SET @DGORF@(DGSETID,"FLAG")=$PIECE($GET(DGSEG(4)),DGCS,1)_";DGPF(26.15,"
+20 SET @DGORF@(DGSETID,"OWNER")=$$IEN^XUAF4($GET(DGSEG(20)))
+21 SET @DGORF@(DGSETID,"ORIGSITE")=$$IEN^XUAF4($GET(DGSEG(21)))
End DoDot:1
+22 QUIT
+23 ;
OBX(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
+1 ;
+2 ; Input:
+3 ; DGSEG - OBX segment field array
+4 ; DGCS - HL7 component separator
+5 ; DGRS - HL7 repetition separator
+6 ; DGSS - HL7 sub-component separator
+7 ;
+8 ; Output:
+9 ; DGORF(setid,"NARR",line) - ASSIGNMENT NARRATIVE (1) field,
+10 ; file #26.13
+11 ; DGORF(setid,assigndt,"ACTION") - ACTION (.03) field,
+12 ; file #26.14
+13 ; DGORF(setid,assigndt,"COMMENT",line) - HISTORY COMMENTS (1) field,
+14 ; file #26.14
+15 ; DGERR - undefined on success, error array on failure
+16 ; format: DGERR(seg_id,sequence,fld_pos)=error code
+17 ;
+18 ;assignment date
NEW DGADT
+19 NEW DGI
+20 ;text line counter
NEW DGLINE
+21 NEW DGRSLT
+22 ;OBR segment Set ID
NEW DGSETID
+23 ;
+24 SET DGSETID=+$GET(@DGORF@("SETID"))
+25 IF (DGSETID'>0)
QUIT
+26 ;
+27 ; Narrative Observation Identifier
+28 IF $PIECE(DGSEG(3),DGCS,1)="N"
Begin DoDot:1
+29 SET DGLINE=$ORDER(@DGORF@(DGSETID,"NARR",""),-1)
+30 FOR DGI=1:1:$LENGTH(DGSEG(5),DGRS)
Begin DoDot:2
+31 SET @DGORF@(DGSETID,"NARR",DGLINE+DGI,0)=$PIECE(DGSEG(5),DGRS,DGI)
End DoDot:2
End DoDot:1
+32 ;
+33 ; Status Observation Identifier
+34 IF $PIECE(DGSEG(3),DGCS,1)="S"
Begin DoDot:1
+35 SET DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")
+36 IF (+DGADT'>0)
QUIT
+37 DO CHK^DIE(26.14,.03,,DGSEG(5),.DGRSLT)
+38 SET @DGORF@(DGSETID,DGADT,"ACTION")=+DGRSLT
End DoDot:1
+39 ;
+40 ; Comment Observation Identifier
+41 IF $PIECE(DGSEG(3),DGCS,1)="C"
Begin DoDot:1
+42 SET DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")
+43 IF (+DGADT'>0)
QUIT
+44 SET DGLINE=$ORDER(@DGORF@(DGSETID,DGADT,"COMMENT",""),-1)
+45 FOR DGI=1:1:$LENGTH(DGSEG(5),DGRS)
Begin DoDot:2
+46 SET @DGORF@(DGSETID,DGADT,"COMMENT",DGLINE+DGI,0)=$PIECE(DGSEG(5),DGRS,DGI)
End DoDot:2
End DoDot:1
+47 QUIT
