| 1 | LRDRAW ;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
|
|---|
| 9 | BEGIN 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
|
|---|
| 10 | END K DIC,%ZIS,LRODT,LRLLOC,LRPGM,LRIO,LRTIME,LRDC,LRDFN,LRDPF,LRIOZERO,LRLWC,LRSN,PNM,SSN,Z
|
|---|
| 11 | Q
|
|---|
| 12 | GO 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
|
|---|
| 19 | ORD 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
|
|---|
| 21 | PRNT 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
|
|---|
| 26 | FNDLOC ;return a location from ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN), from LRNODRQW, LRPHEXPT, LRPHITEM
|
|---|
| 27 | LOOP 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
|
|---|
| 35 | SOME 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
|
|---|
| 41 | LALL 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
|
|---|
| 45 | LEND K %,X,Y S LRLLOC="^" Q
|
|---|
