- LRAPDS ; IHS/DIR/AAB - AP REPORT DISPLAYS/PRINTS 11/9/95 07:22 ;
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;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
- LRAPDS ; IHS/DIR/AAB - AP REPORT DISPLAYS/PRINTS 11/9/95 07:22 ;
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- +3 DO ^LRAPCUM
- DO END
- QUIT
- +4 ;
- +5 ;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
