source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OSAP4.m@ 810

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

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1LR7OSAP4 ;slc/dcm - Silent AP API ;3/22/2007
2 ;;5.2;LAB SERVICE;**365**;Sep 27, 1994;Build 9
3 ;
4EN(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 ;
19CY S LRSS="CY",LRAA(1)="CYTOPATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
20 Q
21 ;
22SPA S LRSS="SP",LRAA(1)="SURGICAL PATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
23 Q
24 ;
25EM S LRSS="EM",LRAA(1)="ELECTRON MICROSCOPY",LRAA=+$O(^LRO(68,"B","EM",0)) S:'LRAA LRAA=$$FIND(LRSS)
26 Q
27 ;
28AU D EN^LR7OSAP2(LRDFN)
29 Q
30 ;
31FIND(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
Note: See TracBrowser for help on using the repository browser.