VistA-WorldVistAEHR/r/LAB_SERVICE-LR-LS/LRAPAUPT.m

22 lines
469 B
Mathematica

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