| 1 | LRSRVR2A ;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 | ;
|
|---|
| 6 | CLEAN ;
|
|---|
| 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 | ;
|
|---|
| 18 | HDR ; 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 | ;
|
|---|
| 43 | SITENOTE ; 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 | ;
|
|---|
| 57 | SYNNOTE ; 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 | ;
|
|---|
| 67 | SUFFIX ; 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 | ;
|
|---|
| 77 | UUBEGFN(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
|
|---|
