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  Sep 23, 2025@20:38:58                                                                                                                                                                                                    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)