LRORD3 ;SLC/CJS/DALOI/FHS - MORE LAZY ACCESSION LOGGING ;2/6/91 13:01 [ 04/10/2003 9:46 AM ]
;;5.2T9;LR;**1010,1011,1013,1014,1015,1018**;Nov 17, 2004
;;5.2;LAB SERVICE;**153,263**;Sep 27, 1994
% R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
Q
GSS ;from LRMIBL, LRORD1
;----- BEGIN IHS MODIFICATIONS LR*5.2*1018 VARIOUS ADDITION OF VARIABLE BLRGUI FOR PATIENT CHART STUFF
W:'$G(BLRGUI) !,"For ",$P(^TMP("LRSTIK",$J,LRSSX),U,2)
GS ;from LRMIBL, LRORD, LRORD2
I '$G(BLRGUI),$D(LRLWC),LRLWC="LC",'$P(^LAB(60,LRTSTS,0),U,9) W !!?10," Sorry ** No Lab collect sample Defined for this test ",$C(7),! S (LRSAMP,LRSPEC)=-1 Q
S LRSAMP=-1,LRSPEC=-1 S:$D(LRSAME) LRSAMP=$P(LRSAME,U),LRSPEC=$P(LRSAME,U,2)
K %
I '$G(BLRGUI),$D(LRLWC),LRLWC="LC",$P(^LAB(60,LRTSTS,0),U,9) S X=$P(^LAB(62,$P(^(0),U,9),0),U) W !,?5,"The Lab Will collect ",X,!?5,"IS THIS THE CORRECT SAMPLE ? YES // " D % I %["N" W !!?15,$C(7),"LAB CAN ONLY COLLECT THIS TYPE SAMPLE "
;I $D(%),%["N" W !!,"For other samples use the WARD COLLECT OR SEND PATIENT options",! Q ;IHS/ITSC/TPF LR*5.2*1018 COMMENT LINE
I '$G(BLRGUI),$D(%),$D(LRLWC),LRLWC="LC",%'["N" S LRCSN=1,LRUNQ=$P(^LAB(60,LRTSTS,0),U,9),(Y,LRCS(1))=LRUNQ G G2
I $D(LRLWC),LRLWC="LC" Q
;S J=$O(^LAB(60,LRTSTS,3,0)) G GSNO:J<1 S LRCSN=1,LRUNQ=+$P(^LAB(60,LRTSTS,0),U,8),LRCS(1)=+^(3,J,0) S X=$P(^LAB(62,LRCS(1),0),U) W:'$D(LRSAME) !,$S(LRUNQ:"The Sample ",1:""),"Is ",X," ",$P(^(0),U,3) ;IHS/ITSC/TPF LR*5.2*1018 COMMENTED OUT FOR PATIENT CHART
;G G2:LRUNQ Q:$D(LRSAME) W " the correct sample to collect? Y//" D % G G2:%'["N" ;IHS/ITSC/TPF LR*5.2*1018 COMMENTED OUT FOR PATIENT CHART
S J=$O(^LAB(60,LRTSTS,3,0)) G GSNO:J<1 S LRCSN=1,LRUNQ=+$P(^LAB(60,LRTSTS,0),U,8),LRCS(1)=+^(3,J,0) S X=$P(^LAB(62,LRCS(1),0),U) I '$G(BLRGUI) W:'$D(LRSAME) !,$S(LRUNQ:"The Sample ",1:""),"Is ",X," ",$P(^(0),U,3)
G G2:LRUNQ!$G(BLRGUI) Q:$D(LRSAME) W " the correct sample to collect?Y//" D % G G2:%'["N" ;IHS/ITSC/TPF CHANGED FOR PATIENT CHART **1014*
F S J=$O(^LAB(60,LRTSTS,3,J)) Q:J<1 S LRCSN=LRCSN+1,LRCS(LRCSN)=+^(J,0)
G GSNO:LRCSN<2
I '$G(BLRGUI) W ! F I=1:1:LRCSN W !,I," ",$P(^LAB(62,LRCS(I),0),U)," ",$P(^(0),U,3)
I '$G(BLRGUI) R !,"Choose one: ",X:DTIME IF X>0&(X<(LRCSN+1)) S LRCSN=+X G G2
GSNO ;from LRORD1, LRWU1
Q:$D(LRSAME) S LRCSN=1,LRCS(1)=-1
I '$G(BLRGUI) S DIC="^LAB(62,",DIC(0)="AEMOQ" D ^DIC K DIC S LRCS(1)=+Y
G2 S LRSAMP=LRCS(LRCSN) I LRSAMP<1 S Y=-1,LROT="" G G3
I $P(^LAB(62,LRSAMP,0),U,2)'="" S LRSPEC=+$P(^(0),U,2) G G4
W18A S DIC="^LAB(61,",DIC(0)="EMOQ",D="E"
I '$G(BLRGUI) R !,"Select SITE/SPECIMEN: ",X:DTIME
D IX^DIC:X="?" G W18A:X="?" D ^DIC K DIC G W18A:'($D(DUOUT)!$D(DTOUT))&(Y<0) I $D(DTOUT)!$D(DUOUT) S LREND=1 Q
I LRUNKNOW=+Y,'$D(LRLABKY) Q:$G(BLRGUI) W !,"Unknown is not allowed." G W18A
G3 S LRSPEC=+Y
I +LRSAMP=-1&(LRSPEC=-1),$D(LROT) W:'$G(BLRGUI) !,"Sample and source incompletely defined, test skipped." Q
G4 Q:+LRSAMP=-1&(LRSPEC=-1)!$D(LRSAME)!$D(LRBLEND)
I $D(LRFLOG),$P(LRFLOG,U,3)="MI" Q
I '$D(LRLABKY) K % Q
I $D(LRLWC),LRLWC="LC" Q
I '$G(BLRGUI) W !,"Same specimen/source for the rest of the order" S %=2 D YN^DICN G G4:%=0 S:%=1 LRSAME=LRSAMP_U_LRSPEC
Q
LRORD3 ;SLC/CJS/DALOI/FHS - MORE LAZY ACCESSION LOGGING ;2/6/91 13:01 [ 04/10/2003 9:46 AM ]
+1 ;;5.2T9;LR;**1010,1011,1013,1014,1015,1018**;Nov 17, 2004
+2 ;;5.2;LAB SERVICE;**153,263**;Sep 27, 1994
% READ %:DTIME
IF %=""!(%["N")!(%["Y")
QUIT
WRITE !,"Answer 'Y' or 'N': "
GOTO %
+1 QUIT
GSS ;from LRMIBL, LRORD1
+1 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018 VARIOUS ADDITION OF VARIABLE BLRGUI FOR PATIENT CHART STUFF
+2 IF '$GET(BLRGUI)
WRITE !,"For ",$PIECE(^TMP("LRSTIK",$JOB,LRSSX),U,2)
GS ;from LRMIBL, LRORD, LRORD2
+1 IF '$GET(BLRGUI)
IF $DATA(LRLWC)
IF LRLWC="LC"
IF '$PIECE(^LAB(60,LRTSTS,0),U,9)
WRITE !!?10," Sorry ** No Lab collect sample Defined for this test ",$CHAR(7),!
SET (LRSAMP,LRSPEC)=-1
QUIT
+2 SET LRSAMP=-1
SET LRSPEC=-1
IF $DATA(LRSAME)
SET LRSAMP=$PIECE(LRSAME,U)
SET LRSPEC=$PIECE(LRSAME,U,2)
+3 KILL %
+4 IF '$GET(BLRGUI)
IF $DATA(LRLWC)
IF LRLWC="LC"
IF $PIECE(^LAB(60,LRTSTS,0),U,9)
SET X=$PIECE(^LAB(62,$PIECE(^(0),U,9),0),U)
WRITE !,?5,"The Lab Will collect ",X,!?5,"IS THIS THE CORRECT SAMPLE ? YES // "
DO %
IF %["N"
WRITE !!?15,$CHAR(7),"LAB CAN ONLY COLLECT THIS TYPE SAMPLE "
+5 ;I $D(%),%["N" W !!,"For other samples use the WARD COLLECT OR SEND PATIENT options",! Q ;IHS/ITSC/TPF LR*5.2*1018 COMMENT LINE
+6 IF '$GET(BLRGUI)
IF $DATA(%)
IF $DATA(LRLWC)
IF LRLWC="LC"
IF %'["N"
SET LRCSN=1
SET LRUNQ=$PIECE(^LAB(60,LRTSTS,0),U,9)
SET (Y,LRCS(1))=LRUNQ
GOTO G2
+7 IF $DATA(LRLWC)
IF LRLWC="LC"
QUIT
+8 ;S J=$O(^LAB(60,LRTSTS,3,0)) G GSNO:J<1 S LRCSN=1,LRUNQ=+$P(^LAB(60,LRTSTS,0),U,8),LRCS(1)=+^(3,J,0) S X=$P(^LAB(62,LRCS(1),0),U) W:'$D(LRSAME) !,$S(LRUNQ:"The Sample ",1:""),"Is ",X," ",$P(^(0),U,3) ;IHS/ITSC/TPF LR*5.2*1018 COMMENTED OUT FO
R PATIENT CHART
+9 ;G G2:LRUNQ Q:$D(LRSAME) W " the correct sample to collect? Y//" D % G G2:%'["N" ;IHS/ITSC/TPF LR*5.2*1018 COMMENTED OUT FOR PATIENT CHART
+10 SET J=$ORDER(^LAB(60,LRTSTS,3,0))
IF J<1
GOTO GSNO
SET LRCSN=1
SET LRUNQ=+$PIECE(^LAB(60,LRTSTS,0),U,8)
SET LRCS(1)=+^(3,J,0)
SET X=$PIECE(^LAB(62,LRCS(1),0),U)
IF '$GET(BLRGUI)
IF '$DATA(LRSAME)
WRITE !,$SELECT(LRUNQ:"The Sample ",1:""),"Is ",X," ",$PIECE(^(0),U,3)
+11 ;IHS/ITSC/TPF CHANGED FOR PATIENT CHART **1014*
IF LRUNQ!$GET(BLRGUI)
GOTO G2
IF $DATA(LRSAME)
QUIT
WRITE " the correct sample to collect?Y//"
DO %
IF %'["N"
GOTO G2
+12 FOR
SET J=$ORDER(^LAB(60,LRTSTS,3,J))
IF J<1
QUIT
SET LRCSN=LRCSN+1
SET LRCS(LRCSN)=+^(J,0)
+13 IF LRCSN<2
GOTO GSNO
+14 IF '$GET(BLRGUI)
WRITE !
FOR I=1:1:LRCSN
WRITE !,I," ",$PIECE(^LAB(62,LRCS(I),0),U)," ",$PIECE(^(0),U,3)
+15 IF '$GET(BLRGUI)
READ !,"Choose one: ",X:DTIME
IF X>0&(X<(LRCSN+1))
SET LRCSN=+X
GOTO G2
GSNO ;from LRORD1, LRWU1
+1 IF $DATA(LRSAME)
QUIT
SET LRCSN=1
SET LRCS(1)=-1
+2 IF '$GET(BLRGUI)
SET DIC="^LAB(62,"
SET DIC(0)="AEMOQ"
DO ^DIC
KILL DIC
SET LRCS(1)=+Y
G2 SET LRSAMP=LRCS(LRCSN)
IF LRSAMP<1
SET Y=-1
SET LROT=""
GOTO G3
+1 IF $PIECE(^LAB(62,LRSAMP,0),U,2)'=""
SET LRSPEC=+$PIECE(^(0),U,2)
GOTO G4
W18A SET DIC="^LAB(61,"
SET DIC(0)="EMOQ"
SET D="E"
+1 IF '$GET(BLRGUI)
READ !,"Select SITE/SPECIMEN: ",X:DTIME
+2 IF X="?"
DO IX^DIC
IF X="?"
GOTO W18A
DO ^DIC
KILL DIC
IF '($DATA(DUOUT)!$DATA(DTOUT))&(Y<0)
GOTO W18A
IF $DATA(DTOUT)!$DATA(DUOUT)
SET LREND=1
QUIT
+3 IF LRUNKNOW=+Y
IF '$DATA(LRLABKY)
IF $GET(BLRGUI)
QUIT
WRITE !,"Unknown is not allowed."
GOTO W18A
G3 SET LRSPEC=+Y
+1 IF +LRSAMP=-1&(LRSPEC=-1)
IF $DATA(LROT)
IF '$GET(BLRGUI)
WRITE !,"Sample and source incompletely defined, test skipped."
QUIT
G4 IF +LRSAMP=-1&(LRSPEC=-1)!$DATA(LRSAME)!$DATA(LRBLEND)
QUIT
+1 IF $DATA(LRFLOG)
IF $PIECE(LRFLOG,U,3)="MI"
QUIT
+2 IF '$DATA(LRLABKY)
KILL %
QUIT
+3 IF $DATA(LRLWC)
IF LRLWC="LC"
QUIT
+4 IF '$GET(BLRGUI)
WRITE !,"Same specimen/source for the rest of the order"
SET %=2
DO YN^DICN
IF %=0
GOTO G4
IF %=1
SET LRSAME=LRSAMP_U_LRSPEC
+5 QUIT
