| 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 | 
|---|