LROW2P ;VA/SLC/TGA - PRINTS WARD COLLECT ORDER IN LAB ; 22-Oct-2013 09:22 ; MKK
;;5.2;LAB SERVICE;**1027,1028,1033**;NOV 01, 1997;Build 46
;;5.2;LAB SERVICE;**100,121,338**;NOV 01, 1997
;S ZTRTN="ENT^LROW2P",ZTIO=ION,ZTDTH=$H,ZTSAVE("LRSN")="",ZTSAVE("LRODT")="",ZTDESC="PRINTS WARD COLLECT ORDER" I ION]"" D ^%ZTLOAD
S ZTRTN="ENT^LROW2P",ZTIO=ION,ZTDTH=$H,ZTSAVE("LRSN")="",ZTSAVE("LRODT")="",ZTDESC="PRINTS WARD/CLINIC COLLECT ORDER" I ION]"" D ^%ZTLOAD ;IHS/OIRM TUC/AAB 3/20/97
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,"LABORATORY: ",^DD("SITE") ;IHS/ANMC/CLS 08/18/96
;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,$S(LRLWC="SP":"Send Patient",LRLWC="WC":"Ward/Clinic Collect",LRLWC="I":"Immed Lab Collect ",1:"Lab Collect")," ORDER FOR " S Y=LRODT D DD^LRX W Y ;IHS/ANMC/CLS 08/18/96 AAB/3/20/97
W !,?23,"ORDER: ",$S($D(^LRO(69,LRODT,1,LRSN,.1)):^(.1),1:""),?40,"LOCATION: ",LRLLOC W:$L(LRBED) " BED: ",LRBED
D ENTRYAUD^BLRUTIL("ENT2^LROW2P 4.0","VADM")
I $G(DOB)="" D PT^LRX ; IHS/OIT/MKK - LR*5.2*1028
; 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
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027 -- Add in HRCN, DOB & SEX
W !!,$E(PNM,1,33),?35,$G(HRCN)
W ?46,"DOB:" W:$G(DOB)'="" $$FMTE^XLFDT(DOB,"5DZ")
W ?65,"SEX:",$G(SEX)
W !,"ENTERED BY: " S X=LRDUZ D DUZ^LRX K LRDUZ W LRUSNM,?40 S Y=LRDTO D DD^LRX W Y
; ----- END IHS/OIT/MKK - LR*5.2*1027
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:__________"
W !!!,"DATE/TIME OF COLLECTION:__________" ;IHS/ANMC/CLS 08/18/96
I $G(LRLWC)="WC" W !!,"COLLECTED BY:_____________________________" ;IHS/ANMC/CLS 08/18/96
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)
I $G(LRLWC)="SP" W !!,"** PLEASE BRING THIS WITH YOU TO THE LAB **",! ;IHS/ANMC/CLS 08/18/96
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)
;
;----- BEGIN IHS/OIT/MKK - LR*5.2*1027 -- PRINT OUT 'SIGN OR SYMPTOM' LAB POV
S LRTPTR=$P($G(^LRO(69,LRODT,1,LRSN,2,T,0)),U) ;TEST POINTER
S:LRTPTR'="" LRTNAME=$P($G(^LAB(60,LRTPTR,0)),U)
; W !,"Sign or Symptom for test "_$G(LRTNAME)_" : ",$G(^LRO(69,LRODT,1,LRSN,2,T,9999999)),!!
W !,"Clinical Indication for test "_$G(LRTNAME)_" : ",$G(^LRO(69,LRODT,1,LRSN,2,T,9999999)),!! ; IHS/MSC/MKK - LR*5.2*1033
K LRTPTR
;----- END IHS/OIT/MKK - LR*5.2*1027
Q
LROW2P ;VA/SLC/TGA - PRINTS WARD COLLECT ORDER IN LAB ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;LAB SERVICE;**1027,1028,1033**;NOV 01, 1997;Build 46
+2 ;;5.2;LAB SERVICE;**100,121,338**;NOV 01, 1997
+3 ;S ZTRTN="ENT^LROW2P",ZTIO=ION,ZTDTH=$H,ZTSAVE("LRSN")="",ZTSAVE("LRODT")="",ZTDESC="PRINTS WARD COLLECT ORDER" I ION]"" D ^%ZTLOAD
+4 ;IHS/OIRM TUC/AAB 3/20/97
SET ZTRTN="ENT^LROW2P"
SET ZTIO=ION
SET ZTDTH=$HOROLOG
SET ZTSAVE("LRSN")=""
SET ZTSAVE("LRODT")=""
SET ZTDESC="PRINTS WARD/CLINIC COLLECT ORDER"
IF ION]""
DO ^%ZTLOAD
+5 KILL ZTSK,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTDESC
+6 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 ;IHS/ANMC/CLS 08/18/96
WRITE !!,?23,"LABORATORY: ",^DD("SITE")
+10 ;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
+11 ;IHS/ANMC/CLS 08/18/96 AAB/3/20/97
WRITE !,?23,$SELECT(LRLWC="SP":"Send Patient",LRLWC="WC":"Ward/Clinic Collect",LRLWC="I":"Immed Lab Collect ",1:"Lab Collect")," ORDER FOR "
SET Y=LRODT
DO DD^LRX
WRITE Y
+12 WRITE !,?23,"ORDER: ",$SELECT($DATA(^LRO(69,LRODT,1,LRSN,.1)):^(.1),1:""),?40,"LOCATION: ",LRLLOC
IF $LENGTH(LRBED)
WRITE " BED: ",LRBED
+13 DO ENTRYAUD^BLRUTIL("ENT2^LROW2P 4.0","VADM")
+14 ; IHS/OIT/MKK - LR*5.2*1028
IF $GET(DOB)=""
DO PT^LRX
+15 ; 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
+16 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027 -- Add in HRCN, DOB & SEX
+17 WRITE !!,$EXTRACT(PNM,1,33),?35,$GET(HRCN)
+18 WRITE ?46,"DOB:"
IF $GET(DOB)'=""
WRITE $$FMTE^XLFDT(DOB,"5DZ")
+19 WRITE ?65,"SEX:",$GET(SEX)
+20 WRITE !,"ENTERED BY: "
SET X=LRDUZ
DO DUZ^LRX
KILL LRDUZ
WRITE LRUSNM,?40
SET Y=LRDTO
DO DD^LRX
WRITE Y
+21 ; ----- END IHS/OIT/MKK - LR*5.2*1027
+22 IF $LENGTH(LRPR)
WRITE !,"PRACTITIONER: "
WRITE $SELECT($DATA(^VA(200,LRPR,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+23 IF LRORDTIM
SET Y=LRODT_"."_LRORDTIM
DO DD^LRX
WRITE ?32,$SELECT(LRLWC="I":"REQUESTED ",1:" Est.")_" Collect Time: ",Y
+24 WRITE !,"Collection sample: ",$PIECE(LRCS,U)," ",$PIECE(LRCS,U,3)
IF $PIECE(LRCS,U)'[LRCSS
WRITE ?32," Site/Specimen: ",LRCSS
+25 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
+26 ;W !!!,"TIME OF COLLECTION:__________"
+27 ;IHS/ANMC/CLS 08/18/96
WRITE !!!,"DATE/TIME OF COLLECTION:__________"
+28 ;IHS/ANMC/CLS 08/18/96
IF $GET(LRLWC)="WC"
WRITE !!,"COLLECTED BY:_____________________________"
+29 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)
+30 ;IHS/ANMC/CLS 08/18/96
IF $GET(LRLWC)="SP"
WRITE !!,"** PLEASE BRING THIS WITH YOU TO THE LAB **",!
+31 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 ;
+7 ;----- BEGIN IHS/OIT/MKK - LR*5.2*1027 -- PRINT OUT 'SIGN OR SYMPTOM' LAB POV
+8 ;TEST POINTER
SET LRTPTR=$PIECE($GET(^LRO(69,LRODT,1,LRSN,2,T,0)),U)
+9 IF LRTPTR'=""
SET LRTNAME=$PIECE($GET(^LAB(60,LRTPTR,0)),U)
+10 ; W !,"Sign or Symptom for test "_$G(LRTNAME)_" : ",$G(^LRO(69,LRODT,1,LRSN,2,T,9999999)),!!
+11 ; IHS/MSC/MKK - LR*5.2*1033
WRITE !,"Clinical Indication for test "_$GET(LRTNAME)_" : ",$GET(^LRO(69,LRODT,1,LRSN,2,T,9999999)),!!
+12 KILL LRTPTR
+13 ;----- END IHS/OIT/MKK - LR*5.2*1027
+14 QUIT
