source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LROW2P.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1LROW2P ;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
6ENT ;
7 S U="^" S:$D(ZTQUEUED) ZTREQ="@"
8ENT2 ;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
27TEST 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
Note: See TracBrowser for help on using the repository browser.