source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRDRAW.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1LRDRAW ;DALOI/CJS/RLM-WARD COLLECTION SUMMARY ;8/11/97
2 ;;5.2;LAB SERVICE;**121,190,272,369**;Sep 27, 1994;Build 2
3 ; Reference to ^%DT supported by DBIA #10003
4 ; Reference to $$FMTE^XLFDT supported by IA #10103
5 ; Reference to $$NOW^XLFDT supported by IA #10103
6 ; Reference to ^DIC supported by IA #10007
7 ; Reference to ^SC( supported by DBIA #908
8 ; Reference to ^VA(200 supported by DBIA #10060
9BEGIN S %DT="AE" D ^%DT Q:Y<1 S U="^",%ZIS="Q",LRODT=+Y D FNDLOC Q:LRLLOC[U S ZTRTN="GO^LRDRAW" D IO^LRWU
10END K DIC,%ZIS,LRODT,LRLLOC,LRPGM,LRIO,LRTIME,LRDC,LRDFN,LRDPF,LRIOZERO,LRLWC,LRSN,PNM,SSN,Z
11 Q
12GO S:$D(ZTQUEUED) ZTREQ="@" U IO S LRDC=0 W @IOF,!,"List of Patients with Lab Orders",?40,"Order Date: "_$$FMTE^XLFDT(LRODT,""),!
13 W ?2,"Date/Time Printed: "_$$FMTE^XLFDT($$NOW^XLFDT,""),!
14 I LRLLOC="" F I=0:0 S LRLLOC=$O(^LRO(69,LRODT,1,"AC",LRLLOC)) Q:LRLLOC="" D ORD
15 I LRLLOC'="" D ORD
16 I 'LRDC W !!,"REPORT EMPTY."
17 W !,"Report Completed",!
18 Q
19ORD S LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)) Q:LRSN<1 D:'$D(^LRO(69,LRODT,1,LRSN,1))&$D(^LRO(69,LRODT,1,LRSN,0)) PRNT
20 Q
21PRNT S LRDFN=+^LRO(69,LRODT,1,LRSN,0),LRLWC=$P(^(0),U,4),LRDC=1
22 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
23 W !!,PNM,?30,SSN,?50,"ORDER NUMBER: ",$S($D(^LRO(69,LRODT,1,LRSN,.1)):+^(.1),1:"?"),!,"LOCATION: ",LRLLOC,?50,$S(LRLWC="SP":"SEND PATIENT",LRLWC="WC":"WARD COLLECT",LRLWC="LC":"LAB COLLECT",1:"")
24 W !,"TESTS: " S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1 S X=^(I,0) W ?9,$P(^LAB(60,+X,0),U,1) W:$P(X,"^",11) ?30," Canceled by: "_$P(^VA(200,$P(X,"^",11),0),"^") W !
25 Q
26FNDLOC ;return a location from ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN), from LRNODRQW, LRPHEXPT, LRPHITEM
27LOOP S LRLLOC="" W !,$S($D(DIC("A")):DIC("A"),1:"Select PATIENT LOCATION: ")
28 R "ALL// ",X:DTIME G:'$T LEND S:X="" X="ALL" S:X="ALL"!(X="all") X="" S LRLLOC=X Q:X="" I $L(X) G LEND:X["^",LALL:X["?"!(X'?.ANP)
29 I $L(X)<2!($L(X)>30) W " Enter 2 - 30 alpha-numeric name" G LOOP
30 I $D(^LRO(69,LRODT,1,"AC",X)) S LRLLOC=X K %,X,Y Q
31 S DIC=44,DIC(0)="EMOZ",DIC("S")="I $L($P(^(0),U,2)),$D(^LRO(69,LRODT,1,""AC"",$P(^(0),U,2)))" D ^DIC K DIC
32 I $D(DTOUT)!$D(DUOUT) K DTOUT,DUOUT G LOOP
33 I Y>0 S LRLLOC=$P(Y(0),U,2) I $D(^LRO(69,LRODT,1,"AC",LRLLOC)) K %,X,Y Q
34 I '$D(^LRO(69,LRODT,1,"AC",LRLLOC)) W !,"["_LRLLOC_"] is not a valid entry",$C(7),! G LOOP
35SOME S Y=$O(^LRO(69,LRODT,1,"AC",X)) G LALL:Y=""!($E(Y,1,$L(LRLLOC))'=LRLLOC)
36 S %=$O(^LRO(69,LRODT,1,"AC",Y)) I $E(%,1,$L(LRLLOC))'=LRLLOC W $E(Y,$L(LRLLOC)+1,$L(Y)) S LRLLOC=Y K %,Y,X Q
37 K % S Y=X F %=1:1 S Y=$O(^LRO(69,LRODT,1,"AC",Y)) Q:Y=""!($E(Y,1,$L(LRLLOC))'=LRLLOC) S %(%)=Y W !,?5,%,?9,Y I '(%#10) R !,"Press ""^"" to quit ",X:DTIME S:'$T X="^" Q:X["^"
38 S %=%-1 W !,"CHOOSE 1-",%,": " R X:DTIME G:'$T LOOP G LALL:X["?" G LOOP:X["^"!(X="")
39 I X\1'=+X!(X<1)!(X>%) W " ??",$C(7),! G LOOP
40 S LRLLOC=%(X) K %,X,Y Q
41LALL S X="?",DIC=44,DIC(0)="EMOQ",DIC("S")="I $L($P(^(0),U,2)),$D(^LRO(69,LRODT,1,""AC"",$P(^(0),U,2)))" D ^DIC K DIC
42 S Y="" W !,"YOU MAY ALSO CHOOSE FROM:" F %=1:1 S Y=$O(^LRO(69,LRODT,1,"AC",Y)) Q:Y="" D
43 . I '$D(^SC("C",Y)) W !,?3,Y I '(%#10) R !,"Press ""^"" to quit ",X:DTIME S:'$T X="^" Q:X["^"
44 G LOOP
45LEND K %,X,Y S LRLLOC="^" Q
Note: See TracBrowser for help on using the repository browser.