- DGPFHLU2 ;ALB/RPM - PRF HL7 BUILD OBX SEGMENT ; 2/20/03
- ;;5.3;Registration;**425,1015**;Aug 13, 1993;Build 21
- ;
- Q
- ;
- OBX(DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGFLD,DGHL) ;OBX Segment API
- ;This function wraps the data retrieval and segment creation APIs and
- ;returns a formatted OBX segment.
- ;
- ; Input:
- ; DGSET - (required) OBX segment Set ID
- ; DGID - (required) Observation identifier code
- ; DGSUBID - (optional) Observation Sub-ID
- ; DGVALUE - (required) Observation value
- ; DGPFAH - (required) Assignment history data array
- ; DGFLD - (optional) List of comma-separated fields (sequence #'s)
- ; to include. Defaults to all required fields (3,11).
- ; DGHL - HL7 environment array
- ;
- ; Output:
- ; Function Value - OBX segment on success, "" on failure
- ;
- N DGOBX
- N DGVAL
- ;
- S DGOBX=""
- I $G(DGSET)>0,$G(DGID)?1A,$G(DGVALUE)]"" D
- . S DGFLD=$$CKSTR^DGPFHLUT("3,11",DGFLD) ;required fields
- . S DGFLD=","_DGFLD_","
- . I $$OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,.DGPFAH,.DGVAL) D
- . . S DGOBX=$$BLDSEG^DGPFHLUT("OBX",.DGVAL,.DGHL)
- Q DGOBX
- ;
- OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGVAL) ;build OBX value array
- ;
- ; Input:
- ; DGFLD - (required) Fields string
- ; DGSET - (required) OBX segment Set ID
- ; DGID - (required) Observation identifier code
- ; DGSUBID - (optional) Observation Sub-ID
- ; DGVALUE - (required) Observation value
- ; DGPFAH - (required) Assignment history data array
- ;
- ; Output:
- ; Function Value - 1 on sucess, 0 on failure
- ; DGVAL - OBX field array [SUB1:field, SUB2:repetition,
- ; SUB3:component, SUB4:sub-component]
- ;
- N DGRSLT ;function value
- N DGTYPE ;observation value type
- N DGIDSTR ;observation identifier string
- N DGDAT ;observation date
- ;
- S DGRSLT=0
- I $G(DGFLD)]"",+$G(DGSET)>0,$G(DGID)?1A,$G(DGVALUE)]"" D
- . ;
- . ; seq 1 Set ID
- . I DGFLD[",1," D
- . . S DGVAL(1)=DGSET
- . ;
- . ; seq 2 Value Type
- . I DGFLD[",2," D
- . . S DGTYPE=$S(DGID="S":"ST",DGID="N":"TX",DGID="C":"TX",1:"")
- . . Q:(DGTYPE']"")
- . . S DGVAL(2)=DGTYPE
- . ;
- . ; seq 3 Observation Identifier
- . I DGFLD[",3," D Q:'$D(DGVAL(3)) ;required field
- . . S DGIDSTR=$S(DGID="S":"Status",DGID="N":"Narrative",DGID="C":"Comment",1:"")
- . . Q:(DGIDSTR']"")
- . . S DGVAL(3,1,1)=DGID
- . . S DGVAL(3,1,2)=DGIDSTR
- . . S DGVAL(3,1,3)="L"
- . ;
- . ; seq 4 Observation Sub-ID (optional)
- . I DGFLD[",4," D
- . . S DGVAL(4)=$S(+$G(DGSUBID)>0:DGSUBID,1:"")
- . ;
- . ; seq 5 Observation Value
- . I DGFLD[",5," D
- . . S DGVAL(5)=DGVALUE
- . ;
- . ; seq 6 Units
- . I DGFLD[",6," D
- . . S DGVAL(6)=""
- . ;
- . ; seq 7 Reference Range
- . I DGFLD[",7," D
- . . S DGVAL(7)=""
- . ;
- . ; seq 8 Abnormal Flags
- . I DGFLD[",8," D
- . . S DGVAL(8)=""
- . ;
- . ; seq 9 Probability
- . I DGFLD[",9," D
- . . S DGVAL(9)=""
- . ;
- . ; seq 10 Nature of Abnormal Test
- . I DGFLD[",10," D
- . . S DGVAL(10)=""
- . ;
- . ; seq 11 Observ Result Status
- . I DGFLD[",11," D
- . . S DGVAL(11)="F"
- . ;
- . ; seq 12 Date last Obs Normal Values
- . I DGFLD[",12," D
- . . S DGVAL(12)=""
- . ;
- . ; seq 13 User Defined Access Checks
- . I DGFLD[",13," D
- . . S DGVAL(13)=""
- . ;
- . ; seq 14 Date/Time of the Observation
- . I DGFLD[",14," D
- . . S DGDAT=$$FMTHL7^XLFDT(+$G(DGPFAH("ASSIGNDT")))
- . . S DGVAL(14)=$S(DGDAT>0:DGDAT,1:"")
- . ;
- . ; seq 15 Producer's ID
- . I DGFLD[",15," D
- . . S DGVAL(15)=""
- . ;
- . ; seq 16 Responsible Observer
- . I DGFLD[",16," D
- . . S DGVAL(16)=""
- . ;
- . ; seq 17 Observation Method
- . I DGFLD[",17," D
- . . S DGVAL(17)=""
- . ;
- . S DGRSLT=1
- I 'DGRSLT K DGVAL
- Q DGRSLT
- ;
- BLDOBXTX(DGROOT,DGTXTA,DGID,DGPFAH,DGHL,DGSEG,DGSET) ;build OBX text segments
- ;
- ; Input:
- ; DGROOT - (required) Closed root array or global name for segment
- ; storage
- ; DGTXTA - (required) Closed root array containing text
- ; DGID - (required) OBX segment Observation ID
- ; DGPFAH - (required) Assignment history data array
- ; DGHL - (required) VistA HL7 environment array
- ; DGSEG - (optional) Previous segment # in DGROOT
- ; DGSET - (optional) Previous OBX Set ID
- ;
- ; Output:
- ; Function Value - 1 on success, 0 on failure
- ;
- N DGI ;generic counter
- N DGOBX ;formatted OBX segment
- N DGOBXTX ;array of pre-processed text lines
- N DGRSLT ;function value
- N DGSTR ;list of OBX segment fields to include
- ;
- S DGRSLT=0
- S DGSTR="1,2,3,5,11,14"
- I $G(DGROOT)]"",$G(DGTXTA)]"",$G(DGID)?1A,$D(DGPFAH) D
- . Q:'$$BLDTEXT^DGPFHLUT(DGTXTA,.DGHL,.DGOBXTX)
- . S DGSEG=$G(DGSEG,0)
- . S DGSET=$G(DGSET,0)
- . S DGI=0
- . F S DGI=$O(DGOBXTX(DGI)) Q:'DGI D Q:(DGOBX="")
- . . S DGSET=DGSET+1
- . . S DGOBX=$$OBX^DGPFHLU2(DGSET,DGID,"",DGOBXTX(DGI),.DGPFAH,DGSTR,.DGHL)
- . . Q:(DGOBX="")
- . . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGOBX
- . Q:(DGOBX)=""
- . ;
- . ;success
- . S DGRSLT=1
- ;
- Q DGRSLT
- DGPFHLU2 ;ALB/RPM - PRF HL7 BUILD OBX SEGMENT ; 2/20/03
- +1 ;;5.3;Registration;**425,1015**;Aug 13, 1993;Build 21
- +2 ;
- +3 QUIT
- +4 ;
- OBX(DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGFLD,DGHL) ;OBX Segment API
- +1 ;This function wraps the data retrieval and segment creation APIs and
- +2 ;returns a formatted OBX segment.
- +3 ;
- +4 ; Input:
- +5 ; DGSET - (required) OBX segment Set ID
- +6 ; DGID - (required) Observation identifier code
- +7 ; DGSUBID - (optional) Observation Sub-ID
- +8 ; DGVALUE - (required) Observation value
- +9 ; DGPFAH - (required) Assignment history data array
- +10 ; DGFLD - (optional) List of comma-separated fields (sequence #'s)
- +11 ; to include. Defaults to all required fields (3,11).
- +12 ; DGHL - HL7 environment array
- +13 ;
- +14 ; Output:
- +15 ; Function Value - OBX segment on success, "" on failure
- +16 ;
- +17 NEW DGOBX
- +18 NEW DGVAL
- +19 ;
- +20 SET DGOBX=""
- +21 IF $GET(DGSET)>0
- IF $GET(DGID)?1A
- IF $GET(DGVALUE)]""
- Begin DoDot:1
- +22 ;required fields
- SET DGFLD=$$CKSTR^DGPFHLUT("3,11",DGFLD)
- +23 SET DGFLD=","_DGFLD_","
- +24 IF $$OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,.DGPFAH,.DGVAL)
- Begin DoDot:2
- +25 SET DGOBX=$$BLDSEG^DGPFHLUT("OBX",.DGVAL,.DGHL)
- End DoDot:2
- End DoDot:1
- +26 QUIT DGOBX
- +27 ;
- OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGVAL) ;build OBX value array
- +1 ;
- +2 ; Input:
- +3 ; DGFLD - (required) Fields string
- +4 ; DGSET - (required) OBX segment Set ID
- +5 ; DGID - (required) Observation identifier code
- +6 ; DGSUBID - (optional) Observation Sub-ID
- +7 ; DGVALUE - (required) Observation value
- +8 ; DGPFAH - (required) Assignment history data array
- +9 ;
- +10 ; Output:
- +11 ; Function Value - 1 on sucess, 0 on failure
- +12 ; DGVAL - OBX field array [SUB1:field, SUB2:repetition,
- +13 ; SUB3:component, SUB4:sub-component]
- +14 ;
- +15 ;function value
- NEW DGRSLT
- +16 ;observation value type
- NEW DGTYPE
- +17 ;observation identifier string
- NEW DGIDSTR
- +18 ;observation date
- NEW DGDAT
- +19 ;
- +20 SET DGRSLT=0
- +21 IF $GET(DGFLD)]""
- IF +$GET(DGSET)>0
- IF $GET(DGID)?1A
- IF $GET(DGVALUE)]""
- Begin DoDot:1
- +22 ;
- +23 ; seq 1 Set ID
- +24 IF DGFLD[",1,"
- Begin DoDot:2
- +25 SET DGVAL(1)=DGSET
- End DoDot:2
- +26 ;
- +27 ; seq 2 Value Type
- +28 IF DGFLD[",2,"
- Begin DoDot:2
- +29 SET DGTYPE=$SELECT(DGID="S":"ST",DGID="N":"TX",DGID="C":"TX",1:"")
- +30 IF (DGTYPE']"")
- QUIT
- +31 SET DGVAL(2)=DGTYPE
- End DoDot:2
- +32 ;
- +33 ; seq 3 Observation Identifier
- +34 ;required field
- IF DGFLD[",3,"
- Begin DoDot:2
- +35 SET DGIDSTR=$SELECT(DGID="S":"Status",DGID="N":"Narrative",DGID="C":"Comment",1:"")
- +36 IF (DGIDSTR']"")
- QUIT
- +37 SET DGVAL(3,1,1)=DGID
- +38 SET DGVAL(3,1,2)=DGIDSTR
- +39 SET DGVAL(3,1,3)="L"
- End DoDot:2
- IF '$DATA(DGVAL(3))
- QUIT
- +40 ;
- +41 ; seq 4 Observation Sub-ID (optional)
- +42 IF DGFLD[",4,"
- Begin DoDot:2
- +43 SET DGVAL(4)=$SELECT(+$GET(DGSUBID)>0:DGSUBID,1:"")
- End DoDot:2
- +44 ;
- +45 ; seq 5 Observation Value
- +46 IF DGFLD[",5,"
- Begin DoDot:2
- +47 SET DGVAL(5)=DGVALUE
- End DoDot:2
- +48 ;
- +49 ; seq 6 Units
- +50 IF DGFLD[",6,"
- Begin DoDot:2
- +51 SET DGVAL(6)=""
- End DoDot:2
- +52 ;
- +53 ; seq 7 Reference Range
- +54 IF DGFLD[",7,"
- Begin DoDot:2
- +55 SET DGVAL(7)=""
- End DoDot:2
- +56 ;
- +57 ; seq 8 Abnormal Flags
- +58 IF DGFLD[",8,"
- Begin DoDot:2
- +59 SET DGVAL(8)=""
- End DoDot:2
- +60 ;
- +61 ; seq 9 Probability
- +62 IF DGFLD[",9,"
- Begin DoDot:2
- +63 SET DGVAL(9)=""
- End DoDot:2
- +64 ;
- +65 ; seq 10 Nature of Abnormal Test
- +66 IF DGFLD[",10,"
- Begin DoDot:2
- +67 SET DGVAL(10)=""
- End DoDot:2
- +68 ;
- +69 ; seq 11 Observ Result Status
- +70 IF DGFLD[",11,"
- Begin DoDot:2
- +71 SET DGVAL(11)="F"
- End DoDot:2
- +72 ;
- +73 ; seq 12 Date last Obs Normal Values
- +74 IF DGFLD[",12,"
- Begin DoDot:2
- +75 SET DGVAL(12)=""
- End DoDot:2
- +76 ;
- +77 ; seq 13 User Defined Access Checks
- +78 IF DGFLD[",13,"
- Begin DoDot:2
- +79 SET DGVAL(13)=""
- End DoDot:2
- +80 ;
- +81 ; seq 14 Date/Time of the Observation
- +82 IF DGFLD[",14,"
- Begin DoDot:2
- +83 SET DGDAT=$$FMTHL7^XLFDT(+$GET(DGPFAH("ASSIGNDT")))
- +84 SET DGVAL(14)=$SELECT(DGDAT>0:DGDAT,1:"")
- End DoDot:2
- +85 ;
- +86 ; seq 15 Producer's ID
- +87 IF DGFLD[",15,"
- Begin DoDot:2
- +88 SET DGVAL(15)=""
- End DoDot:2
- +89 ;
- +90 ; seq 16 Responsible Observer
- +91 IF DGFLD[",16,"
- Begin DoDot:2
- +92 SET DGVAL(16)=""
- End DoDot:2
- +93 ;
- +94 ; seq 17 Observation Method
- +95 IF DGFLD[",17,"
- Begin DoDot:2
- +96 SET DGVAL(17)=""
- End DoDot:2
- +97 ;
- +98 SET DGRSLT=1
- End DoDot:1
- +99 IF 'DGRSLT
- KILL DGVAL
- +100 QUIT DGRSLT
- +101 ;
- BLDOBXTX(DGROOT,DGTXTA,DGID,DGPFAH,DGHL,DGSEG,DGSET) ;build OBX text segments
- +1 ;
- +2 ; Input:
- +3 ; DGROOT - (required) Closed root array or global name for segment
- +4 ; storage
- +5 ; DGTXTA - (required) Closed root array containing text
- +6 ; DGID - (required) OBX segment Observation ID
- +7 ; DGPFAH - (required) Assignment history data array
- +8 ; DGHL - (required) VistA HL7 environment array
- +9 ; DGSEG - (optional) Previous segment # in DGROOT
- +10 ; DGSET - (optional) Previous OBX Set ID
- +11 ;
- +12 ; Output:
- +13 ; Function Value - 1 on success, 0 on failure
- +14 ;
- +15 ;generic counter
- NEW DGI
- +16 ;formatted OBX segment
- NEW DGOBX
- +17 ;array of pre-processed text lines
- NEW DGOBXTX
- +18 ;function value
- NEW DGRSLT
- +19 ;list of OBX segment fields to include
- NEW DGSTR
- +20 ;
- +21 SET DGRSLT=0
- +22 SET DGSTR="1,2,3,5,11,14"
- +23 IF $GET(DGROOT)]""
- IF $GET(DGTXTA)]""
- IF $GET(DGID)?1A
- IF $DATA(DGPFAH)
- Begin DoDot:1
- +24 IF '$$BLDTEXT^DGPFHLUT(DGTXTA,.DGHL,.DGOBXTX)
- QUIT
- +25 SET DGSEG=$GET(DGSEG,0)
- +26 SET DGSET=$GET(DGSET,0)
- +27 SET DGI=0
- +28 FOR
- SET DGI=$ORDER(DGOBXTX(DGI))
- IF 'DGI
- QUIT
- Begin DoDot:2
- +29 SET DGSET=DGSET+1
- +30 SET DGOBX=$$OBX^DGPFHLU2(DGSET,DGID,"",DGOBXTX(DGI),.DGPFAH,DGSTR,.DGHL)
- +31 IF (DGOBX="")
- QUIT
- +32 SET DGSEG=DGSEG+1
- SET @DGROOT@(DGSEG)=DGOBX
- End DoDot:2
- IF (DGOBX="")
- QUIT
- +33 IF (DGOBX)=""
- QUIT
- +34 ;
- +35 ;success
- +36 SET DGRSLT=1
- End DoDot:1
- +37 ;
- +38 QUIT DGRSLT