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

LRLNC63.m

Go to the documentation of this file.
  1. LRLNC63 ;DALOI/FHS-HISTORICAL LOINC CODE MAPPER FOR DD(63.04 DATA ;10/15/2001 15:19
  1. ;;5.2;LAB SERVICE;**279**;Sep 27, 1994
  1. TASK ;
  1. I '$G(^XTMP("LRLNC63",0)) S ^(0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"LOINC HISTORICAL MAPPER INFORMATION"
  1. Q:'$G(LRSEQ)
  1. L +^XTMP("LRLNC63","TASK",LRSEQ):1 Q:'$T
  1. H 5
  1. I LRSEQ=999999 D DECIMAL^LRLNC63A Q
  1. S LRNXT=+$G(^XTMP("LRLNC63","SEQ",LRSEQ))
  1. I LRNXT>1 S LRNXT=LRNXT-1
  1. S:LRNXT<1 LRNXT=(LRSEQ-1)
  1. S:LRNXT<0 LRNXT=0
  1. S LRMAP=$$GET1^DIQ(69.9,"1,",95.3,"I","","ERR")
  1. S ^XTMP("LRLNC63","SEQ",LRSEQ,"START")=$$NOW^XLFDT
  1. F S LRNXT=$O(^LR(LRNXT)) Q:$S(LRNXT<1:1,LRNXT>(LRSEQ+20000):1,$G(^XTMP("LRLNC63","STOP")):1,1:0) D I $$S^%ZTLOAD(LRSEQ_" Stopped at "_LRNXT) S ZTSTOP=1 Q
  1. . I '$G(^LR(LRNXT,0)) S ^XTMP("LRLNC63","SEQ",LRSEQ)=LRNXT Q
  1. . D LK6304(LRNXT)
  1. . S ^XTMP("LRLNC63","SEQ",LRSEQ)=LRNXT
  1. I $G(^XTMP("LRLNC63","STOP")) D Q
  1. . N LRNOW
  1. . S LRNOW=$$FMTE^XLFDT($$NOW^XLFDT,1)
  1. . S ^XTMP("LRLNC63","SEQ",LRSEQ,"END")="USER STOP"_U_$$NOW^XLFDT
  1. . S XQAMSG="LOINC Historical Mapper Sequence "_LRSEQ_"-"_(LRSEQ+20000)_" STOPPED @ "_LRNOW
  1. . D XQA^LRLNC63A
  1. . L -^XTMP("LRLNC63","TASK",LRSEQ)
  1. MES ; Send alert message when LRDFN sequence range mapping is finished
  1. S XQAMSG="LOINC Historical Mapper LRDFN sequence "_LRSEQ_" - "_(LRSEQ+20000)_" completed @ "_$$FMTE^XLFDT($$NOW^XLFDT,1)
  1. D DONE^LRLNC63A
  1. Q
  1. 6304 ;Entry point for setting ALL Patient's LOINC CODE for CH subscripted test
  1. K LRDFN,LRIDT,LRDATA,LRNLT,LRLNC
  1. K ^XTMP("LRLNC63")
  1. I $P($G(^LR(LRDFN,0)),U,2)=62.3 Q
  1. S LRDFN=0 F S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 I $O(^LR(LRDFN,"CH",0)) D I $$S^%ZTLOAD Q
  1. . D LK6304(LRDFN)
  1. Q
  1. LK6304(LRDFN) ;Call with LRDFN defined for single patient mapping
  1. Q:'LRDFN
  1. Q:'$G(^LR(LRDFN,0)) S LRFILE=+$P(^(0),U,2),DFN=+$P(^(0),U,3)
  1. I '$G(LRFILE)!(LRFILE=62.3)!('DFN) Q ;Do not process controls
  1. K LRSAGE
  1. S SEX="M",AGE=99,LRSAGE=0
  1. I $S($G(LRMAP):0,LRFILE=2:1,LRFILE=67:1,1:0) D
  1. . D GETS^DIQ(LRFILE,DFN_",",".02;.03","IE","LRSAGE")
  1. . S DOB=$G(LRSAGE(LRFILE,DFN_",",.03,"I"))
  1. . I $L($G(LRSAGE(LRFILE,DFN_",",.02,"I"))) S SEX=LRSAGE(LRFILE,DFN_",",.02,"I")
  1. . S LRSAGE=1
  1. S LRIDT=0 F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 D
  1. . I $G(LRDBUG),'(LRDFN#100) W "."
  1. . Q:$G(^LR(LRDFN,"CH",LRIDT,"NPC"))<2 ;Must have the New Person Convertion node set to >1
  1. . Q:'$P($G(^LR(LRDFN,"CH",LRIDT,0)),U,3) S LRCDT=$P(^(0),U),LRDSPEC=$P(^(0),U,5) ; Must have completion date
  1. . D SUB(LRDFN,LRIDT)
  1. Q
  1. SUB(LRDFN,LRIDT) ;Single or all test LOINC mapping
  1. ;LRDFN=Lab IEN number
  1. ;LRIDT inverse date
  1. ;Check each result and determine LOINC CODE
  1. ;If Result NLT code is defined (LRNLT)
  1. ;If Workload suffix code is set (LRCDEF)
  1. ;If Specimen is defined (LRSPEC)
  1. ;Variable LRLNC is the LOINC CODE
  1. ;LRSB(LRSUB) will screen for only those datanames
  1. ;LRSB(LRSUB)=Workload suffix -- this will be used to change default suffix code.
  1. ;LRDATA= ^LR(LRDFN,"CH",LRIDT,TEST) node
  1. K LR5,LRLNC,LRMNODE,LROVR,LRSUB,LRXDEF,LRXNLT,LRXCDEF
  1. S LRXDEF=0,LRSUB=1
  1. F S LRSUB=$O(^LR(LRDFN,"CH",LRIDT,LRSUB)) Q:LRSUB<1 S LRDATA=^(LRSUB) D
  1. . I '$D(^XTMP("LRLNC63",1,LRSUB)) D XTMP^LRLNC63A(LRSUB)
  1. . S (LR5,LROVR,LRLNC,LRXCDEF,LRMOD1)=""
  1. . I $G(LRMOD),$G(^XTMP("LRLNC63",2,LRSUB)) S LRMNODE=^(LRSUB) D
  1. . . S LROVR=+$P(LRMNODE,U,6),LRXCDEF=$P(LRMNODE,U,5)
  1. . . S LRMOD1=1
  1. . S LRDATA3=$P(LRDATA,U,3),LRDATA5=$P(LRDATA,U,5)
  1. . S LRNLT=$S($G(LRXNLT):LRXNLT,1:$P(LRDATA3,"!",2))
  1. . S LRCDEF=$S($G(LROVR):LRXCDEF,$P(LRDATA3,"!",4):$P(LRDATA3,"!",4),1:LRXCDEF)
  1. . S LRSPEC=$S($P(LRDATA,U,5):+$P(LRDATA,U,5),1:LRDSPEC)
  1. . I '$G(LRNLT) S LRNLT=$S(LRNLT:LRNLT,1:$G(^XTMP("LRLNC63",1,LRSUB)))
  1. . I LRNLT>1,LRSPEC S LRLNC=$$LNC^LRVER1(LRNLT,LRCDEF,LRSPEC)
  1. . I LRLNC D
  1. . . S $P(LRDATA3,"!",3)=LRLNC,$P(LRDATA3,"!",4)=LRCDEF
  1. . . I '$D(^XTMP("LRLNC63","MAP",LRSUB,LRSPEC,LRNLT,+LRCDEF,LRLNC)) S ^(LRLNC)=""
  1. . I '$G(LRMAP),LRSAGE,LRDATA5["$S(" D RANGE^LRLNC63A
  1. . I $G(LRDBUG) D Q
  1. . . W !,LRDFN,?10,LRIDT,?30,LRSUB_" "_LRSPEC
  1. . . I $G(LRDBUG)=2,$G(LRLNC) W !,LRDATA3,!,LRDATA5 Q
  1. . . I $G(LRDBUG)=1 W !,$S(LRLNC:"",1:"** ")_LRDATA3,!,LRDATA5
  1. . I $G(LRLNC) D
  1. . . S $P(LRDATA3,"!",5)=$S($G(LRMOD1):2,1:1)
  1. . . S $P(LRDATA,U,3)=LRDATA3
  1. . . S $P(^LR(LRDFN,"CH",LRIDT,LRSUB),U,3)=LRDATA3
  1. . I $G(LR5) S $P(^LR(LRDFN,"CH",LRIDT,LRSUB),U,5)=LRDATA5
  1. Q
  1. LNC(LRNLT,LRCDEF,LRSPEC) ;reture the LOINC code for WKLD Code/Specimen
  1. ; Call with (nlt code,method suffix,test specimen)
  1. ; TA = Time Aspect
  1. N X,LRXN,Y,LRSPECN,VAL,ERR,TA S X=""
  1. Q:'LRNLT X
  1. K LRMSGM
  1. S:'$L($G(LRCDEF)) LRCDEF="0000"
  1. I $P($G(LRCDEF),".",2) S LRCDEF=$P(LRCDEF,".",2)
  1. S LRCDEF=$S($P(LRNLT,".",2):$P(LRNLT,".",2),1:LRCDEF)
  1. I $L(LRCDEF)'=4 S LRCDEF=LRCDEF_$E("0000",$L(LRCDEF),($L(LRCDEF-4)))
  1. S LRCDEF=LRCDEF_" "
  1. S LRSPEC=+LRSPEC
  1. ;Get time aspect from 61
  1. S TA=$$GET1^DIQ(61,LRSPEC_",",.0961,"I")
  1. S LRSPECN=$S($D(^LAB(61,LRSPEC,0))#2:$$GET1^DIQ(61,LRSPEC_",",.01),1:"Unknown")
  1. S LRNLT=$P(LRNLT,".")_"."
  1. ;Check for WKLD CODE_LOAD/WORK LIST method suffix
  1. S VAL(1)=LRNLT_LRCDEF
  1. S LRXN=$$FIND1^DIC(64,"","X",.VAL,"C","","ERR")
  1. ;Looking for specimen specific LOINC
  1. I LRXN,LRSPEC D I X D MSG(1) Q X
  1. . I TA S X=$$GET1^DIQ(64.02,TA_","_LRSPEC_","_LRXN_",",4,"I") Q:X
  1. . S TA=$O(^LAM(LRXN,5,LRSPEC,1,0)) ; get time aspect
  1. . I TA S X=$$GET1^DIQ(64.02,TA_","_LRSPEC_","_LRXN_",",4,"I") Q:X
  1. ;Looking LOINC default
  1. I LRXN S X=$$LDEF(LRXN) I X D MSG(2) Q X
  1. I LRCDEF="0000 " Q ""
  1. ;Looking for WKLD CODE_GENERIC suffix
  1. K VAL
  1. S VAL(1)=LRNLT_"0000 "
  1. S LRXN=$$FIND1^DIC(64,"","X",.VAL,"C","","ERR")
  1. I 'LRXN Q ""
  1. ;Looking for WKLD CODE_GENERIC specimen specific LOINC
  1. I LRSPEC D I X D MSG(3) Q X
  1. . I TA S X=$$GET1^DIQ(64.02,TA_","_LRSPEC_","_LRXN_",",4,"I") Q:X
  1. . S TA=$O(^LAM(LRXN,5,LRSPEC,1,0)) ; get time aspect
  1. . I TA S X=$$GET1^DIQ(64.02,TA_","_LRSPEC_","_LRXN_",",4,"I") Q:X
  1. ;Looking for WKLD CODE_GENERIC default LOINC
  1. I 'X,LRXN S X=$$LDEF(LRXN) I X D MSG(4)
  1. I 'X S X=""
  1. Q X
  1. LDEF(LRY) ;Find the default LOINC code for WKLD CODE
  1. I 'LRY Q ""
  1. S X=$$GET1^DIQ(64,LRY_",",25,"I")
  1. I 'X S X=""
  1. Q X
  1. TMPSB(LRSB) ; Get LOINC code from ^TMP("LR",$J,"TMP",LRSB,"P")
  1. S NODE=$G(^TMP("LR",$J,"TMP",LRSB,"P"))
  1. I 'NODE Q ""
  1. S $P(NODE,"!",3)=$$LNC($P(NODE,"!",2),$G(LRCDEF),$G(LRSPEC))
  1. S $P(NODE,"!",4)=$G(LRCDEF)
  1. Q $P(NODE,U,2)
  1. Q
  1. MSG(VAL) ;Set output message
  1. Q:'$G(LRMSG)
  1. S LRMSGM="0-No LOINC Code Defined for "_LRNLT_" "_LRCDEF
  1. N TANAME
  1. I $G(TA) S TANAME=$$GET1^DIQ(64.061,TA_",",.01,"E") ;TA Name
  1. I VAL=1 S LRMSGM="1-"_LRNLT_$E(LRCDEF,1,4)_" - "_LRSPECN
  1. I VAL=2 S LRMSGM="2-"_LRNLT_$E(LRCDEF,1,4)_" - Default LOINC"
  1. I VAL=3 S LRMSGM="3-"_LRNLT_"0000 - "_LRSPECN
  1. I VAL=4 S LRMSGM="4-"_LRNLT_"0000 - Default LOINC"
  1. I $G(TA) S LRMSGM=LRMSGM_" Time Aspect "_TANAME
  1. W:$G(LRDBUG) !,LRMSGM,!
  1. Q
  1. ;
  1. RNLT(X) ;
  1. I 'X Q ""
  1. N Y
  1. S Y(1)=+$P($G(^LAB(60,X,64)),U,2)
  1. S Y=$S($P($G(^LAM(Y(1),0)),U,2):$P(^(0),U,2),1:"")
  1. I Y S $P(Y,"!",2)=$$LNC(Y,$G(LRCDEF),$G(LRSPEC))
  1. S $P(Y,"!",3)=$G(LRCDEF)
  1. Q Y
  1. ;
  1. QUE ;Entry point to start/restart historical mapper
  1. ;Queue to a the resource device LRRESOURCE to trottle number of
  1. ;active conversion jobs.
  1. SEC ;Check for security key
  1. I '$D(^XUSEC("XUPROGMODE",+$G(DUZ))) D Q
  1. . W !,$$CJ^XLFSTR("You are not cleared to use this option",80)
  1. DEV ;Check to make sure LRRESOURCE device exist
  1. W @IOF
  1. N LRERR
  1. S LRDEV=$$FIND1^DIC(3.5,"","B","LRRESOURCE","","","LRERR")
  1. I '$G(LRDEV) D G END
  1. . W !,$$CJ^XLFSTR("You must define the resource device named 'LRRESOURCE'",80)
  1. . W !,$$CJ^XLFSTR("with at least one slot. Process Aborted.",80)
  1. S LRSLOT=$$GET1^DIQ(3.5,LRDEV_",",35,"I")
  1. I LRSLOT'>0 D G END
  1. . W !,$$CJ^XLFSTR("LRRESOURCE device must have at leaset 1 slot.",80)
  1. . W !,$$CJ^XLFSTR("The recommended number is 8.",80)
  1. W !!,$$CJ^XLFSTR("D STOP^LRLNC63 to stop all background historical mapping tasks.",80),!
  1. DIS ;Inform the user of the option's functionality
  1. W !!,$$CJ^XLFSTR("This option should be run during 24 hour off peak time frame!!",80),!!
  1. W !,$$CJ^XLFSTR("This option will queue multiple tasks to LOINC map",80)
  1. W !,$$CJ^XLFSTR("historical data in the LAB DATA (#63).",80)
  1. K DIR S DIR(0)="Y",DIR("A")="Are you certain you wish to proceed"
  1. D ^DIR I $G(Y)'=1 G END
  1. S LRSTOP=$G(^XTMP("LRLNC63","STOP"))
  1. K ^XTMP("LRLNC63",1),^XTMP("LRLNC63","STOP")
  1. S LRLST=$O(^LR(999999),-1)
  1. D
  1. . I LRLST[".",$D(^LR(0))#2 S $P(^(0),U,3)=$P(LRLST,".") Q
  1. . I $D(^LR(0))#2 S $P(^(0),U,3)=LRLST
  1. K ^XTMP("LRLNC63",0)
  1. F LRSEQ=1:20000:LRLST D IO
  1. I $O(^LR(999999)) S LRSEQ=999999 D IO
  1. END ;Cleanup
  1. K LRDEV,LRSLOT,LRLST,LRSEQ
  1. K ZTSAVE,ZTDTH,ZTDESC,ZTRTN
  1. Q
  1. IO ;Task to LRRESOURCE
  1. L +^XTMP("LRLNC63","TASK",LRSEQ):1 I '$T D Q
  1. . W !,$$CJ^XLFSTR("Sequence # "_LRSEQ_" is already running.",80),!
  1. I $G(^XTMP("LRLNC63","SEQ",LRSEQ,"END")) D
  1. . K ^XTMP("LRLNC63","SEQ",LRSEQ)
  1. I $G(LRSTOP) K ^XTMP("LRLNC63","SEQ",LRSEQ,"END")
  1. S ZTSAVE("LRSEQ")="",ZTIO="LRRESOURCE",ZTDTH=$H
  1. S ZTDESC="LOINC Historical Conversion - Seq "_LRSEQ_" "_$$NOW^XLFDT
  1. S ZTSAVE("LRLST")=""
  1. S ZTRTN="TASK^LRLNC63"
  1. D ^%ZTLOAD
  1. L -^XTMP("LRLNC63","TASK",LRSEQ)
  1. Q:'$D(ZTSK)
  1. S XQAMSG="LRDFN Conversion Sequence "_LRSEQ_"-"_(LRSEQ+20000)_" Task number is "_ZTSK
  1. W !,XQAMSG D XQA^LRLNC63A
  1. Q
  1. STOP ;Stop all LOINC conversion background jobs
  1. N DIR
  1. W !?5,"Stopping all background LOINC historical mapping jobs",!!
  1. S DIR(0)="Y",DIR("A")="Are you certain you want to continue"
  1. D ^DIR Q:Y'=1
  1. S ^XTMP("LRLNC63","STOP")=$H_U_$$HTE^XLFDT($H)_U_"DUZ= "_$G(DUZ)
  1. W !," Background task stop node has been set, jobs should stop soon",!
  1. Q