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

LA7VIN7D.m

Go to the documentation of this file. 
  1. LA7VIN7D ;DALOI/JDB - Process ORU's OBX for Micro ;11/18/11  14:41
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
  1.  ;
  1.  ; Continuation of LA7VIN7 and is only called from there.
  1.  ; Process OBX segments for "MI" subscript tests.
  1.  Q
  1.  ;
  1. 8 ;
  1.  ; Process Parasite (Subscript 6)
  1.  N X,SUB,ISQN2
  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",6,SUBID)
  1.  I SUBID="" I $G(PSUBID)'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",6,PSUBID)
  1.  K LA7VPSTG ; used to track ISQN3 for Parasite Stage Quantity
  1.  I 'ISQN2 D  Q  ;
  1.  . D SUBIDERR^LA7VIN71
  1.  ;
  1.  S SUB="6,0"
  1.  D LAH(SUB,-1,"")
  1.  S SUB="6,"_ISQN2_",0"
  1.  D LAH(SUB,1,LA7612) ; #61.2 IEN
  1.  S SUB="6,"_ISQN2_",0,.01"
  1.  D LAH(SUB,1,LA7RLNC) ; LOINC
  1.  D LAH(SUB,2,LA7SCT)
  1.  S SUB="6,"_ISQN2_",0,.01,0"
  1.  D LAH(SUB,1,OBX11) ;obsv result status
  1.  S SUB="6,"_ISQN2_",0,.01,1"
  1.  D LAH(SUB,1,LA74) ; perf lab
  1.  S X=$P(LA7RO,"^",3)
  1.  D LAH(SUB,2,X) ;resp observer
  1.  S SUB="6,"_ISQN2_",.1"
  1.  D LAH(SUB,1,SUBID) ; isolate ID
  1.  D NTE
  1.  Q
  1.  ;
  1. 12(COM) ;
  1.  ; Process Parasite Rpt Remark (Subscript 7)
  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="7,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",7,"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="7,"_ISQN2_",0"
  1.  ; insert separator line if needed
  1.  I ISQN2>1 D LAH(SUB,1," ") S ISQN2=ISQN2+1 S SUB="7,"_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="7,"_ISQN2_",0"
  1.  . ;
  1.  D NTE^LA7VIN71(LA76247,ISQN)
  1.  Q
  1.  ;
  1. 13 ;
  1.  ; Process Parasite's Stage
  1.  N X,SUB,ISQN2,ISQN3,SEQ2,LADATA,STAGE
  1.  S ISQN2=0
  1.  I SUBID'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",6,SUBID)
  1.  I SUBID="" I $G(PSUBID)'="" S ISQN2=$$SUBID^LAGEN(LWL,1,LA7ISQN,"MI",6,PSUBID)
  1.  I 'ISQN2 D  Q  ;
  1.  . D SUBIDERR^LA7VIN71
  1.  ;
  1.  D LAH("6,0",-1,"")
  1.  S SUB="6,"_ISQN2_",1,0"
  1.  D LAH(SUB,1,"@") ;@=force empty field
  1.  S ISQN3=+$O(^LAH(LWL,1,LA7ISQN,"MI",6,ISQN2,1,"A"),-1)+1
  1.  S LA7VPSTG=ISQN3 ; save this for processing parasite stage count
  1.  S STAGE=""
  1.  K LADATA
  1.  I $G(LA7SCT)'="" D  ;
  1.  . S STAGE=$$SCT2PSTG^LA7VHLU6(LA7SCT,"","SCT",DT)
  1.  . D CHK^DIE(63.35,.01,"",STAGE,.LADATA)
  1.  . I LADATA="^" S STAGE=""
  1.  I $G(LA7SCT)="" D  ;
  1.  . ; Try Set of Codes translation
  1.  . D CHK^DIE(63.35,.01,"",OBX5,.LADATA)
  1.  . I LADATA'="^" S STAGE=LADATA
  1.  ;
  1.  ; file if stage found
  1.  I STAGE'="" D  ;
  1.  . N STOP,SEQ
  1.  . S SEQ=0
  1.  . S X=""
  1.  . S STOP=0
  1.  . ; Find existing stage entry if already in LAH
  1.  . F  S SEQ=$O(^LAH(LWL,1,LA7ISQN,"MI",6,ISQN2,1,SEQ)) Q:'SEQ  D  Q:STOP  ;
  1.  . . S X=$G(^LAH(LWL,1,LA7ISQN,"MI",6,ISQN2,1,SEQ,0))
  1.  . . I $P(X,"^",1)=STAGE S STOP=1 S ISQN3=SEQ
  1.  . ;
  1.  . S LA7VPSTG=ISQN3 ; save for processing Parasite Stage Qty
  1.  . S SUB="6,"_ISQN2_",1,"_ISQN3_",0"
  1.  . S X=STAGE
  1.  . D LAH(SUB,1,X)
  1.  . ;
  1.  . S SUB="6,"_ISQN2_",1,"_ISQN3_",0,.01"
  1.  . I $G(LA7NLT)'="" D LAH(SUB,2,LA7NLT)
  1.  . I $G(LA7SCT)'="" D LAH(SUB,3,LA7SCT) ;SCT stage code
  1.  . ;
  1.  . S SUB="6,"_ISQN2_",1,"_ISQN3_",0,.01,0"
  1.  . D LAH(SUB,1,OBX11) ;obsv status
  1.  . S SUB="6,"_ISQN2_",1,"_ISQN3_",0,.01,1"
  1.  . D LAH(SUB,1,LA74) ; perf lab
  1.  . S X=$P(LA7RO,"^",3)
  1.  . D LAH(SUB,2,X) ; resp observer
  1.  ;
  1.  I STAGE="" I LADATA="^" D  ;
  1.  . S ISQN3=""
  1.  . S X=SUBID
  1.  . S:X="" X=$G(PSUBID)
  1.  . S:X'="" X="["_X_"]UNKNOWN STAGE QTY: "
  1.  . D 12(X_$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH))
  1.  . Q
  1.  . ;
  1.  ;
  1.  ; for NTE info need to pass back ISQN3 also
  1.  I ISQN3 S LA7RMK(0,0)=LA76247_"^"_ISQN2_","_ISQN3
  1.  I 'ISQN3 D NTE
  1.  Q
  1.  ;
  1. 14 ;
  1.  ; Process Parasite Stage Quantity
  1.  N X,SUB,ISQN2,ISQN3
  1.  S ISQN2=0
  1.  I SUBID'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",6,SUBID)
  1.  I SUBID="" I $G(PSUBID)'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",6,PSUBID)
  1.  I 'ISQN2 D  Q  ;
  1.  . D SUBIDERR^LA7VIN71
  1.  ;
  1.  ; use associated "Parasite Stage" ISQN3 from previous OBX
  1.  S ISQN3=+$G(LA7VPSTG) ;top level variable
  1.  ; Stage filed so now qty can be filed
  1.  I ISQN3 D  ;
  1.  . S SUB="6,"_ISQN2_",1,"_ISQN3_",0"
  1.  . D LAH(SUB,2,OBX5)
  1.  ;
  1.  I 'ISQN3 D  ;
  1.  . ;file as comment in #63.36
  1.  . ;if we couldnt file the stage we cant file the qty
  1.  . N MAXLEN,SEQ2
  1.  . S MAXLEN=68 ; COMMENTS field size
  1.  . S SEQ2=+$O(^LAH(LWL,LA7ISQN,"MI",ISQN2,7,"A"),-1)+1
  1.  . S SUB="7,"_SEQ2_",0"
  1.  . ; insert separator line if needed
  1.  . I SEQ2>1 D LAH(SUB,1,"") S SEQ2=SEQ2+1 S SUB="7,"_SEQ2_",0"
  1.  . ; modify MAXLEN for prefixed Subid
  1.  . S X=SUBID
  1.  . S:X="" X=$G(PSUBID)
  1.  . S:X'="" X="["_X_"]"
  1.  . S X=X_"UNKNOWN STAGE QTY: "
  1.  . I $L(X_OBX5)'>MAXLEN D  ;
  1.  . . D LAH(SUB,1,X_OBX5)
  1.  . I $L(X_OBX5)>MAXLEN D  ;
  1.  . . N I,Y,PASS
  1.  . . S X=X_OBX5
  1.  . . S PASS=$L(X)\MAXLEN
  1.  . . S:($L(X)#MAXLEN)>0 PASS=PASS+1
  1.  . . F I=0:1:PASS-1 S Y=(I*MAXLEN)+1 D  ;
  1.  . . . I I=0 D LAH(SUB,1,$E(X,Y,(Y+MAXLEN)-1)) ;subid prefix
  1.  . . . I I>0 D LAH(SUB,1,$E(X,Y,(Y+MAXLEN)-1))
  1.  . . . S Y=Y+MAXLEN
  1.  . . . S SEQ2=SEQ2+1
  1.  . . . S SUB="7,"_SEQ2_",0"
  1.  . . ;
  1.  . ;
  1.  ;
  1.  ; For NTE need to send back ISQN3 also
  1.  I ISQN3 S LA7RMK(0,0)=LA76247_"^"_ISQN2_","_ISQN3
  1.  I 'ISQN3 D NTE
  1.  Q
  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. 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. NTE ;
  1.  ; Convenience method
  1.  D NTE^LA7VIN71(LA76247,ISQN2)
  1.  Q