LRAPAUPT ;AVAMC/REG/WTY - AUTOPSY PRINT ;9/13/01
;;5.2;LAB SERVICE;**72,248,259**;Sep 27, 1994
;
N LRFLG
S:$G(LREND) LREND=0
S LRDICS="AU" D ^LRAP G:'$D(Y) END
S LR("Q")=0
S LR("AU1")=1,LRAPX=3
D XR^LRU,EN2^LRUA,SGL^LRAURPT
I LR("Q") D END Q
I '$G(POP),'$D(ZTSK),LR("AU1")=1,LRDFN>0 D
.S LRFLG=1
.D EN^LRAPAUSR
.I '+$G(LR("Q")),IOST?1"C-".E D
..K DIR S DIR(0)="E"
..D ^DIR W @IOF
END ;
W:IOST?1"P-".E @IOF
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
D V^LRU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPAUPT 490 printed Nov 22, 2024@17:17 Page 2
LRAPAUPT ;AVAMC/REG/WTY - AUTOPSY PRINT ;9/13/01
+1 ;;5.2;LAB SERVICE;**72,248,259**;Sep 27, 1994
+2 ;
+3 NEW LRFLG
+4 if $GET(LREND)
SET LREND=0
+5 SET LRDICS="AU"
DO ^LRAP
if '$DATA(Y)
GOTO END
+6 SET LR("Q")=0
+7 SET LR("AU1")=1
SET LRAPX=3
+8 DO XR^LRU
DO EN2^LRUA
DO SGL^LRAURPT
+9 IF LR("Q")
DO END
QUIT
+10 IF '$GET(POP)
IF '$DATA(ZTSK)
IF LR("AU1")=1
IF LRDFN>0
Begin DoDot:1
+11 SET LRFLG=1
+12 DO EN^LRAPAUSR
+13 IF '+$GET(LR("Q"))
IF IOST?1"C-".E
Begin DoDot:2
+14 KILL DIR
SET DIR(0)="E"
+15 DO ^DIR
WRITE @IOF
End DoDot:2
End DoDot:1
END ;
+1 if IOST?1"P-".E
WRITE @IOF
+2 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 DO V^LRU
+4 QUIT
