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

LRERT.m

Go to the documentation of this file. 
  1. LRERT ;DALOI/JDB - STS TEAM UTILITIES ;06/10/09  14:44
  1.  ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
  1.  ;
  1.  Q
  1.  ;
  1. BLDERTX(LRFILE,LRFIEN,LRDELIM,LRERT,LRTYPE,LRFLAGS) ;
  1.  ; Constructs a string or array used for the ERT data extract
  1.  ; FileMan safe
  1.  ; Called by NOTIFY^LRSCTX1
  1.  ; Inputs
  1.  ;   LRFILE: File #
  1.  ;   LRFIEN: Entry's IEN
  1.  ;  LRDELIM: Delimiter to use <dflt=|>
  1.  ;    LRERT:<byref>  See Outputs
  1.  ;   LRTYPE: Return the string or the array elements
  1.  ;         :  1=String  2=Array <dflt=2>
  1.  ;         : Return data can be big so need to limit in order
  1.  ;         : to watch symbol table use.
  1.  ;  LRFLAGS: Controls behavior of the API
  1.  ;         : S=Populate SCT text with text from Lexicon
  1.  ; Outputs
  1.  ;   The ERT extract string.
  1.  ;   The ERT array:  ERT(1)=id  ERT(2)=Entry name, etc..
  1.  ; ERT extract format (from ^LRSRVR6)
  1.  ; Station #-File #-IEN|Entry Name|SNOMED I|VUID|SNOMED CT|SNOMED CT TERM|Mapping Exception|Related Specimen|Related Specimen ID|Extract Ver|Term Status|
  1.  ;
  1.  N LRCNT,LRDATA,LRDATA2,LRDSUB,LRI,LRMSG,LRSCT,LRSITE,LRT,LRX,LRY
  1.  N DA,DIC,DIE,DIERR,DIR,DR,X,X1,X2,Y
  1.  S LRT=$T ;preserve $T
  1.  S LRDELIM=$G(LRDELIM),LRTYPE=$G(LRTYPE,2)
  1.  S LRFLAGS=$G(LRFLAGS)_" " ;so LRFLAGS'="" for [ operations
  1.  I LRDELIM="" S LRDELIM="|"
  1.  S LRDSUB=LRDELIM
  1.  I LRDELIM="|" S LRDSUB="!" ;used for DELIM $TR
  1.  I LRDELIM="^" S LRDSUB="~"
  1.  ;
  1.  ; Initialize LRERT array. STS expects all elements to be defined or null
  1.  K LRERT
  1.  F LRI=1:1:11 S LRERT(LRI)=""
  1.  ;
  1.  S LRX=$$KSP^XUPARAM("INST")
  1.  S LRX=$$NS^XUAF4(LRX)
  1.  S LRSITE=$P(LRX,"^",2)
  1.  S LRX=LRSITE_"-"_LRFILE_"-"_LRFIEN
  1.  S LRERT(1)=LRX
  1.  D GETS^DIQ(LRFILE,LRFIEN_",","@;.01;2;20;21","EI","LRDATA","LRMSG")
  1.  M LRDATA2=LRDATA(LRFILE,LRFIEN_",")
  1.  K LRDATA
  1.  S LRCNT=1
  1.  F LRI=.01,2,0,20 D  ;  0=dummy placeholder for unused VUID field
  1.  . S LRCNT=LRCNT+1
  1.  . I LRI=0 Q
  1.  . S LRX=$G(LRDATA2(LRI,"E"))
  1.  . I LRI=2,LRX'="" D
  1.  . . I LRFILE=62 S LRX="" Q  ;fld #2 not used in #62
  1.  . . I LRFILE>60.9,LRFILE<61.61 S LRY=((LRFILE*10)#610)+1,LRX=$E("TMEFDPJ",LRY)_"-"_LRX
  1.  . I LRX'="" S LRERT(LRCNT)=$TR(LRX,LRDELIM,LRDSUB)
  1.  ;
  1.  ; Send SCT term name if code and flag to send
  1.  S LRSCT=$G(LRDATA2(20,"E"))
  1.  I LRSCT'="",LRFLAGS["S" D
  1.  . K LRDATA
  1.  . S LRX=$$CODE^LRSCT(LRSCT,"SCT",,"LRDATA")
  1.  . Q:LRX<1
  1.  . S LRX=$G(LRDATA("F"))
  1.  . I LRX="" S LRX=$G(LRDATA("P"))
  1.  . I LRX'="" S LRERT(6)=$TR(LRX,LRDELIM,LRDSUB)
  1.  ;
  1.  ; If COLLECTION SAMPLE (#62) then send related specimen and specimen id
  1.  I LRFILE=62 D
  1.  . N LR61
  1.  . S LR61=$P($G(^LAB(LRFILE,LRFIEN,0)),"^",2) Q:LR61<1
  1.  . S LRERT(8)=$P($G(^LAB(61,LR61,0)),"^")
  1.  . S LRERT(9)=LRSITE_"-61-"_LR61
  1.  ;
  1.  S LRERT(10)=$$VER^LRSRVR6
  1.  S LRERT(11)=$G(LRDATA2(21,"I"))
  1.  ;
  1.  I LRTYPE=1 D
  1.  . S LRI=0
  1.  . F  S LRI=$O(LRERT(LRI)) Q:LRI<1  S $P(LRERT,LRDELIM,LRI)=LRERT(LRI) K LRERT(LRI)
  1.  ;
  1.  I LRT ;restore $T
  1.  Q $S(LRTYPE=1:LRERT,1:"")
  1.  ;
  1.  ;
  1. TNUM(FILE,IEN,NOW,EXCTYP) ;
  1.  ; Construct transaction number
  1.  ; Inputs
  1.  ;   FILE: File #
  1.  ;    IEN: IEN of entry
  1.  ;    NOW: Date/Time of process <dflt=Now>
  1.  ; EXCTYP: ERT Exception Type (1=load, 2=ref lab, 3=local edit)
  1.  ; Returns Transaction number string
  1.  N TNUM,X
  1.  S FILE=$G(FILE)
  1.  S IEN=$G(IEN)
  1.  S NOW=$G(NOW)
  1.  S EXCTYP=$G(EXCTYP)
  1.  I NOW="" S NOW=$$NOW^XLFDT()
  1.  I EXCTYP'>0 Q ""
  1.  S X=$$KSP^XUPARAM("INST")
  1.  S X=$$NS^XUAF4(X)
  1.  S X=$P(X,"^",2)
  1.  ; transaction #: Site-Exc Type-NOW-File#:IEN
  1.  S TNUM=X_"-"_EXCTYP_"-"_NOW_"-"_FILE_":"_IEN ;transaction #
  1.  S TNUM=$$UP^XLFSTR(TNUM)
  1.  Q TNUM
  1.  ;
  1.  ;
  1. LOGIT(TEXT,IN,TMPNM) ;
  1.  ; FileMan safe
  1.  ; Adds data to the ^XTMP gobal.
  1.  ; Inputs
  1.  ;  TEXT:<byref> Save symtbl space (dont manipulate)
  1.  ;  IN: <byref>
  1.  ;           IN("TNUM") - Transaction Number <req>
  1.  ;           IN("TDT") - Transaction date/time <opt>
  1.  ;           IN("FILE") targ file <req>
  1.  ;           IN("FIEN") ;targ file IEN <req>
  1.  ;           IN("SCT") ;SCT code <opt>
  1.  ;           IN("R6247") ;#62.49 IEN <opt>
  1.  ;           IN("STSEXC") ;STS exception type <req>
  1.  ;           IN("HDIERR") ;STS error flag <opt> 0 or 1
  1.  ;           IN("PREV","SCT")
  1.  ;           IN("PREV","TEXT")
  1.  ; TMPNM:<opt> XTMP subscript <dflt=LRSCTX-STS>
  1.  ; Outputs
  1.  ;  Record # or "0^err #^err msg"
  1.  N FILE,FIEN,LRLCK,REC,TEXT2,SCTCHNG,STR,STSEXC,TDT,TNUM,X
  1.  ;
  1.  S TMPNM=$G(TMPNM)
  1.  I TMPNM="" S TMPNM="LRSCTX-STS"
  1.  ;
  1.  ; Update ^XTMP
  1.  S ^XTMP(TMPNM,0)=$$FMADD^XLFDT(DT,365)_U_$$NOW^XLFDT()_U_"STS Term/SCT Alerts"
  1.  S STR=$$TRIM^XLFSTR(TEXT)
  1.  S LRLCK=$NA(^XTMP(TMPNM))
  1.  S X=$$GETLOCK^LRUTIL(LRLCK,60)
  1.  I 'X Q "0^1^Failed to acquire lock."
  1.  S FILE=+$G(IN("FILE")),FIEN=+$G(IN("FIEN")),TNUM=$G(IN("TNUM"))
  1.  S TDT=$G(IN("TDT"))
  1.  I TDT="" S TDT=$$NOW^XLFDT()
  1.  S STSEXC=$G(IN("STSEXC"))
  1.  S:STSEXC="" STSEXC=0
  1.  I TNUM="" S TNUM=$$TNUM(FILE,FIEN,TDT,STSEXC) S LRERT("TNUM")=TNUM
  1.  ;
  1.  S REC=+$O(^XTMP(TMPNM,"A"),-1)+1
  1.  S ^XTMP(TMPNM,REC,0)=$E(STR,1,200)
  1.  S ^XTMP(TMPNM,REC,1)=$E(STR,201,$L(STR))
  1.  S $P(^XTMP(TMPNM,REC,2),U,1)=TNUM ;transaction #
  1.  S $P(^XTMP(TMPNM,REC,2),U,2)=TDT ;transaction date/time
  1.  S $P(^XTMP(TMPNM,REC,2),U,3)=FILE ;targ file
  1.  S $P(^XTMP(TMPNM,REC,2),U,4)=FIEN ;targ file IEN
  1.  S $P(^XTMP(TMPNM,REC,2),U,5)=$G(IN("SCT")) ;SCT code
  1.  S $P(^XTMP(TMPNM,REC,2),U,6)=$G(IN("R6247")) ;#62.49 IEN
  1.  S $P(^XTMP(TMPNM,REC,2),U,7)=DUZ
  1.  S $P(^XTMP(TMPNM,REC,2),U,8)=STSEXC ;STS exception type
  1.  S X=""
  1.  I $G(IN("HDIERR"))'="" S X=IN("HDIERR")
  1.  I X="" I $D(IN("HDIERR")) S X=$S($D(IN("HDIERR")):1,1:0)
  1.  S $P(^XTMP(TMPNM,REC,2),U,9)=X ;STS error
  1.  S ^XTMP(TMPNM,REC,10)=$G(IN("PREV","SCT")) ;previous SCT code
  1.  S ^XTMP(TMPNM,REC,20)=$E($G(IN("PREV","TEXT")),1,200)
  1.  S ^XTMP(TMPNM,REC,21)=$E($G(IN("PREV","TEXT")),201,400)
  1.  S ^XTMP(TMPNM,REC,22)="" ;previous SCT FSN text
  1.  S ^XTMP(TMPNM,REC,23)="" ;SCT FSN text overflow
  1.  S ^XTMP(TMPNM,"B",$$UP^XLFSTR($E(STR,1,200)),REC)=""
  1.  S ^XTMP(TMPNM,"C",TNUM,REC)=""
  1.  S ^XTMP(TMPNM,"D",TDT,REC)=""
  1.  S ^XTMP(TMPNM,"E",+FILE,+FIEN,REC)=""
  1.  S ^XTMP(TMPNM,"F",STSEXC,REC)="" ;exception type xref
  1.  L -@LRLCK
  1.  Q REC
  1.  ;
  1.  ;
  1. OK2LOG(TEXT,IN,TMPNM) ;
  1.  ; FileMan safe
  1.  ; Checks if this change needs to be logged.
  1.  ; Inputs
  1.  ;   TEXT:<byref> Not manipulated (minimize symtbl use)
  1.  ;     IN:<byref>
  1.  ;            IN("FILE") <req>
  1.  ;            IN("SCT") <opt>
  1.  ;            IN("PREV","SCT") <opt>
  1.  ; Outputs
  1.  ;  1=OK to log  or 0 with error code^error msg
  1.  ;  If "0^2^SCT changed"  then this should still generate an alert
  1.  N X,I,STOP,STR,REC,TEXT2,STATUS,FILE
  1.  S TMPNM=$G(TMPNM)
  1.  I TMPNM="" S TMPNM="LRSCTX-STS"
  1.  S TEXT=$G(TEXT),FILE=$G(IN("FILE")),STATUS=1
  1.  S TEXT2=$$TRIM^XLFSTR(TEXT),TEXT2=$$UP^XLFSTR(TEXT2)
  1.  S STR=$E(TEXT2,1,200) ;some terms can be long and wont fit in a node
  1.  ; check if this term has been sent already.
  1.  S I=0,STOP=0
  1.  F  S I=$O(^XTMP(TMPNM,"B",STR,I)) Q:'I  D  Q:STOP
  1.  . I STR_$$UP^XLFSTR($G(^XTMP(TMPNM,I,1)))'=TEXT2 Q
  1.  . S DATA=$G(^XTMP(TMPNM,I,2))
  1.  . I $P(DATA,U,3)'=FILE Q
  1.  . S STOP=1
  1.  ;
  1.  I STOP S STATUS="0^1^Alert already sent."
  1.  ; did SCT change?
  1.  I STOP,$G(IN("PREV","SCT"))'=$G(IN("SCT")) S STATUS="0^2^SCT changed.",STOP=0
  1.  Q STATUS