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 ---[H[J[2J[HLRAPDS 660 printed Nov 22, 2024@17:17:24 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
