source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRNODRAW.m@ 1375

Last change on this file since 1375 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1LRNODRAW ;SLC/CJS - PRINT LIST OF NON-DRAW ORDERS ;8/11/97
2 ;;5.2;LAB SERVICE;**121,153**;Sep 27, 1994
3 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["^"
4 S %ZIS="QN" D ^%ZIS G:POP END I IO=IO(0) G GO
5 K IO("Q") S ZTRTN="GO^LRNODRAW",ZTDTH=$H,ZTSAVE("L*")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTIO,ZTDTH,ZTSAVE
6END 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
7% R %:DTIME S:'$T DTOUT=1 Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
8GO 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
9 I LRLLOC="" F I=0:0 S LRLLOC=$O(^LRO(69,LRODT,1,"AC",LRLLOC)) Q:LRLLOC="" D ORD
10 I LRLLOC'="" D ORD
11 I 'LRDC W !,"REPORT EMPTY"
12 W !,"Finished",! D ^%ZISC,END Q
13ORD S LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)) Q:LRSN<1 S LRDC=1 D PRNT
14 Q
15PRNT ;
16 I $D(^LRO(69,LRODT,1,LRSN,1)),$P(^(1),U,4)="C" Q
17 I '$L($P(^LRO(69,LRODT,1,LRSN,0),U,4)) Q
18 I $D(^LRO(69,LRODT,1,LRSN,0)),$P(^(0),U,4)'="LC" Q
19 S LRDFN=+^LRO(69,LRODT,1,LRSN,0)
20 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
21 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
22 S LRBECAUS=$S($L($P(^LRO(69,LRODT,1,LRSN,1),"^",6)):$P(^(1),U,6),1:"")
23PRN ;
24 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
25 W !!,PNM,?40,SSN,!,"LOCATION: ",LRLLOC,?30,"NON-DRAW",?40,"Order: ",^LRO(69,LRODT,1,LRSN,.1)
26 W !,"TESTS: " S I=0
27 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
28 . Q:'$D(^LAB(60,+X,0))#2
29 . W ?9,$P(^LAB(60,+X,0),U)
30 . I Y D DD^LRX W " Accessioned "_Y
31 . I LRCOMB W !?9,"COMBINED WITH ORDER # "_LRCOMB
32 . I $P(X,"^",11) W !?9,"Canceled by: "_$P(^VA(200,$P(X,"^",11),0),"^")
33 . W !
34 W:$L(LRBECAUS) !,"REASON: ",LRBECAUS
35 Q
36EN S:$D(ZTQUEUED) ZTREQ="@" G GO
Note: See TracBrowser for help on using the repository browser.