source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRNDLST.m@ 700

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1LRNDLST ;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,!
7END 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 %
11GO 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
19ORD 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
25PRNT ;
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
31EN D GO W:$E(IOST,1,2)="P-" @IOF S:$D(ZTQUEUED) ZTREQ="@" Q
32 Q
Note: See TracBrowser for help on using the repository browser.