source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRLNC63A.m@ 811

Last change on this file since 811 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1LRLNC63A ;DALOI/FHS-HISTORICAL LOINC MAPPER UTILITY ;01/30/2001 15:19
2 ;;5.2;LAB SERVICE;**279**;Sep 27, 1994
3XQA ;Send alert message
4 S XQA("G.LMI")=""
5 D SETUP^XQALERT
6 Q
7RANGE ; Change for high/low ranges $S( statement to a numeric value
8 K LRP,VAL,VALX
9 I 'LR5 S AGE=+$$DATE^LRDAGE(DOB,LRCDT) I AGE<1 S AGE=99
10 F LRP=2:1:5 D
11 . S VAL=$P(LRDATA5,"!",LRP)
12 . Q:'$L(VAL)
13 . Q:VAL'["$S("
14 . S VALX="S VALX="_VAL
15 . X VALX
16 . S $P(LRDATA5,"!",LRP)=VALX,LR5=1
17 Q
18XTMP(LRSUB) ;Setup XTMP("LRLNC",1,LRSUB)=Result NLT code
19 Q:$D(^XTMP("LRLNC63",1,LRSUB))
20 N LRCHK,LRTST
21 S (LRCHK,LRTST)=0
22 F S LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";1",LRTST)) Q:LRTST<1!($G(LRCHK)) D
23 . Q:'$P($G(^LAB(60,LRTST,64)),U,2)
24 . S ^XTMP("LRLNC63",1,LRSUB)=$$NLT(LRTST),LRCHK=^(LRSUB)
25 I '$G(LRCHK) S ^XTMP("LRLNC63",1,LRSUB)="-1"
26 Q
27NLT(X) ;
28 N Y
29 S Y=$S($D(^LAM(+$P($G(^LAB(60,+X,64)),U,2),0)):$P(^(0),U,2),1:"")
30 Q Y
31LIST ;List those test not have result NLT codes defined
32 K ^TMP("LRLNC63",$J)
33 N LRANS,LRSB,LRCNT,LRX
34 S ^TMP("LRLNC63",$J,"LST",1,0)="List of tests missing RNLT codes in LABORTORY TEST (#60) file,"
35 S ^TMP("LRLNC63",$J,"LST",2,0)="found during LOINC Historical Mapping process."
36 S ^TMP("LRLNC63",$J,"LST",3,0)="These test(s) will have no historical LOINC mapping performed."
37 S ^TMP("LRLNC63",$J,"LST",4,0)=" "
38 S ^TMP("LRLNC63",$J,"LST",5,0)="[Test IEN] Test Name Type "
39 S ^TMP("LRLNC63",$J,"LST",6,0)=""
40 S LRCNT=6,LRSB=0 F S LRSB=$O(^XTMP("LRLNC63",1,LRSB)) Q:LRSB<1 S LRX=^(LRSB) D
41 . Q:LRX>0
42 . S LRCH="CH;"_LRSB_";1",LRTST=0
43 . F S LRTST=$O(^LAB(60,"C",LRCH,LRTST)) Q:LRTST<1 D
44 . . Q:'$D(^LAB(60,LRTST,0))#2
45 . . N LRANS,LRV,LRANS
46 . . S LRV=LRTST_","
47 . . D GETS^DIQ(60,LRV,".01;3","E","LRANS")
48 . . S LRCNT=LRCNT+1
49 . . S ^TMP("LRLNC63",$J,"LST",LRCNT,0)="["_LRTST_"] "_$G(LRANS(60,LRV,.01,"E"))_" -- Type: "_$G(LRANS(60,LRV,3,"E"))
50MAIL ;Send mail message containing tests not having RNLT codes.
51 ;Therefore not historical LOINC mapping could be done.
52 D
53 . I '$O(^TMP("LRLNC63",$J,"LST",6)) D
54 . . S ^TMP("LRLNC63",$J,"LST",7,0)="Negative Report - All test have RNLT codes definded"
55 . N XMDUZ,XMTEXT,XMY,XMSUB
56 . S XMSUB="LOINC Historical Mapping Exception Report"
57 . S XMTEXT="^TMP(""LRLNC63"","_$J_",""LST"","
58 . S XMDUZ=.5
59 . S XMY("G.LMI")=""
60 . D ^XMD
61MAP ;Provide a list of mapped test in ^ delimited format
62 N NODE,LRSB,LRNLT,LRSPECN,LRCDEF,LRLNC,LRTST
63 S LRMCNT=0
64 S ^TMP("LRLNC63",$J,"MAP",1,0)="List of test mapped to LOINC codes formatted with '^' as field delimiter."
65 S ^TMP("LRLNC63",$J,"MAP",2,0)=" "
66 S ^TMP("LRLNC63",$J,"MAP",3,0)="DataName#^Test Name^Specimen^Specimen IEN^RNLT^NLT suffix^LOINC Code"
67 S LRMCNT=3
68 S NODE="^XTMP(""LRLNC63"","_$J_",""MAP"")"
69 F S NODE=$Q(@NODE) Q:$QS(NODE,2)'="MAP" D
70 . S LRSB=$QS(NODE,3),LRSPEC=$QS(NODE,4)
71 . S LRNLT=$QS(NODE,5)
72 . S LRSPECN=$S($D(^LAB(61,+LRSPEC,0)):$P(^(0),U),1:"Missing")
73 . S LRCDEF=$QS(NODE,6)
74 . S LRLNC=$QS(NODE,7),LRLNC=$$GET1^DIQ(95.3,LRLNC_",",.01,"E")
75 . S LRTST=+$O(^LAB(60,"C","CH;"_LRSB_";1",0))
76 . S LRTST=$S($D(^LAB(60,LRTST,0))#2:$P(^(0),U),1:"Unknown")
77 . S LRMCNT=+$G(LRMCNT)+1
78 . S ^TMP("LRLNC63",$J,"MAP",LRMCNT,0)=LRSB_U_LRTST_U_LRSPECN_U_LRSPEC_U_LRNLT_U_LRCDEF_U_LRLNC
79MAPMAIL ;Send mail message containing mapped test
80 D
81 . N XMDUZ,XMTEXT,XMY,XMSUB
82 . S XMSUB="LOINC Historical Mapped LOINC tests"
83 . S XMTEXT="^TMP(""LRLNC63"","_$J_",""MAP"","
84 . S XMDUZ=.5
85 . S XMY("G.LMI")=""
86 . D ^XMD
87CLEAN ;
88 K ^TMP("LRLNC63",$J)
89 Q
90DECIMAL ;Check for possible LRDFN's >999999 - LRDFN maybe set to LRIDT format
91 S (LRNXT,LRSEQ)=999999
92 Q:'$O(^LR(LRSEQ))
93 S ^XTMP("LRLNC63","SEQ",LRSEQ,"START")=$$NOW^XLFDT
94 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
95 . I '$G(^LR(LRNXT,0)) S ^XTMP("LRLNC63","SEQ",LRSEQ)=LRNXT Q
96 . D LK6304^LRLNC63(LRNXT)
97 . S ^XTMP("LRLNC63","SEQ",LRSEQ)=LRNXT
98 I $G(^XTMP("LRLNC63","STOP")) D Q
99 . N LRNOW
100 . S LRNOW=$$FMTE^XLFDT($$NOW^XLFDT,1)
101 . S ^XTMP("LRLNC63","SEQ",LRSEQ,"END")="USER STOP"_U_$$NOW^XLFDT
102 . S XQAMSG="LOINC Historical Mapper Sequence "_LRSEQ_" STOPPED @ "_LRNOW
103 . D XQA
104 . L -^XTMP("LRLNC63","TASK",LRSEQ)
105 S XQAMSG="LOINC Historical Mapper LRDFN sequence "_LRSEQ_" completed @ "_$$FMTE^XLFDT($$NOW^XLFDT,1)
106DONE ; Send alert message when LRDFN sequence range mapping is finished
107 L -^XTMP("LRLNC63","TASK",LRSEQ)
108 S ^XTMP("LRLNC63","SEQ",LRSEQ,"END")=$$NOW^XLFDT
109 D XQA
110UPDATE ;If mapping complete, send list of tests not having result NLT codes
111 ;Update fields 95.3,95.31 in LAB(69.9 file with date and last LRDFN
112 K LRSEQX,LRNOP,LRFDA,LRERR
113 S LRNOP=0
114 F LRSEQX=1:20000:LRLST D Q:$G(LRNOP)
115 . I '$G(^XTMP("LRLNC63","SEQ",LRSEQX,"END")) S LRNOP=1
116 Q:$G(LRNOP)
117 D LIST^LRLNC63A
118 S LRFDA(95,69.9,"1,",95.3)=DT
119 S LRFDA(95,69.9,"1,",95.31)=+$P($G(LRLST),".")
120 D FILE^DIE("KS","LRFDA(95)","LRERR")
121 Q
122RERUN ; This will restart the historical mapping from the beginning.
123 ; To restart call QUE^LRLNC63
124 N DIR,DIRUT,Y
125 W !,$$CJ^XLFSTR(" This will re-run LOINC Historical Mapping from the beginning ",80)
126 W !,$$CJ^XLFSTR("reseting all globals to zero.",80)
127 W !,$$CJ^XLFSTR(" To restart from a stopping point use the",80)
128 W !,$$CJ^XLFSTR("LAB DATA LOINC Mapping Option.",80),!!
129 S DIR(0)="Y",DIR("A")="Are you certain you want to proceed" D ^DIR
130 I $G(Y)'=1 Q
131 K ^XTMP("LRLNC63")
132 D QUE^LRLNC63
133 Q
Note: See TracBrowser for help on using the repository browser.