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

LA7VIN7C.m

Go to the documentation of this file. 
  1. LA7VIN7C ;DALOI/JDB - Process ORU's OBX for Micro ;08/16/13  16:09
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**74,80**;Sep 27, 1994;Build 19
  1.  ;
  1.  ; Continuation of LA7VIN7 and is only called from there.
  1.  ; Process OBX segments for "MI" subscript tests.
  1.  Q
  1.  ;
  1.  ;
  1. 5 ; Process Virus (Subscript 17)
  1.  ;
  1.  N X,SUB,ISQN2
  1.  I DDS<0!(DDP<1) D DDERR^LA7VIN7A 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",17,SUBID)
  1.  I SUBID="" I $G(PSUBID)'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",17,PSUBID)
  1.  I 'ISQN2 D  Q  ;
  1.  . D SUBIDERR^LA7VIN71
  1.  ;
  1.  S SUB="17,"_ISQN2_",0"
  1.  D LAH(SUB,DDP,LA7612) ; organism #61.2 IEN
  1.  S SUB="17,"_ISQN2_",.1"
  1.  D LAH(SUB,1,SUBID) ; isolate id
  1.  S SUB="17,"_ISQN2_",.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="17,"_ISQN2_",0,.01,0"
  1.  D LAH(SUB,1,OBX11) ;
  1.  S SUB="17,"_ISQN2_",0,.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. 22(COM) ; Process TB Rpt Remark (Subscript 13)
  1.  ; Input
  1.  ;  COM : <opt> The text to use for the remark (comment)
  1.  ;      :  If empty OBX5 is used
  1.  ;
  1.  N X,SUB,ISQN2,TEXT,TEXT2,MAXLEN
  1.  ; Dont initialize COM
  1.  S SUB="13,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",13,"A"),-1)+1
  1.  ; pull comment from COM or OBX5
  1.  S TEXT="OBX5"
  1.  I $D(COM)=1 S TEXT="COM"
  1.  I TEXT="OBX5" S TEXT2=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
  1.  I TEXT="COM" S TEXT2=$G(COM)
  1.  S MAXLEN=68 ; COMMENTS field size
  1.  S SUB="13,"_ISQN2_",0"
  1.  ; insert separator line if needed
  1.  I ISQN2>1 D LAH(SUB,1," ") S ISQN2=ISQN2+1 S SUB="13,"_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 $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="13,"_ISQN2_",0"
  1.  . ;
  1.  D NTE^LA7VIN71(LA76247,ISQN)
  1.  Q
  1.  ;
  1.  ;
  1. 30(COM) ; Process Virology Rpt Remark (Subscript 18)
  1.  ; Input
  1.  ;  COM : <opt> The text to use for the remark (comment)
  1.  ;      :  If empty OBX5 is used
  1.  ;
  1.  N X,SUB,ISQN2,TEXT,TEXT2,MAXLEN
  1.  ; Dont initialize COM
  1.  S SUB="18,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",18,"A"),-1)+1
  1.  ; pull comment from COM or OBX5
  1.  S TEXT="OBX5"
  1.  I $D(COM)=1 S TEXT="COM"
  1.  I TEXT="OBX5" S TEXT2=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
  1.  I TEXT="COM" S TEXT2=$G(COM)
  1.  S MAXLEN=68 ; COMMENTS field size
  1.  S SUB="18,"_ISQN2_",0"
  1.  ; insert separator line if needed
  1.  I ISQN2>1 D LAH(SUB,1," ") S ISQN2=ISQN2+1 S SUB="18,"_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 $L(TEXT2)'>MAXLEN D  ;
  1.  . D LAH(SUB,1,TEXT2)
  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="18,"_ISQN2_",0"
  1.  . ;
  1.  D NTE^LA7VIN71(LA76247,ISQN)
  1.  Q
  1.  ;
  1.  ;
  1. 48 ; Process Sterility Results (Subscript 31)
  1.  ;
  1.  N LRX,SUB,ISQN2
  1.  S ISQN2=$O(^LAH(LWL,1,LA7ISQN,"MI",31,"A"),-1)+1
  1.  S SUB="31,"_ISQN2_",0"
  1.  S LRX=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
  1.  D  ;
  1.  . N LRZ,LAMSG
  1.  . D CHK^DIE(63.292,.01,"",LRX,.LRZ,"LAMSG")
  1.  . I $G(LRZ)'="^" S LRX=LRZ
  1.  ;
  1.  D LAH(SUB,1,LRX)
  1.  ;
  1.  D ADDINFO(31,ISQN2) ;
  1.  ;
  1.  D NTE^LA7VIN71(LA76247,ISQN)
  1.  Q
  1.  ;
  1.  ;
  1. NODE(LA76247,COM) ; Process series of free-text multiples.
  1.  ;
  1.  ; Handles the following 62.47 concepts and the corresponding free-text multiple in Microbiology (MI) subscript
  1.  ; Sequence Concept                           Field                                 Subscript
  1.  ;
  1.  ;   40     MYCOLOGY SMEAR/PREP               (#19.6)  MYCOLOGY SMEAR/PREP              15
  1.  ;   41     PARASITOLOGY SMEAR PREP           (#15.51) PARASITOLOGY SMEAR/PREP          24
  1.  ;   42     BACTERIOLOGY SMEAR PREP           (#11.7)  BACTERIOLOGY SMEAR/PREP          25
  1.  ;   43     BACTERIOLOGY TEST                 (#1.5)   BACTERIOLOGY TEST(S)             26
  1.  ;   44     PARASITE TEST                     (#16.4)  PARASITE TEST(S)                 27
  1.  ;   45     MYCOLOGY TEST                     (#20.4)  MYCOLOGY TEST(S)                 28
  1.  ;   46     TB TEST                           (#26.4)  TB TEST(S)                       29
  1.  ;   47     VIROLOGY TEST                     (#36.4)  VIROLOGY TESTS                   30
  1.  ;
  1.  ;  The following are currently processed from NTE segments - See LA7VIN2A (NTE/MISPC)
  1.  ;   86     MI PRELIMINARY BACT COMMENT       (#1)     PRELIMINARY BACT COMMENT         19
  1.  ;   87     MI PRELIMINARY VIROLOGY COMMENT   (#36.5)  PRELIMINARY VIROLOGY COMMENT     20
  1.  ;   88     MI PRELIMINARY PARASITE COMMENT   (#16.5)  PRELIMINARY PARASITE COMMENT     21
  1.  ;   89     MI PRELIMINARY MYCOLOGY COMMENT   (#20.5)  PRELIMINARY MYCOLOGY COMMENT     22
  1.  ;   90     MI PRELIMINARY TB COMMENT         (#26.5)  PRELIMINARY TB COMMENT           23
  1.  ;
  1.  ; Input
  1.  ;  LA76247 : ien of related concept in file #62.47
  1.  ;      COM : <opt> The text to use for the remark (comment)
  1.  ;          :  If empty OBX5 is used
  1.  ;
  1.  ; Don't initialize COM
  1.  ;
  1.  N ISQN2,MAXLEN,SUB,SUBROOT,TEXT,TEXT2,X
  1.  ;
  1.  ; Determine subscript based on 62.47 concept number.
  1.  I LA76247<48 S SUBROOT=$P("15^24^25^26^27^28^29^30","^",LA76247-39)
  1.  E  S SUBROOT=$P("19^20^21^22^23","^",LA76247-85)
  1.  ;
  1.  S ISQN2=$O(^LAH(LWL,1,LA7ISQN,"MI",SUBROOT,"A"),-1)+1
  1.  S SUB=SUBROOT_","_ISQN2_",0"
  1.  ;
  1.  ; pull comment from COM or OBX5
  1.  I $G(COM)=""  S TEXT="OBX5",TEXT2=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
  1.  E  S TEXT="COM",TEXT2=COM
  1.  S MAXLEN=68 ; free-text field size
  1.  ;
  1.  ; insert separator line if needed
  1.  I ISQN2>1 D
  1.  . D LAH(SUB,1," ")
  1.  . D ADDINFO(SUBROOT,ISQN2)
  1.  . S ISQN2=ISQN2+1,SUB=SUBROOT_","_ISQN2_",0"
  1.  ;
  1.  ; if this an override insert Original Concept name
  1.  I $P(DSOBX3,"^",6),$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.  . D ADDINFO(SUBROOT,ISQN2)
  1.  . S ISQN2=ISQN2+1,SUB=SUBROOT_","_ISQN2_",0"
  1.  ;
  1.  ; modify MAXLEN for prefixed Subid
  1.  I $L(TEXT2)'>MAXLEN D LAH(SUB,1,TEXT2),ADDINFO(SUBROOT,ISQN2)
  1.  ;
  1.  I $L(TEXT2)>MAXLEN D
  1.  . N LA7I,LA7Y,PASS
  1.  . S PASS=$L(TEXT2)\MAXLEN
  1.  . S:($L(TEXT2)#MAXLEN)>0 PASS=PASS+1
  1.  . F LA7I=0:1:PASS-1 D
  1.  . . S LA7Y=(LA7I*MAXLEN)+1
  1.  . . D LAH(SUB,1,$E(TEXT2,LA7Y,(LA7Y+MAXLEN)-1))
  1.  . . D ADDINFO(SUBROOT,ISQN2)
  1.  . . S LA7Y=LA7Y+MAXLEN
  1.  . . S ISQN2=ISQN2+1,SUB=SUBROOT_","_ISQN2_",0"
  1.  ;
  1.  D NTE^LA7VIN71(LA76247,ISQN)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. LAH(LASUB,LAP,LAVAL) ;
  1.  ; Convenience method
  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. ADDINFO(SUBSCR,ISQN2) ;
  1.  ; Add result info (lab, person, status, etc.) to comment nodes.
  1.  ;  Used for adding info to each comment line (0,0 node)
  1.  ; Inputs
  1.  ;   SUBSCR: The LAH subscript (eg 25 for Concept 42)
  1.  ;    ISQN2: The comment sequence number.
  1.  N SUB,X,Y
  1.  S SUBSCR=$G(SUBSCR)
  1.  S ISQN2=$G(ISQN2)
  1.  S SUB=SUBSCR_","_ISQN2_",0,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.  Q