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

LRLNC63A.m

Go to the documentation of this file.
  1. LRLNC63A ;DALOI/FHS-HISTORICAL LOINC MAPPER UTILITY ;01/30/2001 15:19
  1. ;;5.2;LAB SERVICE;**279**;Sep 27, 1994
  1. XQA ;Send alert message
  1. S XQA("G.LMI")=""
  1. D SETUP^XQALERT
  1. Q
  1. RANGE ; Change for high/low ranges $S( statement to a numeric value
  1. K LRP,VAL,VALX
  1. I 'LR5 S AGE=+$$DATE^LRDAGE(DOB,LRCDT) I AGE<1 S AGE=99
  1. F LRP=2:1:5 D
  1. . S VAL=$P(LRDATA5,"!",LRP)
  1. . Q:'$L(VAL)
  1. . Q:VAL'["$S("
  1. . S VALX="S VALX="_VAL
  1. . X VALX
  1. . S $P(LRDATA5,"!",LRP)=VALX,LR5=1
  1. Q
  1. XTMP(LRSUB) ;Setup XTMP("LRLNC",1,LRSUB)=Result NLT code
  1. Q:$D(^XTMP("LRLNC63",1,LRSUB))
  1. N LRCHK,LRTST
  1. S (LRCHK,LRTST)=0
  1. F S LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";1",LRTST)) Q:LRTST<1!($G(LRCHK)) D
  1. . Q:'$P($G(^LAB(60,LRTST,64)),U,2)
  1. . S ^XTMP("LRLNC63",1,LRSUB)=$$NLT(LRTST),LRCHK=^(LRSUB)
  1. I '$G(LRCHK) S ^XTMP("LRLNC63",1,LRSUB)="-1"
  1. Q
  1. NLT(X) ;
  1. N Y
  1. S Y=$S($D(^LAM(+$P($G(^LAB(60,+X,64)),U,2),0)):$P(^(0),U,2),1:"")
  1. Q Y
  1. LIST ;List those test not have result NLT codes defined
  1. K ^TMP("LRLNC63",$J)
  1. N LRANS,LRSB,LRCNT,LRX
  1. S ^TMP("LRLNC63",$J,"LST",1,0)="List of tests missing RNLT codes in LABORTORY TEST (#60) file,"
  1. S ^TMP("LRLNC63",$J,"LST",2,0)="found during LOINC Historical Mapping process."
  1. S ^TMP("LRLNC63",$J,"LST",3,0)="These test(s) will have no historical LOINC mapping performed."
  1. S ^TMP("LRLNC63",$J,"LST",4,0)=" "
  1. S ^TMP("LRLNC63",$J,"LST",5,0)="[Test IEN] Test Name Type "
  1. S ^TMP("LRLNC63",$J,"LST",6,0)=""
  1. S LRCNT=6,LRSB=0 F S LRSB=$O(^XTMP("LRLNC63",1,LRSB)) Q:LRSB<1 S LRX=^(LRSB) D
  1. . Q:LRX>0
  1. . S LRCH="CH;"_LRSB_";1",LRTST=0
  1. . F S LRTST=$O(^LAB(60,"C",LRCH,LRTST)) Q:LRTST<1 D
  1. . . Q:'$D(^LAB(60,LRTST,0))#2
  1. . . N LRANS,LRV,LRANS
  1. . . S LRV=LRTST_","
  1. . . D GETS^DIQ(60,LRV,".01;3","E","LRANS")
  1. . . S LRCNT=LRCNT+1
  1. . . S ^TMP("LRLNC63",$J,"LST",LRCNT,0)="["_LRTST_"] "_$G(LRANS(60,LRV,.01,"E"))_" -- Type: "_$G(LRANS(60,LRV,3,"E"))
  1. MAIL ;Send mail message containing tests not having RNLT codes.
  1. ;Therefore not historical LOINC mapping could be done.
  1. D
  1. . I '$O(^TMP("LRLNC63",$J,"LST",6)) D
  1. . . S ^TMP("LRLNC63",$J,"LST",7,0)="Negative Report - All test have RNLT codes definded"
  1. . N XMDUZ,XMTEXT,XMY,XMSUB
  1. . S XMSUB="LOINC Historical Mapping Exception Report"
  1. . S XMTEXT="^TMP(""LRLNC63"","_$J_",""LST"","
  1. . S XMDUZ=.5
  1. . S XMY("G.LMI")=""
  1. . D ^XMD
  1. MAP ;Provide a list of mapped test in ^ delimited format
  1. N NODE,LRSB,LRNLT,LRSPECN,LRCDEF,LRLNC,LRTST
  1. S LRMCNT=0
  1. S ^TMP("LRLNC63",$J,"MAP",1,0)="List of test mapped to LOINC codes formatted with '^' as field delimiter."
  1. S ^TMP("LRLNC63",$J,"MAP",2,0)=" "
  1. S ^TMP("LRLNC63",$J,"MAP",3,0)="DataName#^Test Name^Specimen^Specimen IEN^RNLT^NLT suffix^LOINC Code"
  1. S LRMCNT=3
  1. S NODE="^XTMP(""LRLNC63"","_$J_",""MAP"")"
  1. F S NODE=$Q(@NODE) Q:$QS(NODE,2)'="MAP" D
  1. . S LRSB=$QS(NODE,3),LRSPEC=$QS(NODE,4)
  1. . S LRNLT=$QS(NODE,5)
  1. . S LRSPECN=$S($D(^LAB(61,+LRSPEC,0)):$P(^(0),U),1:"Missing")
  1. . S LRCDEF=$QS(NODE,6)
  1. . S LRLNC=$QS(NODE,7),LRLNC=$$GET1^DIQ(95.3,LRLNC_",",.01,"E")
  1. . S LRTST=+$O(^LAB(60,"C","CH;"_LRSB_";1",0))
  1. . S LRTST=$S($D(^LAB(60,LRTST,0))#2:$P(^(0),U),1:"Unknown")
  1. . S LRMCNT=+$G(LRMCNT)+1
  1. . S ^TMP("LRLNC63",$J,"MAP",LRMCNT,0)=LRSB_U_LRTST_U_LRSPECN_U_LRSPEC_U_LRNLT_U_LRCDEF_U_LRLNC
  1. MAPMAIL ;Send mail message containing mapped test
  1. D
  1. . N XMDUZ,XMTEXT,XMY,XMSUB
  1. . S XMSUB="LOINC Historical Mapped LOINC tests"
  1. . S XMTEXT="^TMP(""LRLNC63"","_$J_",""MAP"","
  1. . S XMDUZ=.5
  1. . S XMY("G.LMI")=""
  1. . D ^XMD
  1. CLEAN ;
  1. K ^TMP("LRLNC63",$J)
  1. Q
  1. DECIMAL ;Check for possible LRDFN's >999999 - LRDFN maybe set to LRIDT format
  1. S (LRNXT,LRSEQ)=999999
  1. Q:'$O(^LR(LRSEQ))
  1. S ^XTMP("LRLNC63","SEQ",LRSEQ,"START")=$$NOW^XLFDT
  1. F S LRNXT=$O(^LR(LRNXT)) Q:$S(LRNXT<1: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^LRLNC63(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_" STOPPED @ "_LRNOW
  1. . D XQA
  1. . L -^XTMP("LRLNC63","TASK",LRSEQ)
  1. S XQAMSG="LOINC Historical Mapper LRDFN sequence "_LRSEQ_" completed @ "_$$FMTE^XLFDT($$NOW^XLFDT,1)
  1. DONE ; Send alert message when LRDFN sequence range mapping is finished
  1. L -^XTMP("LRLNC63","TASK",LRSEQ)
  1. S ^XTMP("LRLNC63","SEQ",LRSEQ,"END")=$$NOW^XLFDT
  1. D XQA
  1. UPDATE ;If mapping complete, send list of tests not having result NLT codes
  1. ;Update fields 95.3,95.31 in LAB(69.9 file with date and last LRDFN
  1. K LRSEQX,LRNOP,LRFDA,LRERR
  1. S LRNOP=0
  1. F LRSEQX=1:20000:LRLST D Q:$G(LRNOP)
  1. . I '$G(^XTMP("LRLNC63","SEQ",LRSEQX,"END")) S LRNOP=1
  1. Q:$G(LRNOP)
  1. D LIST^LRLNC63A
  1. S LRFDA(95,69.9,"1,",95.3)=DT
  1. S LRFDA(95,69.9,"1,",95.31)=+$P($G(LRLST),".")
  1. D FILE^DIE("KS","LRFDA(95)","LRERR")
  1. Q
  1. RERUN ; This will restart the historical mapping from the beginning.
  1. ; To restart call QUE^LRLNC63
  1. N DIR,DIRUT,Y
  1. W !,$$CJ^XLFSTR(" This will re-run LOINC Historical Mapping from the beginning ",80)
  1. W !,$$CJ^XLFSTR("reseting all globals to zero.",80)
  1. W !,$$CJ^XLFSTR(" To restart from a stopping point use the",80)
  1. W !,$$CJ^XLFSTR("LAB DATA LOINC Mapping Option.",80),!!
  1. S DIR(0)="Y",DIR("A")="Are you certain you want to proceed" D ^DIR
  1. I $G(Y)'=1 Q
  1. K ^XTMP("LRLNC63")
  1. D QUE^LRLNC63
  1. Q