source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VOBXA.m

LA7VOBXA ;DALOI/JMC - LAB OBX Segment message builder (cont'd) ; 5 June 2003
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,70,64**;Sep 27, 1994
 ;
 Q
 ;
OBX2 ; Build OBX-2 sequence - Value type
 ;
 ; default value - string data
 S LA7VAL="ST"
 S LA7TYP="",LA7FILE=$G(LA7FILE),LA7FIELD=$G(LA7FIELD)
 ;
 I LA7FILE,LA7FIELD S LA7TYP=$$GET1^DID(LA7FILE,LA7FIELD,"","TYPE","","LA7ERR")
 ;
 I LA7TYP="DATE/TIME" S LA7VAL="TS"
 I LA7TYP="FREE TEXT" S LA7VAL="ST"
 I LA7TYP="WORD-PROCESSING" S LA7VAL="FT"
 I LA7TYP="NUMERIC" S LA7VAL="NM"
 I LA7TYP="SET" S LA7VAL="ST"
 I LA7TYP="POINTER" S LA7VAL="CE"
 ;
 Q
 ;
 ;
OBX3 ; Build OBX-3 sequence - Observation identifier field
 ;
 ; Initialize variables 
 S LA7J=1,LA7Y=""
 ;
 ; Build sequence using LOINC codes only
 ; LOINC code/code name/"LN"
 I LA7953'="" D
 . N LA7IENS,LA7Z
 . S LA7953=$P(LA7953,"-"),LA7IENS=LA7953_","
 . D GETS^DIQ(95.3,LA7IENS,".01;80","E","LA7X")
 . ; Invalid code???
 . I $G(LA7X(95.3,LA7IENS,.01,"E"))="" Q
 . S LA7Z=LA7X(95.3,LA7IENS,.01,"E")
 . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
 . S $P(LA7Y,$E(LA7ECH,1),LA7J)=LA7Z
 . S LA7Z=$G(LA7X(95.3,LA7IENS,80,"E")),LA7Z=$TR(LA7Z,"~","^")
 . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
 . S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=LA7Z
 . S $P(LA7Y,$E(LA7ECH,1),LA7J+2)="LN"
 . S LA7J=4
 ;
 ; Build sequence using NLT codes
 ; File #64 NLT code/NLT code name/"99VA64"
 ; If LOINC is primary make NLT alternate, otherwise NLT primary.
 I LA7NLT'="" D
 . N LA7642,LA7Z
 . S LA764=$O(^LAM("E",LA7NLT,0)),LA7Z=""
 . S $P(LA7Y,$E(LA7ECH,1),LA7J)=LA7NLT
 . I LA764 S LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
 . I LA7Z="" D
 . . S LA764=$O(^LAM("E",$P(LA7NLT,".")_".0000",0))
 . . I LA764 S LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
 . . S LA7642=$O(^LAB(64.2,"C","."_$P(LA7NLT,".",2),0))
 . . I LA764,LA7642 S LA7Z=LA7Z_"~"_$$GET1^DIQ(64.2,LA7642_",",.01,"I")
 . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
 . S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=LA7Z
 . S $P(LA7Y,$E(LA7ECH,1),LA7J+2)="99VA64"
 . S LA7J=LA7J+3
 ;
 ; Non-standard/non-VA code
 ; Don't use alternate code when it's "99VA63" and we've already encoded
 ; a primary and alternate. If alternate is a non-VA code then use as
 ; alternate code.
 ; If primary and alternate are not 99VA63 then code 3rd triplet with
 ; 99VA63 per Julius Chou for Clinical Case Registry (JMC/May 13, 2004)
 I LA7ALT="" Q
 I $P(LA7ALT,"^",3)'="99VA63",LA7J>4 S LA7J=4
 I $P(LA7ALT,"^",3)="99VA63" D  Q:LA7J=0
 . I $P(LA7Y,$E(LA7ECH,1),3)="99VA63" S LA7J=0 Q
 . I LA7J>4,$P(LA7Y,$E(LA7ECH,1),6)="99VA63" S LA7J=0 Q
 . I LA7J>4 S LA7J=7
 S $P(LA7Y,$E(LA7ECH,1),LA7J)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^"),LA7FS_LA7ECH)
 S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^",2),LA7FS_LA7ECH)
 S $P(LA7Y,$E(LA7ECH,1),LA7J+2)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^",3),LA7FS_LA7ECH)
 ;
 Q
 ;
 ;
OBX5 ; Build OBX-5 sequence - Observation value
 ; Removes trailing spaces on string and text results.
 ; Removes leading & trailing spaces on numeric results.
 ;
 S LA7Y=""
 ;
 I $G(LA7OBX2)="" S LA7OBX2="ST" ; default value type
 I LA7OBX2="ST"!(LA7OBX2="TX") D
 . S LA7VAL=$$TRIM^XLFSTR(LA7VAL,"R"," ")
 . S LA7Y=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
 I LA7OBX2="NM" S LA7Y=$$TRIM^XLFSTR(LA7VAL,"RL"," ")
 I LA7OBX2="TS" D
 . S LA7VAL=$$CHKDT^LA7VHLU1(LA7VAL)
 . S LA7Y=$$FMTHL7^XLFDT(LA7VAL)
 I LA7OBX2="CE" D
 . N I,X
 . F I=1:1:6 D
 . . I '$L($P(LA7VAL,"^",I)) Q
 . . S X=$$CHKDATA^LA7VHLU3($P(LA7VAL,"^",I),LA7FS_LA7ECH)
 . . S $P(LA7Y,$E(LA7ECH),I)=X
 ;
 Q
 ;
 ;
OBX5M ; Build OBX-5 sequence - Observation value - multi-line textual result
 ;
 K LA7WP
 ;
 S LA7WP=""
 S LA7TYPE=$$GET1^DID(LA7FN,LA7FLD,"","TYPE","LA7ERR(1)")
 ;
 ; Process word-processing type field.
 ; Check and encode data
 I LA7TYPE="WORD-PROCESSING" D  Q
 . N DIWF,DIWL,DIWR,X
 . S LA7WP=$$GET1^DIQ(LA7FN,LA7IENS,LA7FLD,"","LA7WP","LA7ERR(2)")
 . K ^UTILITY($J,"W")
 . S DIWL=1,DIWR=245,DIWF="",LA7I=0
 . I $$GET1^DID(+$$GET1^DID(LA7FN,LA7FLD,"","SPECIFIER","LA7ERR(1)"),.01,"","SPECIFIER","LA7ERR(3)")["L" S DIWF="N"
 . F  S LA7I=$O(LA7WP(LA7I)) Q:'LA7I  S X=LA7WP(LA7I) D ^DIWP
 . K LA7WP
 . S LA7I=0
 . F  S LA7I=$O(^UTILITY($J,"W",DIWL,LA7I)) Q:'LA7I  D
 . . S LA7WP(LA7I)=$$CHKDATA^LA7VHLU3(^UTILITY($J,"W",DIWL,LA7I,0),LA7FS_LA7ECH)
 . . I LA7I>1 S LA7WP(LA7I)=$E(LA7ECH,3)_".br"_$E(LA7ECH,3)_LA7WP(LA7I)
 . K ^UTILITY($J,"W")
 ;
 ; Free text, assumes multiple valued
 I LA7TYPE="FREE TEXT" D
 . D GETS^DIQ(LA7FN,LA7IENS,LA7FLD_"*","","LA7WP","LA7ERR")
 ;
 Q
 ;
 ;
OBX5R ; Build OBX-5 sequence with repetition - Observation value
 ;
 S (LA7I,LA7Y)=""
 F  S LA7I=$O(LA7VAL(LA7I)) Q:'LA7I  D
 . S LA7Y=LA7Y_$$OBX5^LA7VOBX(LA7VAL(LA7I),LA7OBX2,LA7FS,LA7ECH)_$E(LA7ECH,2)
 ;
 Q
 ;
 ;
OBX6 ; Build OBX-6 sequence - Units
 ;
 S LA7ECH=$G(LA7ECH),LA7Y=""
 ;
 ; Units - remove leading and trailing spaces
 I $G(LA7VAL)'="" S LA7Y=$$TRIM^XLFSTR(LA7VAL,"LR"," ")
 ;
 ; Build sequence using LOINC codes only
 ; LOINC code/code name/"LN"
 I $G(LA764061) D
 . N LA7IENS,LA7X,LA7Z
 . S LA7IENS=LA764061_","
 . D GETS^DIQ(64.061,LA7IENS,".01;1","E","LA7X")
 . ; LOINC code
 . S LA7Z=$G(LA7X(64.061,LA7IENS,.01,"E"))
 . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
 . S $P(LA7Y,$E(LA7ECH,1),1)=LA7Z
 . ; LOINC code name
 . S LA7Z=$G(LA7X(64.061,LA7IENS,1,"E"))
 . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
 . S $P(LA7Y,$E(LA7ECH,1),2)=LA7Z
 . S $P(LA7Y,$E(LA7ECH,1),3)="LN"
 ;
 Q
 ;
 ;
OBX7 ; Build OBX-7 sequence - Reference range
 ; Removes leading and trailing quote marks ("").
 ;
 S LA7Y=""
 ;
 I $G(LA7LOW)'="" D
 . S LA7LOW=$$TRIM^XLFSTR(LA7LOW,"RL","""")
 . I LA7LOW?1A.E S LA7Y=LA7Y_LA7LOW Q  ; alphabetic value
 . I $G(LA7HIGH)="",$E(LA7LOW)'=">" S LA7Y=">"
 . S LA7Y=LA7Y_LA7LOW
 ;
 I $G(LA7HIGH)'="" D
 . S LA7HIGH=$$TRIM^XLFSTR(LA7HIGH,"RL","""")
 . I LA7HIGH?1A.E S LA7Y=LA7Y_LA7HIGH Q  ; alphabetic value
 . I $G(LA7LOW)="" D  Q
 . . I $E(LA7HIGH)'="<" S LA7Y="<"
 . . S LA7Y=LA7Y_LA7HIGH
 . S LA7Y=LA7Y_"-"_LA7HIGH
 ;
 S LA7Y=$$CHKDATA^LA7VHLU3(LA7Y,LA7FS_LA7ECH)
 ;
 Q