1 | LROW2P ;SLC/TGA - PRINTS WARD COLLECT ORDER IN LAB ; 6/29/05 11:01am
|
---|
2 | ;;5.2;LAB SERVICE;**100,121,338**;Sep 27, 1994
|
---|
3 | S ZTRTN="ENT^LROW2P",ZTIO=ION,ZTDTH=$H,ZTSAVE("LRSN")="",ZTSAVE("LRODT")="",ZTDESC="PRINTS WARD COLLECT ORDER" I ION]"" D ^%ZTLOAD
|
---|
4 | K ZTSK,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTDESC
|
---|
5 | Q
|
---|
6 | ENT ;
|
---|
7 | S U="^" S:$D(ZTQUEUED) ZTREQ="@"
|
---|
8 | ENT2 ;from LRORDST, LROW2
|
---|
9 | Q:'$D(^LRO(69,LRODT,1,LRSN,0))
|
---|
10 | N LRSAMP,GOT,I S GOT=0
|
---|
11 | S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1 I $D(^(I,0)),'$P(^(0),"^",11) S GOT=1
|
---|
12 | Q:'GOT
|
---|
13 | S X=^LRO(69,LRODT,1,LRSN,0),LRCSS=$S($D(^(4,1)):^(1,0),1:0),LRDFN=$P(X,U),(LRSAMP,LRCS)=$P(X,U,3),LRLWC=$P(X,U,4),LRDTO=$P(X,U,5),LRPR=$P(X,U,6),LRLLOC=$P(X,U,7),LRORDTIM=$P($P(X,U,8),".",2),LRDUZ=$P(X,U,2)
|
---|
14 | S LRCSS=$S($D(^LAB(61,+LRCSS,0)):$P(^(0),U),1:""),LRCS=$S($D(^LAB(62,+LRCS,0)):^(0),1:"")
|
---|
15 | S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),X=^DIC(LRDPF,0,"GL")_DFN_",0)",PNM=$S($D(@X):$P(@X,U),1:"UNKNOWN"),SSN=$S($D(@X):$P(@X,U,9),1:"UNKNOWN") S X=^DIC(LRDPF,0,"GL")_DFN_",.101)" S LRBED=$S($D(@X):^(.101),1:"")
|
---|
16 | D:SSN SSN^LRU
|
---|
17 | W !!,?23,$S(LRLWC="SP":"Send Patient",LRLWC="WC":"Ward Collect",LRLWC="I":"Immed Lab Collect ",1:"Lab Collect")," ORDER FOR " S Y=LRODT D DD^LRX W Y
|
---|
18 | W !,?23,"ORDER: ",$S($D(^LRO(69,LRODT,1,LRSN,.1)):^(.1),1:""),?40,"LOCATION: ",LRLLOC W:$L(LRBED) " BED: ",LRBED
|
---|
19 | W !,PNM,?40,SSN,!,"ENTERED BY: " S X=LRDUZ D DUZ^LRX K LRDUZ W LRUSNM,?40 S Y=LRDTO D DD^LRX W Y
|
---|
20 | I $L(LRPR) W !,"PRACTITIONER: " W $S($D(^VA(200,LRPR,0)):$P(^(0),"^"),1:"UNKNOWN")
|
---|
21 | I LRORDTIM S Y=LRODT_"."_LRORDTIM D DD^LRX W ?32,$S(LRLWC="I":"REQUESTED ",1:" Est.")_" Collect Time: ",Y
|
---|
22 | W !,"Collection sample: ",$P(LRCS,U)," ",$P(LRCS,U,3) W:$P(LRCS,U)'[LRCSS ?32," Site/Specimen: ",LRCSS
|
---|
23 | S T=0 F S T=$O(^LRO(69,LRODT,1,LRSN,2,T)) Q:T<1 S LRTP=^(T,0) D:'$P(LRTP,"^",11) TEST
|
---|
24 | W !!!,"TIME OF COLLECTION:__________"
|
---|
25 | I $D(^LRO(69,LRODT,1,LRSN,6,0)) W !!,"Order comment: " F I=0:0 S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I<1 W !?2,^(I,0)
|
---|
26 | W ! W:$E(IOST)="P" @IOF D ^%ZISC Q
|
---|
27 | TEST W !,"TEST/PROCEDURE: ",$P(^LAB(60,+LRTP,0),U) S LRUR=+$P(LRTP,U,2) W:LRUR ?48,$P(^LAB(62.05,LRUR,0),U)
|
---|
28 | I $D(^LAB(60,+LRTP,3,"B",+LRSAMP)) S X=$O(^(+LRSAMP,0)) I X,$D(^LAB(60,+LRTP,3,X,1)) N I S I=0 D
|
---|
29 | . W !,"Ward Instructions:"
|
---|
30 | . F S I=$O(^LAB(60,+LRTP,3,X,1,I)) Q:I<1 W !?2,^(I,0)
|
---|
31 | I $O(^LRO(69,LRODT,1,LRSN,2,T,1,0)) W !,"Ward Comments:"
|
---|
32 | S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,2,T,1,I)) Q:I<1 W !?2,^(I,0)
|
---|
33 | Q
|
---|