Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7VIN7A

LA7VIN7A.m

Go to the documentation of this file.
  1. LA7VIN7A ;DALOI/JDB - Process ORU's OBX for Micro ;08/05/16 07:32
  1. ;;5.2;AUTOMATED LAB INSTRUMENTS;**74,90**;Sep 27, 1994;Build 17
  1. ;
  1. ; Continuation of LA7VIN7 and is only called from there - process OBX segments for "MI" subscript tests.
  1. Q
  1. ;
  1. ;
  1. 1 ; Gram Stain (Subscript 2)
  1. ;
  1. N ISQN2,LA7X,SUB,X
  1. ;
  1. ; Store gram stain comment
  1. S ISQN2=$O(^LAH(LWL,1,LA7ISQN,"MI",2,"A"),-1)+1
  1. S SUB="2,"_ISQN2_",0"
  1. S X=OBX5_$S(OBX6'="":" "_OBX6,1:"")
  1. S X=$TR(X,"^"," ")
  1. D LAH(SUB,1,X) ;Value
  1. ;
  1. ; Store gram stain supporting info.
  1. S SUB="2,"_ISQN2_",0,0"
  1. D LAH(SUB,1,LA74) ; perf lab
  1. ;
  1. ; If LEDI interface then use LRLAB,HL as user.
  1. I LA7INTYP=10 S LA7X=^XTMP("LA7 PROXY","LRLAB,HL")
  1. E S LA7X=$P(LA7RO,"^",3)
  1. I LA7X D LAH(SUB,2,LA7X) ;resp observer
  1. ;
  1. D LAH(SUB,3,LA7RLNC) ; LOINC IEN
  1. D LAH(SUB,4,LA7RNLT) ; NLT code
  1. D LAH(SUB,5,OBX11) ; Observ result code
  1. ;
  1. D NTE
  1. Q
  1. ;
  1. ;
  1. 3 ; Process organism (Subscript 3)
  1. ;
  1. N X,SUB,ISQN2
  1. I DDS<0!(DDP<1) D DDERR Q
  1. I LA7612<1 D Q ;
  1. . ; Unknown entity in OBX-5
  1. . N LA7VOBX5
  1. . S LA7VOBX5=OBX5 ;needed for log
  1. . S LA7VOBX5=$$UNESC^LA7VHLU3(LA7VOBX5,LA7FS_LA7ECH)
  1. . D CREATE^LA7LOG(204)
  1. . S LA7KILAH=1 S LA7QUIT=2
  1. ;
  1. S ISQN2=0
  1. I SUBID'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",3,SUBID)
  1. I SUBID="" I $G(PSUBID)'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",3,PSUBID)
  1. I 'ISQN2 D Q ;
  1. . D SUBIDERR^LA7VIN71
  1. ;
  1. D LAH("3,0",-1,"")
  1. S SUB="3,"_ISQN2_",0"
  1. D LAH(SUB,DDP,LA7612) ; organism #61.2 IEN
  1. S SUB="3,"_ISQN2_",.1"
  1. D LAH(SUB,1,SUBID) ; isolate id
  1. S SUB="3,"_ISQN2_","_DDS_",.01"
  1. D LAH(SUB,1,LA7RLNC) ; LOINC IEN
  1. D LAH(SUB,2,LA7RNLT) ; NLT code
  1. D LAH(SUB,3,LA7SCT) ; SCT Code
  1. S SUB="3,"_ISQN2_","_DDS_",.01,0"
  1. D LAH(SUB,1,OBX11) ;
  1. S SUB="3,"_ISQN2_","_DDS_",.01,1"
  1. D LAH(SUB,1,LA74)
  1. S X=$P(LA7RO,"^",3)
  1. D LAH(SUB,2,X)
  1. D NTE
  1. Q
  1. ;
  1. ;
  1. 6(COM) ; Process bact rpt rmk (Subscript 4)
  1. ;
  1. ; Input
  1. ; COM : <opt> The text to use for the remark (comment)
  1. ; : If not defined, copy of sym table variable OBX5 is used.
  1. ; : If OBX5 used, TEXT2 will be HL7 unescaped. If COM
  1. ; : is used it's text is not HL7 unescaped.
  1. ;
  1. N X,SUB,ISQN2,TEXT,MAXLEN,TEXT2
  1. ; Dont initialize COM
  1. S SUB="4,0"
  1. D LAH(SUB,1,LA74)
  1. S X=$P(LA7RO,"^",3)
  1. D LAH(SUB,2,X) ; resp obsv
  1. D LAH(SUB,3,LA7RLNC) ; LOINC
  1. D LAH(SUB,4,OBX11) ;obsv status
  1. S ISQN2=$O(^LAH(LWL,1,LA7ISQN,"MI",4,"A"),-1)+1
  1. ; pull comment from COM or OBX5
  1. S TEXT="OBX5"
  1. I $D(COM)=1 S TEXT="COM"
  1. S MAXLEN=68 ; COMMENTS field size
  1. S SUB="4,"_ISQN2_",0"
  1. ; insert separator line if needed
  1. I ISQN2>1 D LAH(SUB,1," ") S ISQN2=ISQN2+1 S SUB="4,"_ISQN2_",0"
  1. ;
  1. ; if this an override insert Original Concept name
  1. I $P(DSOBX3,"^",6) I $P(DSOBX3,"^",1)'=$P(DSOBX3,"^",6) D ;
  1. . S X=$P(DSOBX3,"^",6) ;original concept
  1. . S X=$G(^LAB(62.47,X,0))
  1. . S X=$P(X,U,1)
  1. . Q:X=""
  1. . D LAH(SUB,1,"["_X_"]")
  1. . S ISQN2=ISQN2+1 S SUB="13,"_ISQN2_",0"
  1. ;
  1. ; modify MAXLEN for prefixed Subid
  1. I TEXT="OBX5" S TEXT2=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
  1. I TEXT="COM" S TEXT2=$G(COM)
  1. I $L(TEXT2)'>MAXLEN D ;
  1. . D LAH(SUB,1,TEXT2)
  1. ;
  1. I $L(TEXT2)>MAXLEN D ;
  1. . N I,Y,PASS
  1. . S PASS=$L(TEXT2)\MAXLEN
  1. . S:($L(TEXT2)#MAXLEN)>0 PASS=PASS+1
  1. . F I=0:1:PASS-1 S Y=(I*MAXLEN)+1 D ;
  1. . . D LAH(SUB,1,$E(TEXT2,Y,(Y+MAXLEN)-1))
  1. . . S Y=Y+MAXLEN
  1. . . S ISQN2=ISQN2+1
  1. . . S SUB="4,"_ISQN2_",0"
  1. . ;
  1. D NTE^LA7VIN71(LA76247,ISQN)
  1. Q
  1. ;
  1. ;
  1. 7 ; Process antimicrobial susceptibilities (Subscript 3)
  1. ;
  1. N ASCRN,ISQN2,LA7X,SUB,X,X2
  1. I DDS<0!(DDP'>0) D DDERR Q
  1. S ISQN2=0
  1. I SUBID'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",3,SUBID)
  1. I SUBID="" I $G(PSUBID)'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",3,PSUBID)
  1. I 'ISQN2 D Q ;
  1. . D SUBIDERR^LA7VIN71
  1. ;
  1. D LAH("3,0",-1,"")
  1. S ASCRN=$$FIELD^LA7VHLU7(13)
  1. I ASCRN'="" D ;
  1. . N X,DATA
  1. . S X=$P(DSOBX3,"^",4)
  1. . S X=X+.2
  1. . D CHK^DIE(63.3,X,"",ASCRN,.DATA)
  1. . S ASCRN=$P(DATA,"^",1)
  1. S SUB="3,"_ISQN2_","_DDS
  1. S X=OBX5_$S(OBX6'="":" "_OBX6,1:"")
  1. ;
  1. ; convert SCT susc code to local code
  1. I LA7VTYP?1(1"CE",1"CM",1"CNE",1"CWE") D
  1. . N LA7I,VAR,VER,X2
  1. . S X2="",VAR=OBX5 D FLD2ARR^LA7VHLU7(.VAR,LA7FS_LA7ECH)
  1. . F LA7I=1,4 D Q:X2'=""
  1. . . I $G(VAR(LA7I))="",$G(VAR(LA7I+1))="" Q ; Quit if no code or text for this tuple
  1. . . S VER=$S(LA7I=1:7,1:8)
  1. . . S X2=$$SCT2KB^LA7VHLU6($G(VAR(LA7I)),$G(VAR(LA7I+1)),$G(VAR(LA7I+2)),$G(VAR(VER)))
  1. . . I X2'="" S X=X2 Q
  1. . . S X2=$$SCT2PN^LA7VHLU6($G(VAR(LA7I)),$G(VAR(LA7I+1)),$G(VAR(LA7I+2)),$G(VAR(VER)))
  1. . . I X2'="" S X=X2
  1. ;
  1. S X=$TR(X,"^"," ")
  1. ;
  1. D LAH(SUB,DDP,X) ; result
  1. D LAH(SUB,2,OBX8) ; interpretation
  1. D LAH(SUB,3,ASCRN) ; screen
  1. S SUB="3,"_ISQN2_","_DDS_",.01"
  1. D LAH(SUB,1,LA7RLNC) ; LOINC
  1. D LAH(SUB,2,LA7RNLT) ; NLT code
  1. D LAH(SUB,3,LA7SCT) ; SCT
  1. S SUB="3,"_ISQN2_","_DDS_",.01,0"
  1. D LAH(SUB,1,OBX11) ;obsv status
  1. S SUB="3,"_ISQN2_","_DDS_",.01,1"
  1. D LAH(SUB,1,LA74) ; #4 IEN
  1. S X=$P(LA7RO,"^",3)
  1. D LAH(SUB,2,X) ; resp observer
  1. ;
  1. ; Set prefix to antibiotic abbrevation or full name to annotate comments.
  1. S LA7X=$$ABPREFIX(1,LA7DD)
  1. I LA7X="" S LA7X=LA7DD("LABEL")
  1. D NTE^LA7VIN71(LA76247,ISQN2,LA7X)
  1. Q
  1. ;
  1. ;
  1. 10 ; Organism Colony Count (Subscript 3)
  1. ;
  1. N X,SUB,ISQN2,UNITS
  1. I DDS<0!(DDP'>0) D DDERR Q
  1. S ISQN2=0
  1. I SUBID'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",3,SUBID)
  1. I SUBID="" I $G(PSUBID)'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",3,PSUBID)
  1. I 'ISQN2 D Q ;
  1. . D SUBIDERR^LA7VIN71
  1. D LAH("3,0",-1,"")
  1. S SUB="3,"_ISQN2_",0"
  1. S X=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
  1. S UNITS=$$UNESC^LA7VHLU3(OBX6,LA7FS_LA7ECH)
  1. I UNITS'="" S X=X_" "_UNITS
  1. D LAH(SUB,2,X) ;quantity
  1. S SUB="3,"_ISQN2_","_DDS_",1"
  1. D LAH(SUB,1,LA7RLNC) ; LOINC
  1. S SUB="3,"_ISQN2_","_DDS_",1,0"
  1. D LAH(SUB,1,OBX11)
  1. S SUB="3,"_ISQN2_","_DDS_",1,1"
  1. D LAH(SUB,1,LA74) ; #4 IEN
  1. S X=$P(LA7RO,"^",3)
  1. D LAH(SUB,2,X) ; resp observer
  1. D NTE
  1. Q
  1. ;
  1. ;
  1. 16 ; Urine Screen (Subscript 1)
  1. ;
  1. N LAMSG,X,X2,Z
  1. ;
  1. S X=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
  1. ;
  1. ; convert SCT positive/negative code to local code
  1. I LA7SCT D
  1. . S X2=$$SCT2PN^LA7VHLU6(LA7SCT,,"SCT",1)
  1. . I X2'="" S X=X2
  1. ;
  1. D ;
  1. . N Z,LAMSG,LRNOECHO
  1. . S LRNOECHO=1
  1. . D CHK^DIE(63.05,11.57,"",X,.Z,"LAMSG")
  1. . I $G(Z)'="^" S X=Z
  1. ;
  1. S DATAOK=$$DATAOK^LA7VIN7(63.05,11.57,X)
  1. ;
  1. S SUB="1,0"
  1. D LAH(SUB,6,X)
  1. ;
  1. S SUB="1,0,.02"
  1. D LAH(SUB,1,LA7RLNC) ; LOINC
  1. S SUB="1,0,.02,0"
  1. D LAH(SUB,1,OBX11) ; Obsv Results
  1. S SUB="1,0,.02,1"
  1. D LAH(SUB,1,LA74)
  1. S X=$P(LA7RO,"^",3)
  1. D LAH(SUB,2,X) ; Resp Obsv.
  1. D NTE^LA7VIN71(LA76247,ISQN)
  1. ;
  1. Q
  1. ;
  1. ;
  1. 17 ; Sputum Screen (Subscript 1)
  1. ;
  1. N X,SUB,ISQN2,UNITS,DATAOK
  1. ;
  1. S X=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
  1. S DATAOK=$$DATAOK^LA7VIN7(63.05,11.58,X)
  1. ; Workaround 01/10/2007 (store anything in Set of Codes)
  1. S SUB="1,0"
  1. D LAH(SUB,5,X)
  1. I DATAOK D LAH(SUB,5,X)
  1. ;
  1. S SUB="1,0,.01"
  1. D LAH(SUB,1,LA7RLNC) ; LOINC
  1. S SUB="1,0,.01,0"
  1. D LAH(SUB,1,OBX11) ; Obsv Results
  1. S SUB="1,0,.01,1"
  1. D LAH(SUB,1,LA74)
  1. S X=$P(LA7RO,"^",3)
  1. D LAH(SUB,2,X) ; Resp Obsv.
  1. D NTE^LA7VIN71(LA76247,ISQN)
  1. ;
  1. Q
  1. ;
  1. ;
  1. DDERR ;
  1. ; If unknown storage location flag error
  1. ; No File #63 field mapping found for OBX-3
  1. N LA7OBX3
  1. S LA7OBX3=OBX3 ;needed for log
  1. D CREATE^LA7LOG(201)
  1. S LA7KILAH=1 S LA7QUIT=2
  1. Q
  1. ;
  1. ;
  1. LAH(LASUB,LAP,LAVAL) ;
  1. ; Convenience method
  1. I LAP'=-1 I LAVAL="" Q
  1. D LAH^LAGEN(+$G(LWL),+$G(LA7ISQN),"MI",LASUB,LAP,LAVAL)
  1. Q
  1. ;
  1. ;
  1. NTE ;
  1. ; Convenience method
  1. D NTE^LA7VIN71(LA76247,ISQN2)
  1. Q
  1. ;
  1. ;
  1. ABPREFIX(LA7TYPE,LA7DD) ; Get prefix of antibiotic full name to annotate comments.
  1. ; Call with LA7TYPE = type of antimicrobial (1=bacterial, 2=mycobacterial)
  1. ; LA7DD = drug node in file #63, MI subscript
  1. ;
  1. ; Returns LA7Y = drug abbreviation or full name from file #62.06
  1. ;
  1. N LA76206,LA7Y,LA7XREF
  1. S (LA76206,LA7Y)="",LA7TYPE=$G(LA7TYPE),LA7DD=$P($G(LA7DD),";")
  1. S LA7XREF=$S(LA7TYPE=1:"AD",LA7TYPE=2:"AD1",1:"")
  1. ;
  1. I LA7XREF'="",LA7DD S LA76206=$O(^LAB(62.06,LA7XREF,LA7DD,0))
  1. ;
  1. I LA76206 D
  1. . S LA76206(0)=$G(^LAB(62.06,LA76206,0))
  1. . S LA7Y="For "_$P(LA76206(0),"^")_": "
  1. ;
  1. Q LA7Y