Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LR7OSAP4

LR7OSAP4.m

Go to the documentation of this file.
  1. LR7OSAP4 ;DALOI/staff - Silent AP API ;11/05/09 10:57
  1. ;;5.2;LAB SERVICE;**365,350**;Sep 27, 1994;Build 230
  1. ;
  1. EN(LRX,LRDFN,LRSS,LRI,LRGIOM) ;Get Anatomic Path results from either TIU or Lab files
  1. ; LRX is the global where the output is placed. Calling package is responsible for cleaning this up
  1. ; LRDFN = Lab Patient ID
  1. ; LRSS = Lab Subscript
  1. ; LRI = Inverse Date/Time from ^LR(LRDFN,LRSS,LRIDT)
  1. Q:'LRDFN Q:$G(LRSS)="" Q:'LRI Q:'$D(^LR(+LRDFN,LRSS,LRI))&(LRSS'="AU")
  1. N LRAA,FST,GCNT,B
  1. ;
  1. K ^TMP("LRC",$J)
  1. ;
  1. D:LRSS="CY" CY D:LRSS="SP" SPA D:LRSS="EM" EM
  1. ;
  1. S FST=0,GCNT=0,B=$G(^LR(LRDFN,LRSS,LRI,0))
  1. ;
  1. S GIOM=$G(LRGIOM)
  1. I GIOM="" D
  1. . S GIOM=$$GET^XPAR("USR^DIV^PKG","LR AP GUI REPORT RIGHT MARGIN",1,"Q")
  1. . I GIOM="" S GIOM=96
  1. ;
  1. ; Display "Printed at:" notice
  1. I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1 D PFAC^LR7OSMZU
  1. ;
  1. I LRSS="AU" D AU
  1. I LRSS'="AU" D
  1. . D W^LR7OSAP
  1. ;
  1. M @LRX=^TMP("LRC",$J)
  1. Q
  1. ;
  1. ;
  1. CY ;
  1. S LRSS="CY",LRAA(1)="CYTOPATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
  1. Q
  1. ;
  1. ;
  1. SPA ;
  1. S LRSS="SP",LRAA(1)="SURGICAL PATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
  1. Q
  1. ;
  1. ;
  1. EM ;
  1. S LRSS="EM",LRAA(1)="ELECTRON MICROSCOPY",LRAA=+$O(^LRO(68,"B","EM",0)) S:'LRAA LRAA=$$FIND(LRSS)
  1. Q
  1. ;
  1. ;
  1. AU ;
  1. D EN^LR7OSAP2(LRDFN)
  1. Q
  1. ;
  1. ;
  1. FIND(SS) ;Find a valid entry in 68
  1. ; SS=LRSS value to look for
  1. N I,Y
  1. 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
  1. Q Y