1 | LR7OSAP4 ;slc/dcm - Silent AP API ;3/22/2007
|
---|
2 | ;;5.2;LAB SERVICE;**365**;Sep 27, 1994;Build 9
|
---|
3 | ;
|
---|
4 | EN(LRX,LRDFN,LRSS,LRI,GIOM) ;Get Anatomic Path results from either TIU or Lab files
|
---|
5 | ; LRX is the global where the output is placed. Calling package is responsible for cleaning this up
|
---|
6 | ; LRDFN = Lab Patient ID
|
---|
7 | ; LRSS = Lab Subscript
|
---|
8 | ; LRI = Inverse Date/Time from ^LR(LRDFN,LRSS,LRIDT)
|
---|
9 | Q:'LRDFN Q:$G(LRSS)="" Q:'LRI Q:'$D(^LR(+LRDFN,LRSS,LRI))&(LRSS'="AU")
|
---|
10 | N LRAA,FST,GCNT,B
|
---|
11 | K ^TMP("LRC",$J)
|
---|
12 | D:LRSS="CY" CY D:LRSS="SP" SPA D:LRSS="EM" EM
|
---|
13 | S FST=0,GCNT=0,GIOM=$G(GIOM,96),B=$G(^LR(LRDFN,LRSS,LRI,0))
|
---|
14 | D:LRSS="AU" AU
|
---|
15 | I LRSS'="AU" D W^LR7OSAP
|
---|
16 | M @LRX=^TMP("LRC",$J)
|
---|
17 | Q
|
---|
18 | ;
|
---|
19 | CY S LRSS="CY",LRAA(1)="CYTOPATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
|
---|
20 | Q
|
---|
21 | ;
|
---|
22 | SPA S LRSS="SP",LRAA(1)="SURGICAL PATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
|
---|
23 | Q
|
---|
24 | ;
|
---|
25 | EM S LRSS="EM",LRAA(1)="ELECTRON MICROSCOPY",LRAA=+$O(^LRO(68,"B","EM",0)) S:'LRAA LRAA=$$FIND(LRSS)
|
---|
26 | Q
|
---|
27 | ;
|
---|
28 | AU D EN^LR7OSAP2(LRDFN)
|
---|
29 | Q
|
---|
30 | ;
|
---|
31 | FIND(SS) ;Find a valid entry in 68
|
---|
32 | ;SS=LRSS value to look for
|
---|
33 | N I,Y
|
---|
34 | S I=0,Y="" F S I=$O(^LRO(68,I)) Q:I<1 I $P($G(^LRO(68,I,0)),"^",2)=SS S Y=I Q
|
---|
35 | Q Y
|
---|