LRAPAUPT.m

LRAPAUPT ;AVAMC/REG/WTY - AUTOPSY PRINT ;9/13/01

 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997

 ;;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

LRAPAUPT  ;AVAMC/REG/WTY - AUTOPSY PRINT ;9/13/01

 +1       ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997

 +2       ;;5.2;LAB SERVICE;**72,248,259**;Sep 27, 1994

 +3       ;

 +4        NEW LRFLG

 +5        IF $GET(LREND)

               SET LREND=0

 +6        SET LRDICS="AU"

           DO ^LRAP

           IF '$DATA(Y)

               GOTO END

 +7        SET LR("Q")=0

 +8        SET LR("AU1")=1

           SET LRAPX=3

 +9        DO XR^LRU

           DO EN2^LRUA

           DO SGL^LRAURPT

 +10       IF LR("Q")

               DO END

               QUIT 

 +11       IF '$GET(POP)

               IF '$DATA(ZTSK)

                   IF LR("AU1")=1

                       IF LRDFN>0

                           Begin DoDot:1

 +12                           SET LRFLG=1

 +13                           DO EN^LRAPAUSR

 +14                           IF '+$GET(LR("Q"))

                                   IF IOST?1"C-".E

                                       Begin DoDot:2

 +15                                       KILL DIR

                                           SET DIR(0)="E"

 +16                                       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