| [613] | 1 | LRNODRAW ;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
|
|---|
| 6 | 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
|
|---|
| 7 | % R %:DTIME S:'$T DTOUT=1 Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
|
|---|
| 8 | 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
|
|---|
| 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
|
|---|
| 13 | ORD S LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)) Q:LRSN<1 S LRDC=1 D PRNT
|
|---|
| 14 | Q
|
|---|
| 15 | PRNT ;
|
|---|
| 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:"")
|
|---|
| 23 | PRN ;
|
|---|
| 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
|
|---|
| 36 | EN S:$D(ZTQUEUED) ZTREQ="@" G GO
|
|---|
