- LR7OSAP4 ;DALOI/staff - Silent AP API ;11/05/09 10:57
- ;;5.2;LAB SERVICE;**365,350**;Sep 27, 1994;Build 230
- ;
- EN(LRX,LRDFN,LRSS,LRI,LRGIOM) ;Get Anatomic Path results from either TIU or Lab files
- ; LRX is the global where the output is placed. Calling package is responsible for cleaning this up
- ; LRDFN = Lab Patient ID
- ; LRSS = Lab Subscript
- ; LRI = Inverse Date/Time from ^LR(LRDFN,LRSS,LRIDT)
- Q:'LRDFN Q:$G(LRSS)="" Q:'LRI Q:'$D(^LR(+LRDFN,LRSS,LRI))&(LRSS'="AU")
- N LRAA,FST,GCNT,B
- ;
- K ^TMP("LRC",$J)
- ;
- D:LRSS="CY" CY D:LRSS="SP" SPA D:LRSS="EM" EM
- ;
- S FST=0,GCNT=0,B=$G(^LR(LRDFN,LRSS,LRI,0))
- ;
- S GIOM=$G(LRGIOM)
- I GIOM="" D
- . S GIOM=$$GET^XPAR("USR^DIV^PKG","LR AP GUI REPORT RIGHT MARGIN",1,"Q")
- . I GIOM="" S GIOM=96
- ;
- ; Display "Printed at:" notice
- I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1 D PFAC^LR7OSMZU
- ;
- I LRSS="AU" D AU
- I LRSS'="AU" D
- . D W^LR7OSAP
- ;
- M @LRX=^TMP("LRC",$J)
- Q
- ;
- ;
- CY ;
- S LRSS="CY",LRAA(1)="CYTOPATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
- Q
- ;
- ;
- SPA ;
- S LRSS="SP",LRAA(1)="SURGICAL PATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
- Q
- ;
- ;
- EM ;
- S LRSS="EM",LRAA(1)="ELECTRON MICROSCOPY",LRAA=+$O(^LRO(68,"B","EM",0)) S:'LRAA LRAA=$$FIND(LRSS)
- Q
- ;
- ;
- AU ;
- D EN^LR7OSAP2(LRDFN)
- Q
- ;
- ;
- FIND(SS) ;Find a valid entry in 68
- ; SS=LRSS value to look for
- N I,Y
- 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
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSAP4 1543 printed Jan 18, 2025@03:06:11 Page 2
- LR7OSAP4 ;DALOI/staff - Silent AP API ;11/05/09 10:57
- +1 ;;5.2;LAB SERVICE;**365,350**;Sep 27, 1994;Build 230
- +2 ;
- 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
- +2 ; LRDFN = Lab Patient ID
- +3 ; LRSS = Lab Subscript
- +4 ; LRI = Inverse Date/Time from ^LR(LRDFN,LRSS,LRIDT)
- +5 if 'LRDFN
- QUIT
- if $GET(LRSS)=""
- QUIT
- if 'LRI
- QUIT
- if '$DATA(^LR(+LRDFN,LRSS,LRI))&(LRSS'="AU")
- QUIT
- +6 NEW LRAA,FST,GCNT,B
- +7 ;
- +8 KILL ^TMP("LRC",$JOB)
- +9 ;
- +10 if LRSS="CY"
- DO CY
- if LRSS="SP"
- DO SPA
- if LRSS="EM"
- DO EM
- +11 ;
- +12 SET FST=0
- SET GCNT=0
- SET B=$GET(^LR(LRDFN,LRSS,LRI,0))
- +13 ;
- +14 SET GIOM=$GET(LRGIOM)
- +15 IF GIOM=""
- Begin DoDot:1
- +16 SET GIOM=$$GET^XPAR("USR^DIV^PKG","LR AP GUI REPORT RIGHT MARGIN",1,"Q")
- +17 IF GIOM=""
- SET GIOM=96
- End DoDot:1
- +18 ;
- +19 ; Display "Printed at:" notice
- +20 IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1
- DO PFAC^LR7OSMZU
- +21 ;
- +22 IF LRSS="AU"
- DO AU
- +23 IF LRSS'="AU"
- Begin DoDot:1
- +24 DO W^LR7OSAP
- End DoDot:1
- +25 ;
- +26 MERGE @LRX=^TMP("LRC",$JOB)
- +27 QUIT
- +28 ;
- +29 ;
- CY ;
- +1 SET LRSS="CY"
- SET LRAA(1)="CYTOPATHOLOGY"
- SET LRAA=+$ORDER(^LRO(68,"B",LRAA(1),0))
- if 'LRAA
- SET LRAA=$$FIND(LRSS)
- +2 QUIT
- +3 ;
- +4 ;
- SPA ;
- +1 SET LRSS="SP"
- SET LRAA(1)="SURGICAL PATHOLOGY"
- SET LRAA=+$ORDER(^LRO(68,"B",LRAA(1),0))
- if 'LRAA
- SET LRAA=$$FIND(LRSS)
- +2 QUIT
- +3 ;
- +4 ;
- EM ;
- +1 SET LRSS="EM"
- SET LRAA(1)="ELECTRON MICROSCOPY"
- SET LRAA=+$ORDER(^LRO(68,"B","EM",0))
- if 'LRAA
- SET LRAA=$$FIND(LRSS)
- +2 QUIT
- +3 ;
- +4 ;
- AU ;
- +1 DO EN^LR7OSAP2(LRDFN)
- +2 QUIT
- +3 ;
- +4 ;
- FIND(SS) ;Find a valid entry in 68
- +1 ; SS=LRSS value to look for
- +2 NEW I,Y
- +3 SET I=0
- SET Y=""
- FOR
- SET I=$ORDER(^LRO(68,I))
- if I<1
- QUIT
- IF $PIECE($GET(^LRO(68,I,0)),"^",2)=SS
- SET Y=I
- QUIT
- +4 QUIT Y