LROW2P ;SLC/TGA - PRINTS WARD COLLECT ORDER IN LAB ; 6/29/05 11:01am
;;5.2;LAB SERVICE;**100,121,338,460**;Sep 27, 1994;Build 1
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 !,"PROVIDER: " W $S($D(^VA(200,LRPR,0)):$E($P(^(0),"^"),1,25),1:"UNKNOWN")
I LRORDTIM S Y=LRODT_"."_LRORDTIM D DD^LRX W ?38,$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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLROW2P 2456 printed Oct 16, 2024@18:19:55 Page 2
LROW2P ;SLC/TGA - PRINTS WARD COLLECT ORDER IN LAB ; 6/29/05 11:01am
+1 ;;5.2;LAB SERVICE;**100,121,338,460**;Sep 27, 1994;Build 1
+2 SET ZTRTN="ENT^LROW2P"
SET ZTIO=ION
SET ZTDTH=$HOROLOG
SET ZTSAVE("LRSN")=""
SET ZTSAVE("LRODT")=""
SET ZTDESC="PRINTS WARD COLLECT ORDER"
IF ION]""
DO ^%ZTLOAD
+3 KILL ZTSK,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTDESC
+4 QUIT
ENT ;
+1 SET U="^"
if $DATA(ZTQUEUED)
SET ZTREQ="@"
ENT2 ;from LRORDST, LROW2
+1 if '$DATA(^LRO(69,LRODT,1,LRSN,0))
QUIT
+2 NEW LRSAMP,GOT,I
SET GOT=0
+3 SET I=0
FOR
SET I=$ORDER(^LRO(69,LRODT,1,LRSN,2,I))
if I<1
QUIT
IF $DATA(^(I,0))
IF '$PIECE(^(0),"^",11)
SET GOT=1
+4 if 'GOT
QUIT
+5 SET X=^LRO(69,LRODT,1,LRSN,0)
SET LRCSS=$SELECT($DATA(^(4,1)):^(1,0),1:0)
SET LRDFN=$PIECE(X,U)
SET (LRSAMP,LRCS)=$PIECE(X,U,3)
SET LRLWC=$PIECE(X,U,4)
SET LRDTO=$PIECE(X,U,5)
SET LRPR=$PIECE(X,U,6)
SET LRLLOC=$PIECE(X,U,7)
SET LRORDTIM=$PIECE($PIECE(X,U,8),".",2)
SET LRDUZ=$PIECE(X,U,2)
+6 SET LRCSS=$SELECT($DATA(^LAB(61,+LRCSS,0)):$PIECE(^(0),U),1:"")
SET LRCS=$SELECT($DATA(^LAB(62,+LRCS,0)):^(0),1:"")
+7 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
SET X=^DIC(LRDPF,0,"GL")_DFN_",0)"
SET PNM=$SELECT($DATA(@X):$PIECE(@X,U),1:"UNKNOWN")
SET SSN=$SELECT($DATA(@X):$PIECE(@X,U,9),1:"UNKNOWN")
SET X=^DIC(LRDPF,0,"GL")_DFN_",.101)"
SET LRBED=$SELECT($DATA(@X):^(.101),1:"")
+8 if SSN
DO SSN^LRU
+9 WRITE !!,?23,$SELECT(LRLWC="SP":"Send Patient",LRLWC="WC":"Ward Collect",LRLWC="I":"Immed Lab Collect ",1:"Lab Collect")," ORDER FOR "
SET Y=LRODT
DO DD^LRX
WRITE Y
+10 WRITE !,?23,"ORDER: ",$SELECT($DATA(^LRO(69,LRODT,1,LRSN,.1)):^(.1),1:""),?40,"LOCATION: ",LRLLOC
if $LENGTH(LRBED)
WRITE " BED: ",LRBED
+11 WRITE !,PNM,?40,SSN,!,"ENTERED BY: "
SET X=LRDUZ
DO DUZ^LRX
KILL LRDUZ
WRITE LRUSNM,?40
SET Y=LRDTO
DO DD^LRX
WRITE Y
+12 IF $LENGTH(LRPR)
WRITE !,"PROVIDER: "
WRITE $SELECT($DATA(^VA(200,LRPR,0)):$EXTRACT($PIECE(^(0),"^"),1,25),1:"UNKNOWN")
+13 IF LRORDTIM
SET Y=LRODT_"."_LRORDTIM
DO DD^LRX
WRITE ?38,$SELECT(LRLWC="I":"REQUESTED",1:" Est.")_" Collect Time: ",Y
+14 WRITE !,"Collection sample: ",$PIECE(LRCS,U)," ",$PIECE(LRCS,U,3)
if $PIECE(LRCS,U)'[LRCSS
WRITE ?32," Site/Specimen: ",LRCSS
+15 SET T=0
FOR
SET T=$ORDER(^LRO(69,LRODT,1,LRSN,2,T))
if T<1
QUIT
SET LRTP=^(T,0)
if '$PIECE(LRTP,"^",11)
DO TEST
+16 WRITE !!!,"TIME OF COLLECTION:__________"
+17 IF $DATA(^LRO(69,LRODT,1,LRSN,6,0))
WRITE !!,"Order comment: "
FOR I=0:0
SET I=$ORDER(^LRO(69,LRODT,1,LRSN,6,I))
if I<1
QUIT
WRITE !?2,^(I,0)
+18 WRITE !
if $EXTRACT(IOST)="P"
WRITE @IOF
DO ^%ZISC
QUIT
TEST WRITE !,"TEST/PROCEDURE: ",$PIECE(^LAB(60,+LRTP,0),U)
SET LRUR=+$PIECE(LRTP,U,2)
if LRUR
WRITE ?48,$PIECE(^LAB(62.05,LRUR,0),U)
+1 IF $DATA(^LAB(60,+LRTP,3,"B",+LRSAMP))
SET X=$ORDER(^(+LRSAMP,0))
IF X
IF $DATA(^LAB(60,+LRTP,3,X,1))
NEW I
SET I=0
Begin DoDot:1
+2 WRITE !,"Ward Instructions:"
+3 FOR
SET I=$ORDER(^LAB(60,+LRTP,3,X,1,I))
if I<1
QUIT
WRITE !?2,^(I,0)
End DoDot:1
+4 IF $ORDER(^LRO(69,LRODT,1,LRSN,2,T,1,0))
WRITE !,"Ward Comments:"
+5 SET I=0
FOR
SET I=$ORDER(^LRO(69,LRODT,1,LRSN,2,T,1,I))
if I<1
QUIT
WRITE !?2,^(I,0)
+6 QUIT
