source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSRVR7.m@ 767

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1LRSRVR7 ;DALIO/JMC - LAB DATA SERVER CONT'D CPT EXTRACT ;Aug 17, 2006
2 ;;5.2;LAB SERVICE;**346**;Sep 27, 1994;Build 10
3 ; Produces NLT/CPT extract via LRLABSERVER option
4 ;
5 Q
6 ;
7 ;
8SERVER ; Server entry Point
9 N I,LRCNT,LREND,LRL,LRMSUBJ,LRST,LRSTN,LRTXT,LRX,LRY
10 D BUILD
11 S LRMSUBJ=LRST_" "_LRSTN_" NLT/CPT EXTRACT "_$$HTE^XLFDT($H,"1M")
12 D MAILSEND^LRSRVR6(LRMSUBJ)
13 D CLEAN
14 Q
15 ;
16 ;
17BUILD ; Build extract
18 N LRCNT,LRCRLF,LRFN,LRNAME,LRQUIT,LRROOT,LRSCT,LRSTR,LRVAL,LRVUID,X,Y
19 ;
20 S LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2)
21 I LRST="" S LRST="???"
22 K ^TMP($J,"LRDATA")
23 S (LRCNT,LRCNT(1),LRCNT(2))=0,LRCRLF=$C(13,10),LRSTR=""
24 D HDR,FILE
25 ;
26 ;
27 ; Set the final info into the ^TMP message global
28 S LRNODE=$O(^TMP($J,"LRDATA",""),-1)+1
29 I LRSTR'="" S ^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
30 S ^TMP($J,"LRDATA",LRNODE+1)=" "
31 S ^TMP($J,"LRDATA",LRNODE+2)="end"
32 ;
33 S J=4
34 S ^TMP($J,"LRDATA",J)="Number of records per file:"
35 S ^TMP($J,"LRDATA",J+1)=$$LJ^XLFSTR("Total number of records",33,".")_": "_$J(LRCNT,5)
36 S ^TMP($J,"LRDATA",J+2)=$$LJ^XLFSTR("CPT/LOINC records",33,".")_": "_$J(LRCNT(1),5)
37 S ^TMP($J,"LRDATA",J+3)=$$LJ^XLFSTR("CPT/Default LOINC records",33,".")_": "_$J(LRCNT(2),5)
38 ;
39 Q
40 ;
41 ;
42CLEAN ;
43 K ^TMP($J,"LR61")
44 K J,LA7PCNT,LR64CODE,LR64NM,LRFILENM,LRLEN,LRLN,LRLNC,LRNODE,LRSTSYN
45 D CLEAN^LRSRVR
46 D ^%ZISC
47 Q
48 ;
49 ;
50FILE ;
51 ;
52 N LR64,LR64018,LR81,LRCPT,LRCPTNM,LRI,LRXX,LRYY,LRZ
53 S LRROOT="^LAM(""AD"")",(LR64,LR64018)=0
54 F S LRROOT=$Q(@LRROOT) Q:LRROOT="" Q:$QS(LRROOT,1)'="AD" D
55 . I $QS(LRROOT,3)'="CPT" Q
56 . I LR64'=$QS(LRROOT,2) D
57 . . S LR64=$QS(LRROOT,2)
58 . . S X=$G(^LAM(LR64,0))
59 . . S LR64NM=$P(X,"^"),LR64CODE=$P(X,"^",2)
60 . . D LOINC
61 . . S LRCNT=LRCNT+1
62 . S LR64018=$QS(LRROOT,4)
63 . S LR81=+$P($G(^LAM(LR64,4,LR64018,0)),"^")
64 . S X=$$CPT^ICPTCOD(LR81,DT,1)
65 . S LRCPT=$S($P(X,"^")>0:$P(X,"^",2),1:"IEN "_LR81)
66 . S LRCPTNM=$S($P(X,"^")>0:$P(X,"^",3),1:$P(X,"^",2))
67 . ; File "default" mapping
68 . S LRSTR=LRSTR_LRST_"-"_LR64_"-"_LR64018_"|"_LR64CODE_"|"_LR64NM_"|"_LRCPT_"|"_LRCPTNM_"|"_LRLN
69 . D SETDATA
70 . ; File specific specimen/time aspect LOINC mappings
71 . S LRXX=LRST_"-"_LR64_"-"_LR64018_"-"
72 . S LRYY="|"_LR64CODE_"|"_LR64NM_"|"_LRCPT_"|"_LRCPTNM_"|"
73 . S LRI=""
74 . F S LRI=$O(LRLN(LRI)) Q:LRI="" D
75 . . S LRSTR=LRSTR_LRXX_LRI_LRYY_LRLN(LRI)
76 . . D SETDATA
77 Q
78 ;
79 ;
80SETDATA ; Set data into report structure
81 S LRSTR=LRSTR_LRCRLF
82 S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
83 D ENCODE^LRSRVR4(.LRSTR)
84 Q
85 ;
86 ;
87HDR ; Set the header information
88 S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT($$NOW^XLFDT),"-")_".TXT"
89 S ^TMP($J,"LRDATA",1)="Report generated.......: "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_LRSTN
90 S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB
91 F I=3,8,10,15 S ^TMP($J,"LRDATA",I)=" "
92 S ^TMP($J,"LRDATA",9)="Attached file..........: "_LRFILENM
93 S ^TMP($J,"LRDATA",11)="Legend:"
94 S X="Station #-NLT IEN-CPT IEN-Spec-Time Aspect|NLT Code|NLT Name|CPT Code|CPT Name|Specimen|Time Aspect|LOINC Code|LOINC Short Name|"
95 S ^TMP($J,"LRDATA",12)=X
96 S X=" 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |"
97 S ^TMP($J,"LRDATA",13)=X
98 S ^TMP($J,"LRDATA",14)=$$REPEAT^XLFSTR("-",$L(X))
99 S ^TMP($J,"LRDATA",16)=$$UUBEGFN^LRSRVR2A(LRFILENM)
100 Q
101 ;
102 ;
103LOINC ; Retreive any LOINC codes for the NLT code
104 N LR61,LRJ,LRK,LRSPECN,LRTA,LRX
105 K LRLN
106 ; Default LOINC
107 S LRX=$G(^LAM(LR64,9))
108 S LRLN="||||"
109 I $P(LRX,"^") D
110 . S $P(LRLN,"|",3)=$$GET1^DIQ(95.3,$P(LRX,"^")_",",.01)
111 . S $P(LRLN,"|",4)=$$GET1^DIQ(95.3,$P(LRX,"^")_",",81)
112 . S LRCNT(2)=LRCNT(2)+1
113 I $P(LRX,"^",2) S $P(LRLN,"|",2)=$P($G(^LAB(64.061,$P(LRX,"^",2),0)),"^")
114 ;
115 ; Specimen specific LOINC
116 S LRJ=0
117 F S LRJ=$O(^LAM(LR64,5,LRJ)) Q:'LRJ D
118 . S LR61=+$P($G(^LAM(LR64,5,LRJ,0)),"^")
119 . S LRSPECN=$P($G(^LAB(61,LR61,0)),"^")
120 . S LRK=0
121 . F S LRK=$O(^LAM(LR64,5,LRJ,1,LRK)) Q:'LRK D
122 . . S LRTA=$P($G(^LAM(LR64,5,LRJ,1,LRK,0)),"^")
123 . . S LRLNC=$P($G(^LAM(LR64,5,LRJ,1,LRK,1)),"^")
124 . . S LRLN(LRJ_"-"_LRK)=LRSPECN_"|"_$P($G(^LAB(64.061,LRTA,0)),"^")_"|"_$$GET1^DIQ(95.3,LRLNC_",",.01)_"|"_$$GET1^DIQ(95.3,LRLNC_",",81)_"|"
125 . . S LRCNT(1)=LRCNT(1)+1
126 ;
127 Q
Note: See TracBrowser for help on using the repository browser.