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 ;DALOI/STAFF - LAB AUTOMATED DATA ;11/18/11 15:03
  1. ;;5.2;AUTOMATED LAB INSTRUMENTS;**1,17,22,27,47,46,64,67,74**;Sep 27, 1994;Build 229
  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","ARI") = assistant result interpreter (DUZ or id^last name, first name, mi [id]) (OBR-33)
  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]) (OBR-16)
  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","PRI") = principle result interpreter (DUZ or id^last name, first name, mi [id]) (OBR-32)
  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,"OBR","TECH") = technican (DUZ or id^last name, first name, mi [id]) (OBR-34)
  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
  1. ;
  1. ;
  1. SUBID(LWL,ISQN,LRSS,NODE,SUBID) ; Set/lookup entry for a sub-id (isolate id)
  1. ; Call with LWL = ien of load/list in LAH
  1. ; ISQN = ien of sequence
  1. ; LRSS = subscript in LAH
  1. ; NODE = data node in LAH
  1. ; SUBID = sub-id to lookup/use to link entry
  1. ;
  1. ; Returns ISQN2 = entry linked to sub-id
  1. ;
  1. N ISQN2
  1. Q:SUBID="" -1
  1. S ISQN2=$O(^LAH(LWL,1,ISQN,LRSS,NODE,"C",SUBID,0))
  1. I 'ISQN2 D
  1. . S ISQN2=$O(^LAH(LWL,1,ISQN,LRSS,NODE,"A"),-1)
  1. . S ISQN2=ISQN2+1
  1. . S ^LAH(LWL,1,ISQN,LRSS,NODE,"C",SUBID,ISQN2)=""
  1. . S ^LAH(LWL,1,ISQN,LRSS,"C",SUBID,NODE,ISQN2)=""
  1. Q ISQN2
  1. ;
  1. LAH(LAWL,LADA,LASS,LASUB,LAP,LAVAL) ;
  1. ; sets data into LAH
  1. ; Inputs
  1. ; LAWL : WorkLoad List
  1. ; LADA :
  1. ; LASS : SubScript
  1. ; LASUB :
  1. ; LAP : Data position ($Piece of node)
  1. ; : if -1 will set the entire node=LAVAL (for WP type data)
  1. ; LAVAL : The VALue to set
  1. N NODE
  1. I LAVAL="@" S LAVAL=""
  1. I LAVAL="""""" S LAVAL=""
  1. I LAP'=-1 I LAVAL["^" S LAVAL=$TR(LAVAL,"^"," ")
  1. S LAWL=+$G(LAWL)
  1. S LADA=+$G(LADA)
  1. S LASS=$G(LASS)
  1. S LASUB=$G(LASUB)
  1. S NODE="^LAH(LAWL,1,LADA,"""_LASS_""","
  1. S NODE=NODE_LASUB
  1. S:$E(NODE,$L(NODE),$L(NODE))'=")" NODE=NODE_")"
  1. I LAP>0 S $P(@NODE,"^",+$G(LAP))=LAVAL
  1. I LAP=-1 S @NODE=LAVAL
  1. Q