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

LAGEN.m

Go to the documentation of this file. 
  1. LAGEN ;VA/DALOI/CJS - LAB AUTOMATED DATA ; 1 Feb 2005
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**1002,1027,1031**;NOV 01, 1997
  1.  ;
  1.  ;;VA LA Patche(s): 1,17,22,27,47,46,64,67
  1.  ;
  1.  Q
  1.  ;
  1. LOG ; Run by accession number.
  1.  S LINK="",LRDFN=0,DPF=2
  1.  I $G(LOG)<1 G LG2
  1.  ; If overlay data -> find if accession exists in LAH
  1.  I LROVER D  Q:ISQN>0
  1.  . N I,X
  1.  . S (ISQN,I)=0
  1.  . F  S I=$O(^LAH(LWL,1,"C",LOG,I)) Q:I<1  D  Q:ISQN
  1.  . . S X=$G(^LAH(LWL,1,I,0))
  1.  . . ; Quit if different accession area.
  1.  . . I $P(X,"^",3)'=WL Q
  1.  . . ; Quit if different accession date and not a rollover accession (same original accession date).
  1.  . . I $P(X,"^",4)'=LADT,$P($G(^LRO(68,WL,1,LADT,1,LOG,0)),"^",3)'=$P($G(^LRO(68,WL,1,$P(X,"^",4),1,LOG,0)),"^",3) Q
  1.  . . S ISQN=I
  1.  . . D UPDT(LWL,ISQN)
  1.  I '$D(^LRO(68,WL,1,LADT,1,LOG,0)) S LINK="^^"_+LOG G LG2
  1.  S X=^LRO(68,WL,1,LADT,1,LOG,0),LINK=WL_U_LADT_U_LOG,LRDFN=+X,DPF=$P(X,U,2)
  1. LG2 D ISQN
  1.  I $G(LOG)>0 S ^LAH(LWL,1,"C",LOG,ISQN)="",$P(^LAH(LWL,1,ISQN,0),U,3,5)=LINK
  1.  I $G(CENUM)>0 S $P(^LAH(LWL,1,ISQN,0),U,6)=CENUM,^LAH(LWL,1,"D",+CENUM,ISQN)=""
  1.  I $D(^LRO(68.2,LWL,1,+TRAY,1,+CUP,0)) S ^(4,ISQN)=""
  1.  Q
  1.  ;
  1.  ;
  1. ISQN ;
  1.  L +^LAH(LWL):99999
  1.  ;
  1.  F  S (^LAH(LWL),ISQN)=1+$G(^LAH(LWL)) Q:'$D(^LAH(LWL,1,ISQN))
  1.  ;
  1.  S:CUP="" TRAY=1,CUP=ISQN
  1.  S ^LAH(LWL,1,ISQN,0)=TRAY_U_CUP_"^^^^^"_METH_"^"_+$G(IDE)
  1.  ;
  1.  D UPDT(LWL,ISQN)
  1.  ;
  1.  S ^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP),ISQN)=""
  1.  ;
  1.  ; IDE xref added to enable correct identifier for CX4/CX5 instruments
  1.  S ^LAH(LWL,1,"E",+$G(IDE),ISQN)=""
  1.  ;
  1.  ; Set UID xref and .3 node, used to verify by unique identifier (UID).
  1.  I $G(LA7UID)'="" D UID(LWL,ISQN,LA7UID)
  1.  ;
  1.  L -^LAH(LWL)
  1.  Q
  1.  ;
  1.  ;
  1. LLIST ;
  1.  S LRDFN=0,DPF=2
  1.  ;
  1.  I LROVER D  Q:ISQN>0
  1.  . S ISQN=+$O(^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP),0))
  1.  . I ISQN D UPDT(LWL,ISQN)
  1.  ;
  1.  ; Run by load/work list number sent.
  1.  D ISQN S LINK="^^"
  1.  ;
  1.  I $D(^LRO(68.2,LWL,1,TRAY,1,CUP,0)) S LINK=$P(^(0),"^",1,3),^(4,ISQN)=""
  1.  ;
  1.  S $P(^LAH(LWL,1,ISQN,0),U,3,5)=LINK
  1.  ;
  1.  S DPF=2
  1.  Q:LINK="^^"
  1.  S WL=+$P(LINK,"^",1),WDT=+$P(LINK,"^",2),LOG=+$P(LINK,"^",3),^LAH(LWL,1,"C",LOG,ISQN)=""
  1.  S X=$S($D(^LRO(68,WL,1,WDT,1,LOG,0)):^(0),1:"0^2"),DPF=+$P(X,U,2),LRDFN=+X
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SEQN ;
  1.  ; Run by the order data received
  1.  S CUP=""
  1.  D LLIST
  1.  Q
  1.  ;
  1.  ;
  1. CENUM ;
  1.  S DPF=2,LRDFN=0,LOG=$O(^LRO(68,WL,1,DT,1,"D",+CENUM,0))
  1.  G LOG:LOG>0 ;for martinez only
  1.  ;IF CENUM?1A.ANP S Y=CENUM D CEPACK I Y?.ANP S DFN=$O(^LAB(62.3,"B",Y,0)) I DFN S DPF=62.3
  1.  ;
  1.  D ISQN
  1.  ;
  1.  S ^LAH(LWL,1,"C",LOG,ISQN)="",^LAH(LWL,1,"D",+CENUM,ISQN)="",$P(^LAH(LWL,1,ISQN,0),U,6)=CENUM
  1.  ;
  1.  I $D(^LRO(68.2,LWL,1,TRAY,1,CUP,0)) S ^(4,ISQN)=""
  1.  Q
  1.  ;
  1.  ;
  1. IDENT ;
  1.  S DPF=2,LRDFN=0,LOG=$O(^LRO(68,WL,1,DT,1,"C",IDENT,0))
  1.  I LOG>0 D LOG Q
  1.  D ISQN
  1.  Q
  1.  ;
  1.  ;
  1. POC ; Entry point for POC interfaces to setup LAH using "E" x-ref
  1.  ; IDE xref used to identify for POC specimen
  1.  I $G(IDE)'="" D  Q:ISQN
  1.  . S ISQN=$O(^LAH(LWL,1,"E",IDE,0))
  1.  . I ISQN D UPDT(LWL,ISQN) Q
  1.  D LOG
  1.  Q
  1.  ;
  1.  ;
  1. CONTROL ; Verify control's
  1.  ;
  1.  Q:'$D(^LRO(68,WL,1,DT,1,LOG,0))  Q:$P(^(0),U,2)'=62.3
  1.  ;
  1.  S LRDFN=+^LRO(68,WL,1,DT,1,LOG,0)
  1.  S IDT=+$P($G(^LRO(68,WL,1,DT,1,LOG,3)),"^",3)
  1.  I IDT<1 Q
  1.  I '$D(^LR(LRDFN,"CH",IDT,0)) Q
  1.  S $P(^LRO(68,WL,1,DT,1,LOG,3),U,4)=NOW
  1.  S $P(^LR(LRDFN,"CH",IDT,0),U,3)=NOW
  1.  ;
  1.  F I=1:0 S I=$O(^LAH(LWL,1,ISQN,I)) Q:I<1  S ^LR(LRDFN,"CH",IDT,I)=^LAH(LWL,1,ISQN,I)
  1.  ;
  1.  S:'$D(LRTEC) LRTEC=$P(^VA(200,DUZ,0),U,2)
  1.  ;
  1.  F I=0:0 S I=$O(^LRO(68,WL,1,DT,1,LOG,4,I)) Q:I<1  I +$P(^(I,0),U,3)[LWL,'$P(^(0),U,5) S $P(^(0),U,5)=NOW,$P(^(0),U,4)=LRTEC,^LRO(68,WL,1,DT,1,"AC",NOW,LOG)="",^LRO(68,WL,1,DT,1,"AD",NOW\1,LOG)=""
  1.  D CONTXREF
  1.  K:$G(LOG) ^LAH(LWL,1,"C",+LOG)
  1.  K ^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP)),^LAH(LWL,1,ISQN)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CEPACK S Y=$P(Y,"\",1),YY="" F I=1:1:$L(Y) S:$A(Y,I)>32 YY=YY_$E(Y,I)
  1.  S Y=YY
  1.  K YY
  1.  Q
  1.  ;
  1.  ;
  1. CONTXREF ; Set up verification X-Ref for controls
  1.  ;
  1.  N DA,LRTEST,LRTN,I,LRGTN,X1,X,S1,J,J1
  1.  ;
  1.  S LRTEST=""
  1.  F LRTN=0:0 S LRTN=$O(^LRO(68,WL,1,DT,1,LOG,4,LRTN)) Q:LRTN<1  I $D(^(LRTN,0)),+$P(^(0),U,3)[LWL,+$P(^(0),U,5) S:LRTEST'="" LRTEST=LRTEST_"^"_LRTN S:LRTEST="" LRTEST=LRTN
  1. AC ;
  1.  K ^TMP("LR",$J,"T")
  1.  D ^LREXPD
  1.  F X=0:0 S X=$O(^TMP("LR",$J,"T",X)) Q:X<1  S X1=$P(^(X),";",2) I X1,$D(^LR(LRDFN,"CH",IDT,X1)) S:'$D(^LRO(68,"AC",LRDFN,IDT,X1)) ^(X1)=""
  1.  K ^TMP("LR",$J,"T")
  1.  Q
  1.  ;
  1.  ;
  1. UPDT(LWL,ISQN) ; Set/update date/time this entry in LAH has data added.
  1.  ; Used by clear instrument data option to allow selective clearing based on date/time criteria.
  1.  ; Call with LWL = ien of load/list in LAH
  1.  ;          ISQN = ien of sequence
  1.  N LANOW,LAX
  1.  ;
  1.  S LANOW=$$NOW^XLFDT
  1.  S LAX=$P($G(^LAH(LWL,1,ISQN,0)),"^",10,11)
  1.  ;
  1.  ; Created date/time_"^"_update date/time.
  1.  S LAX=$S($P(LAX,"^",1):$P(LAX,"^",1),1:LANOW)_"^"_LANOW
  1.  S $P(^LAH(LWL,1,ISQN,0),"^",10,11)=LAX
  1.  Q
  1.  ;
  1.  ;
  1. UID(LWL,ISQN,UID) ; Set .3 node and "U" xref with accession's UID.
  1.  ; Used to verify by unique identifier (UID).
  1.  ; Call with LWL = ien of load/list in LAH
  1.  ;          ISQN = ien of sequence
  1.  ;           UID = accession's UID
  1.  ; Called from above, LRVR1, LRVRW
  1.  ;
  1.  N X
  1.  ;
  1.  S X=$P($G(^LAH(LWL,1,ISQN,.3)),"^")
  1.  ; Kill x-ref if existing value different than new value.
  1.  I X]"",X'=UID K ^LAH(LWL,1,"U",X,ISQN)
  1.  ;
  1.  S $P(^LAH(LWL,1,ISQN,.3),"^")=UID
  1.  S ^LAH(LWL,1,"U",UID,ISQN)=""
  1.  Q
  1.  ;
  1.  ;
  1. POI(LWL,ISQN,NODE,LAID) ; Set .1 node with patient/order info
  1.  ; Call with LWL = ien of load/list in LAH
  1.  ;          ISQN = ien of sequence
  1.  ;          NODE = node to store data on (PID, OBR)
  1.  ;          LAID = array containing values
  1.  ;                 PID - "DFN","DOB","ICN","LRDFN","LRTDFN","PNM","SEX","SSN"
  1.  ;                 OBR - "EOL","FID","ORCDT","ORDNLT","ORDP","PON","SID","PEB","PVB"
  1.  ;
  1.  ; ^LAH(LWL,1,ISQN,.1,"OBR","EOL") = enterer's ordering location
  1.  ; ^LAH(LWL,1,ISQN,.1,"OBR","FID") = filler specimen id
  1.  ; ^LAH(LWL,1,ISQN,.1,"OBR","ORCDT") = order date/time (FileMan d/t)
  1.  ; ^LAH(LWL,1,ISQN,.1,"OBR","ORDNLT") = order NLT (multiple separated by "^")
  1.  ; ^LAH(LWL,1,ISQN,.1,"OBR","ORDP") = ordering provider (DUZ or id^last name, first name, mi [id])
  1.  ; ^LAH(LWL,1,ISQN,.1,"OBR","PEB") = placer entered by (DUZ or id^last name, first name, mi [id])
  1.  ; ^LAH(LWL,1,ISQN,.1,"OBR","PON") = placer order number
  1.  ; ^LAH(LWL,1,ISQN,.1,"OBR","PVB") = placer verified by (DUZ or id^last name, first name, mi [id])
  1.  ; ^LAH(LWL,1,ISQN,.1,"OBR","SID") = placer specimen id
  1.  ; ^LAH(LWL,1,ISQN,.1,"PID","DFN") = patient's DFN in file #2
  1.  ; ^LAH(LWL,1,ISQN,.1,"PID","DOB") = date of birth (FileMan d/t)
  1.  ; ^LAH(LWL,1,ISQN,.1,"PID","ICN") = patient's ICN
  1.  ; ^LAH(LWL,1,ISQN,.1,"PID","LRDFN") = patient's LRDFN in file #63
  1.  ; ^LAH(LWL,1,ISQN,.1,"PID","LRTDFN") = patient's LRTDFN in file #67
  1.  ; ^LAH(LWL,1,ISQN,.1,"PID","PNM") = patient's name
  1.  ; ^LAH(LWL,1,ISQN,.1,"PID","SEX") = patient's sex
  1.  ; ^LAH(LWL,1,ISQN,.1,"PID","SSN") = patient's SSN
  1.  ;
  1.  N LAX,LAY,LAZ
  1.  ;
  1.  S LAX=""
  1.  F  S LAX=$O(LAID(LAX)) Q:LAX=""  D
  1.  . S LAY=LAID(LAX)
  1.  . I LAY="" Q
  1.  . S LAZ=$G(^LAH(LWL,1,ISQN,.1,NODE,LAX))
  1.  . I LAY=LAZ Q
  1.  . ; Remove old data and cross-references.
  1.  . I LAZ'="" D
  1.  . . K ^LAH(LWL,1,ISQN,.1,NODE,LAX)
  1.  . . I $P(LAZ,"^")]"" K ^LAH(LWL,1,"A"_LAX,$P(LAZ,"^"),ISQN)
  1.  . ; Set new values and cross-references.
  1.  . S ^LAH(LWL,1,ISQN,.1,NODE,LAX)=LAY
  1.  . I $P(LAY,"^")'="" S ^LAH(LWL,1,"A"_LAX,$P(LAY,"^"),ISQN)=""
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. LATYP(LWL,ISQN,LAX) ; Set type of interface for this entry
  1.  ; Call with LWL = ien of load/list in LAH
  1.  ;          ISQN = ien of sequence
  1.  ;           LAX = type of interface
  1.  ; 
  1.  S $P(^LAH(LWL,1,ISQN,0),"^",12)=LAX
  1.  Q
  1.  ;
  1.  ;
  1. LAMSGID(LWL,ISQN,LAX) ; Set pointer to file #62.49 for this entry.
  1.  ; Call with LWL = ien of load/list in LAH
  1.  ;          ISQN = ien of sequence
  1.  ;           LAX = ien of entry in file #62.49 that is source of these results
  1.  ; 
  1.  S $P(^LAH(LWL,1,ISQN,0),"^",13)=LAX
  1.  S ^LAH(LWL,1,ISQN,.01,LAX)=""
  1.  Q
  1.  ;
  1.  ;
  1. METH(LWL,ISQN,LAX) ; Save instrument name/method for this entry
  1.  ; Call with LWL = ien of load/list in LAH
  1.  ;          ISQN = ien of sequence
  1.  ;           LAX = method text
  1.  ;
  1.  N X
  1.  S X=$P(^LAH(LWL,1,ISQN,0),"^",7)
  1.  I X'[LAX S X=LAX_";"_X,$P(^LAH(LWL,1,ISQN,0),"^",7)=X
  1.  Q