MAGDHLSO ;WOIFO/MLH - IHE-based ADT interface for PACS - OBX segments ; 12 Jun 2006 3:05 PM
;;3.0;IMAGING;**49**;Mar 19, 2002;Build 2033;Apr 07, 2011
;; 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
;
OBXADT ; GOTO entry point from MAGDHLS - patient height/weight - NOT FOR DIRECT ENTRY
; input: XDFN internal entry number of the patient on global ^DPT
; XYMSG name of array to which to add message elts
; output: @XYMSG input array plus new subtree containing EVN elts
; function return 0 (success) always
;
N DFN ; ----- internal entry number on ^DPT
N VTYPIX ; -- vitals type index on ^UTILITY($J)
N RDTIX ; --- reverse date/time index on ^UTILITY($J)
N SEGIX ; --- segment index on @XYMSG
N SETID ; --- set ID element for HL7 segments
N VDTM ; ---- date/time of vitals data
N VIEN ; ---- vitals IEN for measurement
N VDTA ; ---- vitals data
N UNITS ; --- labels for units of measure
;
K ^UTILITY($J,"GMRVD") ; refresh the return array
S DFN=XDFN,GMRVSTR="HT;WT"
S GMRVSTR(0)="^^1" ; one occurrence each of height and weight
D EN1^GMRVUT0
S SETID=0
S UNITS("HT")="HEIGHT|m|meter"
S UNITS("WT")="WEIGHT|kg|kilogram"
;
F VTYPIX="HT","WT" I $D(^UTILITY($J,"GMRVD",VTYPIX)) D
. S RDTIX=$O(^UTILITY($J,"GMRVD",VTYPIX,0))
. I RDTIX D
. . S VDTM=9999999-RDTIX
. . S VIEN=$O(^UTILITY($J,"GMRVD",VTYPIX,RDTIX,0))
. . ; if a measurement exists, populate the message array
. . I VIEN D OBXAHW(UNITS(VTYPIX))
. . Q
. Q
Q 0
;
OBXAHW(XUNITS) ; SUBROUTINE - called by OBXADT - NOT FOR DIRECT ENTRY
; if a measurement exists, populate the message array
; INPUT: XUNITS labels for units of measure
; format: MEASUREMENT|abbrev|unit
;
S SEGIX=$O(@XYMSG@(" "),-1)+1
S @XYMSG@(SEGIX,0)="OBX"
S SETID=SETID+1,@XYMSG@(SEGIX,1,1,1,1)=SETID
S @XYMSG@(SEGIX,2,1,1,1)="ST"
S @XYMSG@(SEGIX,3,1,2,1)=$P(XUNITS,"|",1)
S @XYMSG@(SEGIX,5,1,1,1)=$J($P($G(^UTILITY($J,"GMRVD",VTYPIX,RDTIX,VIEN)),U,13)/$S($P(XUNITS,"|",2)="m":100,1:1),0,2)
S @XYMSG@(SEGIX,6,1,1,1)=$P(XUNITS,"|",2)
S @XYMSG@(SEGIX,6,1,2,1)=$P(XUNITS,"|",3)
S @XYMSG@(SEGIX,6,1,3,1)="ISO+"
S @XYMSG@(SEGIX,11,1,1,1)="F"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDHLSO 3196 printed Dec 13, 2024@02:00 Page 2
MAGDHLSO ;WOIFO/MLH - IHE-based ADT interface for PACS - OBX segments ; 12 Jun 2006 3:05 PM
+1 ;;3.0;IMAGING;**49**;Mar 19, 2002;Build 2033;Apr 07, 2011
+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 ;
OBXADT ; GOTO entry point from MAGDHLS - patient height/weight - NOT FOR DIRECT ENTRY
+1 ; input: XDFN internal entry number of the patient on global ^DPT
+2 ; XYMSG name of array to which to add message elts
+3 ; output: @XYMSG input array plus new subtree containing EVN elts
+4 ; function return 0 (success) always
+5 ;
+6 ; ----- internal entry number on ^DPT
NEW DFN
+7 ; -- vitals type index on ^UTILITY($J)
NEW VTYPIX
+8 ; --- reverse date/time index on ^UTILITY($J)
NEW RDTIX
+9 ; --- segment index on @XYMSG
NEW SEGIX
+10 ; --- set ID element for HL7 segments
NEW SETID
+11 ; ---- date/time of vitals data
NEW VDTM
+12 ; ---- vitals IEN for measurement
NEW VIEN
+13 ; ---- vitals data
NEW VDTA
+14 ; --- labels for units of measure
NEW UNITS
+15 ;
+16 ; refresh the return array
KILL ^UTILITY($JOB,"GMRVD")
+17 SET DFN=XDFN
SET GMRVSTR="HT;WT"
+18 ; one occurrence each of height and weight
SET GMRVSTR(0)="^^1"
+19 DO EN1^GMRVUT0
+20 SET SETID=0
+21 SET UNITS("HT")="HEIGHT|m|meter"
+22 SET UNITS("WT")="WEIGHT|kg|kilogram"
+23 ;
+24 FOR VTYPIX="HT","WT"
IF $DATA(^UTILITY($JOB,"GMRVD",VTYPIX))
Begin DoDot:1
+25 SET RDTIX=$ORDER(^UTILITY($JOB,"GMRVD",VTYPIX,0))
+26 IF RDTIX
Begin DoDot:2
+27 SET VDTM=9999999-RDTIX
+28 SET VIEN=$ORDER(^UTILITY($JOB,"GMRVD",VTYPIX,RDTIX,0))
+29 ; if a measurement exists, populate the message array
+30 IF VIEN
DO OBXAHW(UNITS(VTYPIX))
+31 QUIT
End DoDot:2
+32 QUIT
End DoDot:1
+33 QUIT 0
+34 ;
OBXAHW(XUNITS) ; SUBROUTINE - called by OBXADT - NOT FOR DIRECT ENTRY
+1 ; if a measurement exists, populate the message array
+2 ; INPUT: XUNITS labels for units of measure
+3 ; format: MEASUREMENT|abbrev|unit
+4 ;
+5 SET SEGIX=$ORDER(@XYMSG@(" "),-1)+1
+6 SET @XYMSG@(SEGIX,0)="OBX"
+7 SET SETID=SETID+1
SET @XYMSG@(SEGIX,1,1,1,1)=SETID
+8 SET @XYMSG@(SEGIX,2,1,1,1)="ST"
+9 SET @XYMSG@(SEGIX,3,1,2,1)=$PIECE(XUNITS,"|",1)
+10 SET @XYMSG@(SEGIX,5,1,1,1)=$JUSTIFY($PIECE($GET(^UTILITY($JOB,"GMRVD",VTYPIX,RDTIX,VIEN)),U,13)/$SELECT($PIECE(XUNITS,"|",2)="m":100,1:1),0,2)
+11 SET @XYMSG@(SEGIX,6,1,1,1)=$PIECE(XUNITS,"|",2)
+12 SET @XYMSG@(SEGIX,6,1,2,1)=$PIECE(XUNITS,"|",3)
+13 SET @XYMSG@(SEGIX,6,1,3,1)="ISO+"
+14 SET @XYMSG@(SEGIX,11,1,1,1)="F"
+15 QUIT
