MAGT7SX ;WOIFO/MLH,PMK,NST - telepathology - create HL7 message to DPS - segment build - OBX ; 19 Jul 2013 3:00 PM
;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
OBXSEG(MSG,KEY,VALTYP,VALUE,DATETIME) ; FUNCTION - main entry point - create OBX key-value pairs
N PARAM ; parameter
N SEGELTS ; array for segment elements
N FLDSETID S FLDSETID=1 ; set ID field number
N FLDVALTYP S FLDVALTYP=2 ; value type field number
N FLDOBSTYP S FLDOBSTYP=3 ; observation type field number
N FLDVALUE S FLDVALUE=5 ; observation value field number
N FLDSTATUS S FLDSTATUS=11 ; observation status field number
N FLDDTTM S FLDDTTM=14 ; date/time of the observation
;
N ERRSTAT S ERRSTAT=0 ; error status - assume nothing to report
;
D Q:ERRSTAT ERRSTAT ; validate input
. F PARAM="KEY","VALTYP","VALUE" D Q:ERRSTAT
. . I '$D(@PARAM) S ERRSTAT="-1001`Undefined parameter "_PARAM
. . Q
. Q
D ; set up fields, check exit flag after each
. D SET^HLOAPI(.SEGELTS,"OBX",0) ; segment type
. D Q:ERRSTAT ; OBX-1-set ID
. . S SETID=$G(SETID("OBX"))+1,SETID("OBX")=SETID
. . D SET^HLOAPI(.SEGELTS,SETID,FLDSETID)
. . Q
. D Q:ERRSTAT ; OBX-2-value type
. . D SET^HLOAPI(.SEGELTS,VALTYP,FLDVALTYP)
. . Q
. D Q:ERRSTAT ; OBX-3-observation type
. . S KEY("TEXT")=KEY
. . D SETCE^HLOAPI4(.SEGELTS,.KEY,FLDOBSTYP)
. . Q
. D Q:ERRSTAT ; OBX-5-observation value
. . I (VALTYP="NM")!(VALTYP="ST") D Q ; number or string
. . . D SET^HLOAPI(.SEGELTS,$G(VALUE),FLDVALUE)
. . . Q
. . I VALTYP="CWE" D Q ; coded with exceptions
. . . D SETCE^HLOAPI4(.SEGELTS,.VALUE,FLDVALUE)
. . . Q
. . I VALTYP="DTM" D Q ; date/time
. . . D SETTS^HLOAPI4(.SEGELTS,VALUE,FLDVALUE)
. . . Q
. . Q
. D Q:ERRSTAT ; OBX-11-observation result status
. . D SET^HLOAPI(.SEGELTS,"O",FLDSTATUS)
. . Q
. D:$G(DATETIME) Q:ERRSTAT ;OBR-14-date/time of the observation
. . D SETTS^HLOAPI4(.SEGELTS,DATETIME,FLDDTTM)
. . Q
. Q
D:'ERRSTAT ; send the segment
. N ERRMSG
. I '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG) D Q
. . S ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
. . Q
. Q
;
Q ERRSTAT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGT7SX 3180 printed Nov 22, 2024@17:18:42 Page 2
MAGT7SX ;WOIFO/MLH,PMK,NST - telepathology - create HL7 message to DPS - segment build - OBX ; 19 Jul 2013 3:00 PM
+1 ;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
OBXSEG(MSG,KEY,VALTYP,VALUE,DATETIME) ; FUNCTION - main entry point - create OBX key-value pairs
+1 ; parameter
NEW PARAM
+2 ; array for segment elements
NEW SEGELTS
+3 ; set ID field number
NEW FLDSETID
SET FLDSETID=1
+4 ; value type field number
NEW FLDVALTYP
SET FLDVALTYP=2
+5 ; observation type field number
NEW FLDOBSTYP
SET FLDOBSTYP=3
+6 ; observation value field number
NEW FLDVALUE
SET FLDVALUE=5
+7 ; observation status field number
NEW FLDSTATUS
SET FLDSTATUS=11
+8 ; date/time of the observation
NEW FLDDTTM
SET FLDDTTM=14
+9 ;
+10 ; error status - assume nothing to report
NEW ERRSTAT
SET ERRSTAT=0
+11 ;
+12 ; validate input
Begin DoDot:1
+13 FOR PARAM="KEY","VALTYP","VALUE"
Begin DoDot:2
+14 IF '$DATA(@PARAM)
SET ERRSTAT="-1001`Undefined parameter "_PARAM
+15 QUIT
End DoDot:2
if ERRSTAT
QUIT
+16 QUIT
End DoDot:1
if ERRSTAT
QUIT ERRSTAT
+17 ; set up fields, check exit flag after each
Begin DoDot:1
+18 ; segment type
DO SET^HLOAPI(.SEGELTS,"OBX",0)
+19 ; OBX-1-set ID
Begin DoDot:2
+20 SET SETID=$GET(SETID("OBX"))+1
SET SETID("OBX")=SETID
+21 DO SET^HLOAPI(.SEGELTS,SETID,FLDSETID)
+22 QUIT
End DoDot:2
if ERRSTAT
QUIT
+23 ; OBX-2-value type
Begin DoDot:2
+24 DO SET^HLOAPI(.SEGELTS,VALTYP,FLDVALTYP)
+25 QUIT
End DoDot:2
if ERRSTAT
QUIT
+26 ; OBX-3-observation type
Begin DoDot:2
+27 SET KEY("TEXT")=KEY
+28 DO SETCE^HLOAPI4(.SEGELTS,.KEY,FLDOBSTYP)
+29 QUIT
End DoDot:2
if ERRSTAT
QUIT
+30 ; OBX-5-observation value
Begin DoDot:2
+31 ; number or string
IF (VALTYP="NM")!(VALTYP="ST")
Begin DoDot:3
+32 DO SET^HLOAPI(.SEGELTS,$GET(VALUE),FLDVALUE)
+33 QUIT
End DoDot:3
QUIT
+34 ; coded with exceptions
IF VALTYP="CWE"
Begin DoDot:3
+35 DO SETCE^HLOAPI4(.SEGELTS,.VALUE,FLDVALUE)
+36 QUIT
End DoDot:3
QUIT
+37 ; date/time
IF VALTYP="DTM"
Begin DoDot:3
+38 DO SETTS^HLOAPI4(.SEGELTS,VALUE,FLDVALUE)
+39 QUIT
End DoDot:3
QUIT
+40 QUIT
End DoDot:2
if ERRSTAT
QUIT
+41 ; OBX-11-observation result status
Begin DoDot:2
+42 DO SET^HLOAPI(.SEGELTS,"O",FLDSTATUS)
+43 QUIT
End DoDot:2
if ERRSTAT
QUIT
+44 ;OBR-14-date/time of the observation
if $GET(DATETIME)
Begin DoDot:2
+45 DO SETTS^HLOAPI4(.SEGELTS,DATETIME,FLDDTTM)
+46 QUIT
End DoDot:2
if ERRSTAT
QUIT
+47 QUIT
End DoDot:1
+48 ; send the segment
if 'ERRSTAT
Begin DoDot:1
+49 NEW ERRMSG
+50 IF '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG)
Begin DoDot:2
+51 SET ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
+52 QUIT
End DoDot:2
QUIT
+53 QUIT
End DoDot:1
+54 ;
+55 QUIT ERRSTAT