- 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 Jan 18, 2025@03:08:01 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