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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLNC63A 5465 printed Dec 13, 2024@02:16:31 Page 2
LRLNC63A ;DALOI/FHS-HISTORICAL LOINC MAPPER UTILITY ;01/30/2001 15:19
+1 ;;5.2;LAB SERVICE;**279**;Sep 27, 1994
XQA ;Send alert message
+1 SET XQA("G.LMI")=""
+2 DO SETUP^XQALERT
+3 QUIT
RANGE ; Change for high/low ranges $S( statement to a numeric value
+1 KILL LRP,VAL,VALX
+2 IF 'LR5
SET AGE=+$$DATE^LRDAGE(DOB,LRCDT)
IF AGE<1
SET AGE=99
+3 FOR LRP=2:1:5
Begin DoDot:1
+4 SET VAL=$PIECE(LRDATA5,"!",LRP)
+5 if '$LENGTH(VAL)
QUIT
+6 if VAL'["$S("
QUIT
+7 SET VALX="S VALX="_VAL
+8 XECUTE VALX
+9 SET $PIECE(LRDATA5,"!",LRP)=VALX
SET LR5=1
End DoDot:1
+10 QUIT
XTMP(LRSUB) ;Setup XTMP("LRLNC",1,LRSUB)=Result NLT code
+1 if $DATA(^XTMP("LRLNC63",1,LRSUB))
QUIT
+2 NEW LRCHK,LRTST
+3 SET (LRCHK,LRTST)=0
+4 FOR
SET LRTST=$ORDER(^LAB(60,"C","CH;"_LRSUB_";1",LRTST))
if LRTST<1!($GET(LRCHK))
QUIT
Begin DoDot:1
+5 if '$PIECE($GET(^LAB(60,LRTST,64)),U,2)
QUIT
+6 SET ^XTMP("LRLNC63",1,LRSUB)=$$NLT(LRTST)
SET LRCHK=^(LRSUB)
End DoDot:1
+7 IF '$GET(LRCHK)
SET ^XTMP("LRLNC63",1,LRSUB)="-1"
+8 QUIT
NLT(X) ;
+1 NEW Y
+2 SET Y=$SELECT($DATA(^LAM(+$PIECE($GET(^LAB(60,+X,64)),U,2),0)):$PIECE(^(0),U,2),1:"")
+3 QUIT Y
LIST ;List those test not have result NLT codes defined
+1 KILL ^TMP("LRLNC63",$JOB)
+2 NEW LRANS,LRSB,LRCNT,LRX
+3 SET ^TMP("LRLNC63",$JOB,"LST",1,0)="List of tests missing RNLT codes in LABORTORY TEST (#60) file,"
+4 SET ^TMP("LRLNC63",$JOB,"LST",2,0)="found during LOINC Historical Mapping process."
+5 SET ^TMP("LRLNC63",$JOB,"LST",3,0)="These test(s) will have no historical LOINC mapping performed."
+6 SET ^TMP("LRLNC63",$JOB,"LST",4,0)=" "
+7 SET ^TMP("LRLNC63",$JOB,"LST",5,0)="[Test IEN] Test Name Type "
+8 SET ^TMP("LRLNC63",$JOB,"LST",6,0)=""
+9 SET LRCNT=6
SET LRSB=0
FOR
SET LRSB=$ORDER(^XTMP("LRLNC63",1,LRSB))
if LRSB<1
QUIT
SET LRX=^(LRSB)
Begin DoDot:1
+10 if LRX>0
QUIT
+11 SET LRCH="CH;"_LRSB_";1"
SET LRTST=0
+12 FOR
SET LRTST=$ORDER(^LAB(60,"C",LRCH,LRTST))
if LRTST<1
QUIT
Begin DoDot:2
+13 if '$DATA(^LAB(60,LRTST,0))#2
QUIT
+14 NEW LRANS,LRV,LRANS
+15 SET LRV=LRTST_","
+16 DO GETS^DIQ(60,LRV,".01;3","E","LRANS")
+17 SET LRCNT=LRCNT+1
+18 SET ^TMP("LRLNC63",$JOB,"LST",LRCNT,0)="["_LRTST_"] "_$GET(LRANS(60,LRV,.01,"E"))_" -- Type: "_$GET(LRANS(60,LRV,3,"E"))
End DoDot:2
End DoDot:1
MAIL ;Send mail message containing tests not having RNLT codes.
+1 ;Therefore not historical LOINC mapping could be done.
+2 Begin DoDot:1
+3 IF '$ORDER(^TMP("LRLNC63",$JOB,"LST",6))
Begin DoDot:2
+4 SET ^TMP("LRLNC63",$JOB,"LST",7,0)="Negative Report - All test have RNLT codes definded"
End DoDot:2
+5 NEW XMDUZ,XMTEXT,XMY,XMSUB
+6 SET XMSUB="LOINC Historical Mapping Exception Report"
+7 SET XMTEXT="^TMP(""LRLNC63"","_$JOB_",""LST"","
+8 SET XMDUZ=.5
+9 SET XMY("G.LMI")=""
+10 DO ^XMD
End DoDot:1
MAP ;Provide a list of mapped test in ^ delimited format
+1 NEW NODE,LRSB,LRNLT,LRSPECN,LRCDEF,LRLNC,LRTST
+2 SET LRMCNT=0
+3 SET ^TMP("LRLNC63",$JOB,"MAP",1,0)="List of test mapped to LOINC codes formatted with '^' as field delimiter."
+4 SET ^TMP("LRLNC63",$JOB,"MAP",2,0)=" "
+5 SET ^TMP("LRLNC63",$JOB,"MAP",3,0)="DataName#^Test Name^Specimen^Specimen IEN^RNLT^NLT suffix^LOINC Code"
+6 SET LRMCNT=3
+7 SET NODE="^XTMP(""LRLNC63"","_$JOB_",""MAP"")"
+8 FOR
SET NODE=$QUERY(@NODE)
if $QSUBSCRIPT(NODE,2)'="MAP"
QUIT
Begin DoDot:1
+9 SET LRSB=$QSUBSCRIPT(NODE,3)
SET LRSPEC=$QSUBSCRIPT(NODE,4)
+10 SET LRNLT=$QSUBSCRIPT(NODE,5)
+11 SET LRSPECN=$SELECT($DATA(^LAB(61,+LRSPEC,0)):$PIECE(^(0),U),1:"Missing")
+12 SET LRCDEF=$QSUBSCRIPT(NODE,6)
+13 SET LRLNC=$QSUBSCRIPT(NODE,7)
SET LRLNC=$$GET1^DIQ(95.3,LRLNC_",",.01,"E")
+14 SET LRTST=+$ORDER(^LAB(60,"C","CH;"_LRSB_";1",0))
+15 SET LRTST=$SELECT($DATA(^LAB(60,LRTST,0))#2:$PIECE(^(0),U),1:"Unknown")
+16 SET LRMCNT=+$GET(LRMCNT)+1
+17 SET ^TMP("LRLNC63",$JOB,"MAP",LRMCNT,0)=LRSB_U_LRTST_U_LRSPECN_U_LRSPEC_U_LRNLT_U_LRCDEF_U_LRLNC
End DoDot:1
MAPMAIL ;Send mail message containing mapped test
+1 Begin DoDot:1
+2 NEW XMDUZ,XMTEXT,XMY,XMSUB
+3 SET XMSUB="LOINC Historical Mapped LOINC tests"
+4 SET XMTEXT="^TMP(""LRLNC63"","_$JOB_",""MAP"","
+5 SET XMDUZ=.5
+6 SET XMY("G.LMI")=""
+7 DO ^XMD
End DoDot:1
CLEAN ;
+1 KILL ^TMP("LRLNC63",$JOB)
+2 QUIT
DECIMAL ;Check for possible LRDFN's >999999 - LRDFN maybe set to LRIDT format
+1 SET (LRNXT,LRSEQ)=999999
+2 if '$ORDER(^LR(LRSEQ))
QUIT
+3 SET ^XTMP("LRLNC63","SEQ",LRSEQ,"START")=$$NOW^XLFDT
+4 FOR
SET LRNXT=$ORDER(^LR(LRNXT))
if $SELECT(LRNXT<1
QUIT
Begin DoDot:1
+5 IF '$GET(^LR(LRNXT,0))
SET ^XTMP("LRLNC63","SEQ",LRSEQ)=LRNXT
QUIT
+6 DO LK6304^LRLNC63(LRNXT)
+7 SET ^XTMP("LRLNC63","SEQ",LRSEQ)=LRNXT
End DoDot:1
IF $$S^%ZTLOAD(LRSEQ_" Stopped at "_LRNXT)
SET ZTSTOP=1
QUIT
+8 IF $GET(^XTMP("LRLNC63","STOP"))
Begin DoDot:1
+9 NEW LRNOW
+10 SET LRNOW=$$FMTE^XLFDT($$NOW^XLFDT,1)
+11 SET ^XTMP("LRLNC63","SEQ",LRSEQ,"END")="USER STOP"_U_$$NOW^XLFDT
+12 SET XQAMSG="LOINC Historical Mapper Sequence "_LRSEQ_" STOPPED @ "_LRNOW
+13 DO XQA
+14 LOCK -^XTMP("LRLNC63","TASK",LRSEQ)
End DoDot:1
QUIT
+15 SET XQAMSG="LOINC Historical Mapper LRDFN sequence "_LRSEQ_" completed @ "_$$FMTE^XLFDT($$NOW^XLFDT,1)
DONE ; Send alert message when LRDFN sequence range mapping is finished
+1 LOCK -^XTMP("LRLNC63","TASK",LRSEQ)
+2 SET ^XTMP("LRLNC63","SEQ",LRSEQ,"END")=$$NOW^XLFDT
+3 DO XQA
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
+2 KILL LRSEQX,LRNOP,LRFDA,LRERR
+3 SET LRNOP=0
+4 FOR LRSEQX=1:20000:LRLST
Begin DoDot:1
+5 IF '$GET(^XTMP("LRLNC63","SEQ",LRSEQX,"END"))
SET LRNOP=1
End DoDot:1
if $GET(LRNOP)
QUIT
+6 if $GET(LRNOP)
QUIT
+7 DO LIST^LRLNC63A
+8 SET LRFDA(95,69.9,"1,",95.3)=DT
+9 SET LRFDA(95,69.9,"1,",95.31)=+$PIECE($GET(LRLST),".")
+10 DO FILE^DIE("KS","LRFDA(95)","LRERR")
+11 QUIT
RERUN ; This will restart the historical mapping from the beginning.
+1 ; To restart call QUE^LRLNC63
+2 NEW DIR,DIRUT,Y
+3 WRITE !,$$CJ^XLFSTR(" This will re-run LOINC Historical Mapping from the beginning ",80)
+4 WRITE !,$$CJ^XLFSTR("reseting all globals to zero.",80)
+5 WRITE !,$$CJ^XLFSTR(" To restart from a stopping point use the",80)
+6 WRITE !,$$CJ^XLFSTR("LAB DATA LOINC Mapping Option.",80),!!
+7 SET DIR(0)="Y"
SET DIR("A")="Are you certain you want to proceed"
DO ^DIR
+8 IF $GET(Y)'=1
QUIT
+9 KILL ^XTMP("LRLNC63")
+10 DO QUE^LRLNC63
+11 QUIT
