LRAPDS.m

LRAPDS ;AVAMC/REG - AP REPORT DISPLAYS/PRINTS ;11/9/95  07:22 ;

 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994

 D ^LRAPCUM,END Q

 ;

 ;display

CY D END S (LRAA(1),X)="CYTOPATHOLOGY",LRSS="CY" D SET G LRAPDS

SP D END S (LRAA(1),X)="SURGICAL PATHOLOGY",LRSS="SP" D SET G LRAPDS

EM D END S LRAA(1)="ELECTRON MICROSCOPY",(LRSS,X)="EM" D SET G LRAPDS

 ;

 ;print

PCY D END S (LRAA(1),X)="CYTOPATHOLOGY",LRSS="CY" D SET G P

PSP D END S (LRAA(1),X)="SURGICAL PATHOLOGY",LRSS="SP" D SET G P

PEM D END S LRAA(1)="ELECTRON MICROSCOPY",(LRSS,X)="EM" D SET G P

 ;

P S (LR("R"),LR("W"))=1 D SGL^LRSPRPT,END Q

 ;

END D V^LRU Q

 ;

SET S LRAA=+$O(^LRO(68,"B",X,0)) Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRAPDS   660     printed  Apr 09, 2024@21:17:17                                                                                                                                                                                                       Page 2

LRAPDS    ;AVAMC/REG - AP REPORT DISPLAYS/PRINTS ;11/9/95  07:22 ;

 +1       ;;5.2;LAB SERVICE;**72**;Sep 27, 1994

 +2        DO ^LRAPCUM

           DO END

           QUIT 

 +3       ;

 +4       ;display

CY         DO END

           SET (LRAA(1),X)="CYTOPATHOLOGY"

           SET LRSS="CY"

           DO SET

           GOTO LRAPDS

SP         DO END

           SET (LRAA(1),X)="SURGICAL PATHOLOGY"

           SET LRSS="SP"

           DO SET

           GOTO LRAPDS

EM         DO END

           SET LRAA(1)="ELECTRON MICROSCOPY"

           SET (LRSS,X)="EM"

           DO SET

           GOTO LRAPDS

 +1       ;

 +2       ;print

PCY        DO END

           SET (LRAA(1),X)="CYTOPATHOLOGY"

           SET LRSS="CY"

           DO SET

           GOTO P

PSP        DO END

           SET (LRAA(1),X)="SURGICAL PATHOLOGY"

           SET LRSS="SP"

           DO SET

           GOTO P

PEM        DO END

           SET LRAA(1)="ELECTRON MICROSCOPY"

           SET (LRSS,X)="EM"

           DO SET

           GOTO P

 +1       ;

P          SET (LR("R"),LR("W"))=1

           DO SGL^LRSPRPT

           DO END

           QUIT 

 +1       ;

END        DO V^LRU

           QUIT 

 +1       ;

SET        SET LRAA=+$ORDER(^LRO(68,"B",X,0))

           QUIT