source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LROW2P.m@ 1800

LROW2P ;SLC/TGA - PRINTS WARD COLLECT ORDER IN LAB ; 6/29/05 11:01am

 ;;5.2;LAB SERVICE;**100,121,338**;Sep 27, 1994

 S ZTRTN="ENT^LROW2P",ZTIO=ION,ZTDTH=$H,ZTSAVE("LRSN")="",ZTSAVE("LRODT")="",ZTDESC="PRINTS WARD COLLECT ORDER" I ION]"" D ^%ZTLOAD

 K ZTSK,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTDESC

 Q

ENT ;

 S U="^" S:$D(ZTQUEUED) ZTREQ="@"

ENT2 ;from LRORDST, LROW2

 Q:'$D(^LRO(69,LRODT,1,LRSN,0))

 N LRSAMP,GOT,I S GOT=0

 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

 Q:'GOT

 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)

 S LRCSS=$S($D(^LAB(61,+LRCSS,0)):$P(^(0),U),1:""),LRCS=$S($D(^LAB(62,+LRCS,0)):^(0),1:"")

 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:"")

 D:SSN SSN^LRU

 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

 W !,?23,"ORDER: ",$S($D(^LRO(69,LRODT,1,LRSN,.1)):^(.1),1:""),?40,"LOCATION: ",LRLLOC W:$L(LRBED) "    BED: ",LRBED

 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

 I $L(LRPR) W !,"PRACTITIONER: " W $S($D(^VA(200,LRPR,0)):$P(^(0),"^"),1:"UNKNOWN")

 I LRORDTIM S Y=LRODT_"."_LRORDTIM D DD^LRX W ?32,$S(LRLWC="I":"REQUESTED ",1:" Est.")_" Collect Time: ",Y

 W !,"Collection sample: ",$P(LRCS,U),"  ",$P(LRCS,U,3) W:$P(LRCS,U)'[LRCSS ?32," Site/Specimen: ",LRCSS

 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

 W !!!,"TIME OF COLLECTION:__________"

 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)

 W ! W:$E(IOST)="P" @IOF D ^%ZISC Q

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)

 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

 . W !,"Ward Instructions:"

 . F  S I=$O(^LAB(60,+LRTP,3,X,1,I)) Q:I<1  W !?2,^(I,0)

 I $O(^LRO(69,LRODT,1,LRSN,2,T,1,0)) W !,"Ward Comments:"

 S I=0 F  S I=$O(^LRO(69,LRODT,1,LRSN,2,T,1,I)) Q:I<1  W !?2,^(I,0)

 Q