source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSRVR2A.m@ 1604

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

initial load of WorldVistAEHR
File size: 3.1 KB
Line 
1LRSRVR2A ;DALIO/FHS - LAB DATA SERVER CONT'D RELMA EXTRACT ; Aug 17, 2006
2 ;;5.2;LAB SERVICE;**346**;Sep 27, 1994;Build 10
3 ; Called by LRSRVR2
4 ;
5 ;
6CLEAN ;
7 K ^TMP($J,"LR60")
8 K ERR,LA7PCNT,LR60IEN,LR60NM,LR6421,LR64IEN
9 K LRACTION,LRCC,LRCCNX,LOINCDTA,LRRNLT,LRCDEF,LREND
10 K LRL,LRLNC,LRLNC80,LRLNCN,LRLNCX,LRNODE,LROUT,LROUT1,LRR64
11 K LRSPEC,LRSPEC60,LRSPECN,LRSPECTA,LRST,LRSTN,LRSTR,LRSTSYN
12 K LRTA,LRUNIT,LRX,LRY,X,Y
13 D CLEAN^LRSRVR
14 D ^%ZISC
15 Q
16 ;
17 ;
18HDR ; Set the header information
19 S ^TMP($J,"LRDATA",1)="Report Generated.......: "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_LRSTN
20 S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB
21 S ^TMP($J,"LRDATA",3)="LOINC version..........: "_$$GET1^DID(95.3,"","","PACKAGE REVISION DATA")
22 S ^TMP($J,"LRDATA",4)="VistA File version.....: "_$G(^LAB(95.3,"VR"))
23 S ^TMP($J,"LRDATA",5)="Extract version........: 1.1"
24 F I=6,12,13 S ^TMP($J,"LRDATA",I)=" "
25 S ^TMP($J,"LRDATA",14)="Legend:"
26 S X="Station #-60 ien-Spec ien-Index|Test Name|Spec|Time Aspect|Units|LOINC|NLT #|Battery Code|Battery Description|Lab Section|Subscript|Comment|Data Type|Reference low|Reference high|Therapeutic low|Therapeutic high|"
27 S ^TMP($J,"LRDATA",15)=X
28 ;S X=" 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 |"
29 ;S ^TMP($J,"LRDATA",16)=X
30 S X="Use Ref Lab|Site Comment|Test Synonyms|Test Type|Default LOINC|Extract Ver|"
31 S ^TMP($J,"LRDATA",16)=X
32 ;S X=" 18 | 19 | 20 | 21 | 22 | 23 |"
33 ;S ^TMP($J,"LRDATA",18)=X
34 S ^TMP($J,"LRDATA",17)=$$REPEAT^XLFSTR("-",$L(X))
35 S ^TMP($J,"LRDATA",18)=" "
36 I 'LRTXT D
37 . S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT($$NOW^XLFDT),"-")_".TXT"
38 . S ^TMP($J,"LRDATA",12)="Attached LMOF file.....: "_LRFILENM
39 . S ^TMP($J,"LRDATA",19)=$$UUBEGFN(LRFILENM)
40 Q
41 ;
42 ;
43SITENOTE ; Build site's test notes for first record
44 ;
45 N LRI,LRSTNDT
46 K LRSTNOTE
47 S (LRSTNOTE,LRI)=0
48 F S LRI=$O(^LAB(60,LR60IEN,11,LRI)) Q:'LRI D
49 . S LRSTNDT=$P($G(^LAB(60,LR60IEN,11,LRI,0)),"^")
50 . M LRSTNOTE(LRI)=^LAB(60,LR60IEN,11,LRI,1)
51 . S LRSTNOTE(LRI,1,0)=$S(LRI>1:"^",1:"")_$$FMTE^XLFDT(LRSTNDT,"1M")_": "_$G(LRSTNOTE(LRI,1,0))
52 . K LRSTNOTE(LRI,0)
53 I $D(LRSTNOTE) S LRSTNOTE=1
54 Q
55 ;
56 ;
57SYNNOTE ; Build site's test synonym's for first record
58 ;
59 K LRSTSYN
60 S LRSTSYN=0
61 M LRSTSYN=^LAB(60,LR60IEN,5)
62 K LRSTSYN(0),LRSTSYN("B")
63 I $D(LRSTSYN) S LRSTSYN=1
64 Q
65 ;
66 ;
67SUFFIX ; If Result NLT does not have a suffix, i.e. it has .0000 then check for suffixed NLT codes which can also be used
68 N LR64,LRRNLT,LRROOT,LRX,LRY
69 S LRRNLT=$$GET1^DIQ(64,LRR64_",",1,"E")
70 S LRROOT="^LAM(""E"","_LRRNLT_")"
71 F S LRROOT=$Q(@LRROOT) Q:LRROOT="" Q:$P($QS(LRROOT,2),".")'=$P(LRRNLT,".") D
72 . S LR64=$QS(LRROOT,3)
73 . I $G(^LAM(LR64,5,LRSPEC60,0)) S LRSPEC(LRSPEC60_"-"_LR64)=LRSPEC60_U_LRSPECN_U_LRSPECTA_U_LRUNIT_U_LR64
74 Q
75 ;
76 ;
77UUBEGFN(LRFILENM) ; Construct uuencode "begin" coding
78 ; Call with LRFILENM = name of uuencoded file attachment
79 ;
80 ; Returns LRX = string with "begin..."_file name
81 ;
82 N LRX
83 S LRX="begin 644 "_LRFILENM
84 Q LRX
Note: See TracBrowser for help on using the repository browser.