source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRLNC63A.m@ 636

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