LRNODRAW ;SLC/CJS - PRINT LIST OF NON-DRAW ORDERS ;8/11/97
 ;;5.2;LAB SERVICE;**121,153**;Sep 27, 1994
 S %DT="AE" D ^%DT Q:Y<1  S U="^",LRODT=+Y,LRLLOC="",%ZIS="Q" W !!?10," You may enter 'ALL' as a response",! D FNDLOC^LRDRAW G END:LRLLOC["^"
 S %ZIS="QN" D ^%ZIS G:POP END I IO=IO(0) G GO
 K IO("Q") S ZTRTN="GO^LRNODRAW",ZTDTH=$H,ZTSAVE("L*")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTIO,ZTDTH,ZTSAVE
END K J,%DT,%,A,I,K,LRDC,LRSN,X,Y,Z,DIC,%ZIS,LRBECAUS,LRCOMB,LRODT,LRLLOC,LRPGM,LRIO,LRTIME,%H,%X,%Y,DFN,LRDFN,LRDPF,LRIOZERO,LRLWC,PNM,POP,SSN Q
% R %:DTIME S:'$T DTOUT=1 Q:%=""!(%["N")!(%["Y")  W !,"Answer 'Y' or 'N': " G %
GO S Y=LRODT D DD^LRX W @IOF,!,"LIST OF PATIENT LAB ORDERS NOT DRAWN  "_Y S LRDC=0 S %DT="T",X="N" D ^%DT,DD^%DT W ?60,Y
 I LRLLOC="" F I=0:0 S LRLLOC=$O(^LRO(69,LRODT,1,"AC",LRLLOC)) Q:LRLLOC=""  D ORD
 I LRLLOC'="" D ORD
 I 'LRDC W !,"REPORT EMPTY"
 W !,"Finished",! D ^%ZISC,END Q
ORD S LRSN=0 F  S LRSN=$O(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)) Q:LRSN<1  S LRDC=1 D PRNT
 Q
PRNT ;
 I $D(^LRO(69,LRODT,1,LRSN,1)),$P(^(1),U,4)="C" Q
 I '$L($P(^LRO(69,LRODT,1,LRSN,0),U,4)) Q
 I $D(^LRO(69,LRODT,1,LRSN,0)),$P(^(0),U,4)'="LC" Q
 S LRDFN=+^LRO(69,LRODT,1,LRSN,0)
 I '$D(^LRO(69,LRODT,1,LRSN,1)),$P(^LRO(69,LRODT,1,LRSN,0),U,4)="LC",'$O(^LRO(69,LRODT,1,LRSN,2,0)) S LRBECAUS="ORDER DELETED" G PRN
 I '$D(^LRO(69,LRODT,1,LRSN,1)),$P(^LRO(69,LRODT,1,LRSN,0),U,4)="LC" S LRBECAUS="NOT ON LIST YET ** " G PRN
 S LRBECAUS=$S($L($P(^LRO(69,LRODT,1,LRSN,1),"^",6)):$P(^(1),U,6),1:"")
PRN ;
 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
 W !!,PNM,?40,SSN,!,"LOCATION: ",LRLLOC,?30,"NON-DRAW",?40,"Order: ",^LRO(69,LRODT,1,LRSN,.1)
 W !,"TESTS: " S I=0
 F  S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1  S X=^(I,0),Y=$S($P(X,U,3):$P(X,U,3),1:0),LRCOMB=$P(X,U,6) D
 . Q:'$D(^LAB(60,+X,0))#2
 . W ?9,$P(^LAB(60,+X,0),U)
 . I Y D DD^LRX W "  Accessioned  "_Y
 . I LRCOMB W !?9,"COMBINED WITH ORDER # "_LRCOMB
 . I $P(X,"^",11) W !?9,"Canceled by: "_$P(^VA(200,$P(X,"^",11),0),"^")
 . W !
 W:$L(LRBECAUS) !,"REASON: ",LRBECAUS
 Q
EN S:$D(ZTQUEUED) ZTREQ="@" G GO