- VAFHLOBX ;ALB/SCK-Create generic OBX segment ; 22 Jan 2002 10:27 AM
- ;;5.3;Registration;**189,149,494**;Aug 13, 1993
- ;
- ; This routine returns the HL7 defined OBX segment
- ;
- EN(VAFARRY,VAFNUM,VAFSTR) ; Returns OBX segment
- ;
- ; Input - VAFARRY Array of data fields from calling application for building into OBX segment fields
- ; Data to be included is expected to be in the following format:
- ; VAFARRY(Field Number) = Field Value
- ;
- ; - Dates to be in internal FM format
- ; - Provider name to be in external format
- ; VAFNUM (optional) as sequential number for SET ID (default=1)
- ; VAFSTR (Optional) as string of fields requested separated by commas. Build all if not passed in.
- ;
- ; **** Assumes all HL7 variables are defined ****
- ;
- ; Output - String of data forming the OBX segment
- ;
- N VAFY,X1
- ;
- ;; Check initial values, set defaults as needed
- ;; Quit on empty array
- I ($O(VAFARRY(""))="") S VAFY=1 G QUIT
- S VAFNUM=$S($G(VAFNUM):VAFNUM,1:1)
- I $G(VAFSTR)']"" S VAFSTR="2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17"
- ;
- ;; Initialize the output string
- S $P(VAFY,HLFS,17)="",VAFSTR=","_VAFSTR_","
- S $P(VAFY,HLFS,1)=VAFNUM ; Required field
- ;
- ;;Check required OBX fields
- I $G(VAFARRY(11))=""!($L($G(VAFARRY(11)))>1) S VAFY=1 G QUIT ; obs result status
- I $G(VAFARRY(3))="" S VAFY=1 G QUIT ; obs ID
- I $G(VAFARRY(11))'="X",$G(VAFARRY(2))']"" S VAFY=1 G QUIT ; Value Type
- ;
- ;;Build segment fields
- I VAFSTR[",2," S $P(VAFY,HLFS,2)=$S($G(VAFARRY(2))]"":VAFARRY(2),1:HLQ) ; Value Type
- I VAFSTR[",3," S $P(VAFY,HLFS,3)=$G(VAFARRY(3)) ; Observation Identifier
- I VAFSTR[",4," S $P(VAFY,HLFS,4)=$S($G(VAFARRY(4))]"":VAFARRY(4),1:HLQ) ; Observation Sub ID
- I VAFSTR[",5," S $P(VAFY,HLFS,5)=$S($G(VAFARRY(5))]"":VAFARRY(5),1:HLQ) ; Observation Value
- I VAFSTR[",6," S $P(VAFY,HLFS,6)=$S($G(VAFARRY(6))]"":VAFARRY(6),1:HLQ) ; Units
- I VAFSTR[",7," S $P(VAFY,HLFS,7)=$S($G(VAFARRY(7))]"":VAFARRY(7),1:HLQ) ; Reference Range
- I VAFSTR[",8," S $P(VAFY,HLFS,8)=$S($G(VAFARRY(8))]"":VAFARRY(8),1:HLQ) ; Abnormal flags
- I VAFSTR[",9," S $P(VAFY,HLFS,9)=$S($G(VAFARRY(9))]"":VAFARRY(9),1:HLQ) ; Probability
- I VAFSTR[",10," S $P(VAFY,HLFS,10)=$S($G(VAFARRY(10))]"":VAFARRY(10),1:HLQ) ; Nature of Abnormal Test
- I VAFSTR[",11," S $P(VAFY,HLFS,11)=$G(VAFARRY(11)) ; Observation Result Status
- I VAFSTR[",12," S X1=$$HLDATE^HLFNC($G(VAFARRY(12))),$P(VAFY,HLFS,12)=$S(X1]"":X1,1:HLQ) ; Date of last OBS Normal Values
- I VAFSTR[",13," S $P(VAFY,HLFS,13)=$S($G(VAFARRY(13))]"":VAFARRY(13),1:HLQ) ; User Defined Access Checks
- I VAFSTR[",14," S X1=$$HLDATE^HLFNC($G(VAFARRY(14))),$P(VAFY,HLFS,14)=$S(X1]"":X1,1:HLQ) ; DT of Observation
- I VAFSTR[",15," S $P(VAFY,HLFS,15)=$S($G(VAFARRY(15))]"":VAFARRY(15),1:HLQ) ; Producer's ID
- I VAFSTR[",16," D S $P(VAFY,HLFS,16)=$S(X1]"":X1,1:HLQ)
- . S DIC="^VA(200,",DIC(0)="MZO",X="`"_$G(VAFARRY(16)) D ^DIC
- . I VAFARRY(16)]"",Y>0 D
- .. N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=VAFARRY(16),DGNAME("FIELD")=.01
- .. S X1=$$HLNAME^XLFNAME(.DGNAME,"S",$E($G(HLECH))),X1=$G(VAFARRY(16))_$E(HLECH,1)_X1
- . E D
- .. S X1=""
- ;
- I VAFSTR[",17," S $P(VAFY,HLFS,17)=$S($G(VAFARRY(17))]"":VAFARRY(17),1:HLQ) ; OBS. Method
- ;
- ;
- QUIT Q "OBX"_HLFS_$G(VAFY)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLOBX 3320 printed Mar 13, 2025@22:07:45 Page 2
- VAFHLOBX ;ALB/SCK-Create generic OBX segment ; 22 Jan 2002 10:27 AM
- +1 ;;5.3;Registration;**189,149,494**;Aug 13, 1993
- +2 ;
- +3 ; This routine returns the HL7 defined OBX segment
- +4 ;
- EN(VAFARRY,VAFNUM,VAFSTR) ; Returns OBX segment
- +1 ;
- +2 ; Input - VAFARRY Array of data fields from calling application for building into OBX segment fields
- +3 ; Data to be included is expected to be in the following format:
- +4 ; VAFARRY(Field Number) = Field Value
- +5 ;
- +6 ; - Dates to be in internal FM format
- +7 ; - Provider name to be in external format
- +8 ; VAFNUM (optional) as sequential number for SET ID (default=1)
- +9 ; VAFSTR (Optional) as string of fields requested separated by commas. Build all if not passed in.
- +10 ;
- +11 ; **** Assumes all HL7 variables are defined ****
- +12 ;
- +13 ; Output - String of data forming the OBX segment
- +14 ;
- +15 NEW VAFY,X1
- +16 ;
- +17 ;; Check initial values, set defaults as needed
- +18 ;; Quit on empty array
- +19 IF ($ORDER(VAFARRY(""))="")
- SET VAFY=1
- GOTO QUIT
- +20 SET VAFNUM=$SELECT($GET(VAFNUM):VAFNUM,1:1)
- +21 IF $GET(VAFSTR)']""
- SET VAFSTR="2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17"
- +22 ;
- +23 ;; Initialize the output string
- +24 SET $PIECE(VAFY,HLFS,17)=""
- SET VAFSTR=","_VAFSTR_","
- +25 ; Required field
- SET $PIECE(VAFY,HLFS,1)=VAFNUM
- +26 ;
- +27 ;;Check required OBX fields
- +28 ; obs result status
- IF $GET(VAFARRY(11))=""!($LENGTH($GET(VAFARRY(11)))>1)
- SET VAFY=1
- GOTO QUIT
- +29 ; obs ID
- IF $GET(VAFARRY(3))=""
- SET VAFY=1
- GOTO QUIT
- +30 ; Value Type
- IF $GET(VAFARRY(11))'="X"
- IF $GET(VAFARRY(2))']""
- SET VAFY=1
- GOTO QUIT
- +31 ;
- +32 ;;Build segment fields
- +33 ; Value Type
- IF VAFSTR[",2,"
- SET $PIECE(VAFY,HLFS,2)=$SELECT($GET(VAFARRY(2))]"":VAFARRY(2),1:HLQ)
- +34 ; Observation Identifier
- IF VAFSTR[",3,"
- SET $PIECE(VAFY,HLFS,3)=$GET(VAFARRY(3))
- +35 ; Observation Sub ID
- IF VAFSTR[",4,"
- SET $PIECE(VAFY,HLFS,4)=$SELECT($GET(VAFARRY(4))]"":VAFARRY(4),1:HLQ)
- +36 ; Observation Value
- IF VAFSTR[",5,"
- SET $PIECE(VAFY,HLFS,5)=$SELECT($GET(VAFARRY(5))]"":VAFARRY(5),1:HLQ)
- +37 ; Units
- IF VAFSTR[",6,"
- SET $PIECE(VAFY,HLFS,6)=$SELECT($GET(VAFARRY(6))]"":VAFARRY(6),1:HLQ)
- +38 ; Reference Range
- IF VAFSTR[",7,"
- SET $PIECE(VAFY,HLFS,7)=$SELECT($GET(VAFARRY(7))]"":VAFARRY(7),1:HLQ)
- +39 ; Abnormal flags
- IF VAFSTR[",8,"
- SET $PIECE(VAFY,HLFS,8)=$SELECT($GET(VAFARRY(8))]"":VAFARRY(8),1:HLQ)
- +40 ; Probability
- IF VAFSTR[",9,"
- SET $PIECE(VAFY,HLFS,9)=$SELECT($GET(VAFARRY(9))]"":VAFARRY(9),1:HLQ)
- +41 ; Nature of Abnormal Test
- IF VAFSTR[",10,"
- SET $PIECE(VAFY,HLFS,10)=$SELECT($GET(VAFARRY(10))]"":VAFARRY(10),1:HLQ)
- +42 ; Observation Result Status
- IF VAFSTR[",11,"
- SET $PIECE(VAFY,HLFS,11)=$GET(VAFARRY(11))
- +43 ; Date of last OBS Normal Values
- IF VAFSTR[",12,"
- SET X1=$$HLDATE^HLFNC($GET(VAFARRY(12)))
- SET $PIECE(VAFY,HLFS,12)=$SELECT(X1]"":X1,1:HLQ)
- +44 ; User Defined Access Checks
- IF VAFSTR[",13,"
- SET $PIECE(VAFY,HLFS,13)=$SELECT($GET(VAFARRY(13))]"":VAFARRY(13),1:HLQ)
- +45 ; DT of Observation
- IF VAFSTR[",14,"
- SET X1=$$HLDATE^HLFNC($GET(VAFARRY(14)))
- SET $PIECE(VAFY,HLFS,14)=$SELECT(X1]"":X1,1:HLQ)
- +46 ; Producer's ID
- IF VAFSTR[",15,"
- SET $PIECE(VAFY,HLFS,15)=$SELECT($GET(VAFARRY(15))]"":VAFARRY(15),1:HLQ)
- +47 IF VAFSTR[",16,"
- Begin DoDot:1
- +48 SET DIC="^VA(200,"
- SET DIC(0)="MZO"
- SET X="`"_$GET(VAFARRY(16))
- DO ^DIC
- +49 IF VAFARRY(16)]""
- IF Y>0
- Begin DoDot:2
- +50 NEW DGNAME
- SET DGNAME("FILE")=200
- SET DGNAME("IENS")=VAFARRY(16)
- SET DGNAME("FIELD")=.01
- +51 SET X1=$$HLNAME^XLFNAME(.DGNAME,"S",$EXTRACT($GET(HLECH)))
- SET X1=$GET(VAFARRY(16))_$EXTRACT(HLECH,1)_X1
- End DoDot:2
- +52 IF '$TEST
- Begin DoDot:2
- +53 SET X1=""
- End DoDot:2
- End DoDot:1
- SET $PIECE(VAFY,HLFS,16)=$SELECT(X1]"":X1,1:HLQ)
- +54 ;
- +55 ; OBS. Method
- IF VAFSTR[",17,"
- SET $PIECE(VAFY,HLFS,17)=$SELECT($GET(VAFARRY(17))]"":VAFARRY(17),1:HLQ)
- +56 ;
- +57 ;
- QUIT QUIT "OBX"_HLFS_$GET(VAFY)
