1 | LRNDLST ;SLC/CJS - PRINT LIST OF NON-DRAW ORDERS ;2/19/91 11:03 ;
|
---|
2 | ;;5.2;LAB SERVICE;**7,13,351**;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 LRBEG=1
|
---|
5 | S %ZIS="QN" D ^%ZIS G:POP END I IO=IO(0) G GO
|
---|
6 | K IO("Q") S ZTDESC="LONG FORM NO DRAW LIST",ZTIO=ION,ZTRTN="EN^LRNDLST",ZTSAVE("LRODT")="",ZTSAVE("LRLLOC")="",ZTSAVE("LRBEG")="" D ^%ZTLOAD W !!?10,"Report Queued to device "_ION,!
|
---|
7 | END K LROUT,DX(0),S,ZTSK
|
---|
8 | K DIRUT,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 D ^%ZISC
|
---|
9 | Q
|
---|
10 | % R %:DTIME S:'$T LROUT=1 Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
|
---|
11 | GO K X,DX,DR,DIC S DR="0:99",U="^",Y=LRODT,PG=1 D DD^LRX S (LROUT,LRDC)=0
|
---|
12 | S DX(0)="I $E(IOST)=""C"" S S=$G(S)+1 I S>20 R ""'^' TO HALT: "",W:DTIME S:W=""^"" LROUT=1 S S=W'?1P W @IOF,!! I '$T S S=0,LROUT=1"
|
---|
13 | I LRLLOC="" F S LRLLOC=$O(^LRO(69,LRODT,1,"AC",LRLLOC)) Q:LRLLOC=""!(LROUT=1) S LRTOP=0,LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)) Q:LRSN<1!(LROUT=1) S LRDC=1 D ORD,PRNT
|
---|
14 | I LRLLOC'=""&(LROUT=0) S LRTOP=0,LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)) Q:LRSN<1!(LROUT=1) S LRDC=1 D ORD,PRNT
|
---|
15 | I 'LRDC W !,"REPORT EMPTY"
|
---|
16 | W !,"Finished",! W:$E(IOST,1,2)="P-" @IOF
|
---|
17 | S W="" R:'$G(LRBEG)&($E(IOST)="C") "Hit Enter to return to menu: ",W:DTIME
|
---|
18 | D ^%ZISC,END Q
|
---|
19 | ORD Q:$G(LROUT)
|
---|
20 | I $D(^LRO(69,LRODT,1,LRSN,1)),$P(^(1),U,4)="C" Q
|
---|
21 | I 'LRTOP S PG=1,W="" D
|
---|
22 | .R:'$G(LRBEG)&($E(IOST)="C") "Enter to CONTINUE or '^' TO HALT: ",W:DTIME
|
---|
23 | .S:W="^" LROUT=1 Q:$G(LROUT) W @IOF,!,"LIST OF PATIENT LAB ORDERS NOT DRAWN "_Y,!!!?10,"LISTING FOR ( ",LRLLOC," ) ",?50,"PG: ",PG,! S LRTOP=1 K LRBEG Q
|
---|
24 | Q
|
---|
25 | PRNT ;
|
---|
26 | Q:$G(LROUT) N S
|
---|
27 | I $D(^LRO(69,LRODT,1,LRSN,1)),$P(^(1),U,4)="C" Q
|
---|
28 | I '$L($P(^LRO(69,LRODT,1,LRSN,0),U,4)) Q
|
---|
29 | I $Y>$S($E(IOST)="C":18,1:60) S PG=PG+1 S W="" R:'$G(LRBEG)&($E(IOST)="C") "Enter to CONTINUE or '^' TO HALT: ",W:DTIME S:W="^" LROUT=1 Q:$G(LROUT) W @IOF,!!?10,"LISTING FOR ( ",LRLLOC," ) ",?50,"PG: ",PG,!
|
---|
30 | S DIC="^LRO(69,"_LRODT_",1,",(DA,D0)=LRSN,S=$Y S:'$D(DTOUT) DTOUT=0 D EN^LRDIQ Q:$G(LROUT) S LROUT=$G(DIRUT) Q
|
---|
31 | EN D GO W:$E(IOST,1,2)="P-" @IOF S:$D(ZTQUEUED) ZTREQ="@" Q
|
---|
32 | Q
|
---|