| 1 | LRORD3 ;SLC/CJS/DALOI/FHS - MORE LAZY ACCESSION LOGGING ;2/6/91 13:01
|
|---|
| 2 | ;;5.2;LAB SERVICE;**153,263**;Sep 27, 1994
|
|---|
| 3 | % R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
|
|---|
| 4 | Q
|
|---|
| 5 | GSS ;from LRMIBL, LRORD1
|
|---|
| 6 | W !,"For ",$P(^TMP("LRSTIK",$J,LRSSX),U,2)
|
|---|
| 7 | GS ;from LRMIBL, LRORD, LRORD2
|
|---|
| 8 | I $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
|
|---|
| 9 | S LRSAMP=-1,LRSPEC=-1 S:$D(LRSAME) LRSAMP=$P(LRSAME,U),LRSPEC=$P(LRSAME,U,2)
|
|---|
| 10 | K %
|
|---|
| 11 | I $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 "
|
|---|
| 12 | I $D(%),%["N" W !!,"For other samples use the WARD COLLECT OR SEND PATIENT options",! Q
|
|---|
| 13 | I $D(%),$D(LRLWC),LRLWC="LC",%'["N" S LRCSN=1,LRUNQ=$P(^LAB(60,LRTSTS,0),U,9),(Y,LRCS(1))=LRUNQ G G2
|
|---|
| 14 | I $D(LRLWC),LRLWC="LC" Q
|
|---|
| 15 | 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)
|
|---|
| 16 | G G2:LRUNQ Q:$D(LRSAME) W " the correct sample to collect? Y//" D % G G2:%'["N"
|
|---|
| 17 | F S J=$O(^LAB(60,LRTSTS,3,J)) Q:J<1 S LRCSN=LRCSN+1,LRCS(LRCSN)=+^(J,0)
|
|---|
| 18 | G GSNO:LRCSN<2
|
|---|
| 19 | W ! F I=1:1:LRCSN W !,I," ",$P(^LAB(62,LRCS(I),0),U)," ",$P(^(0),U,3)
|
|---|
| 20 | R !,"Choose one: ",X:DTIME IF X>0&(X<(LRCSN+1)) S LRCSN=+X G G2
|
|---|
| 21 | GSNO ;from LRORD1, LRWU1
|
|---|
| 22 | Q:$D(LRSAME) S LRCSN=1,LRCS(1)=-1,DIC="^LAB(62,",DIC(0)="AEMOQ" D ^DIC K DIC S LRCS(1)=+Y
|
|---|
| 23 | G2 S LRSAMP=LRCS(LRCSN) I LRSAMP<1 S Y=-1,LROT="" G G3
|
|---|
| 24 | I $P(^LAB(62,LRSAMP,0),U,2)'="" S LRSPEC=+$P(^(0),U,2) G G4
|
|---|
| 25 | W18A S DIC="^LAB(61,",DIC(0)="EMOQ",D="E" R !,"Select SITE/SPECIMEN: ",X:DTIME
|
|---|
| 26 | 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
|
|---|
| 27 | I LRUNKNOW=+Y,'$D(LRLABKY) W !,"Unknown is not allowed." G W18A
|
|---|
| 28 | G3 S LRSPEC=+Y
|
|---|
| 29 | I +LRSAMP=-1&(LRSPEC=-1),$D(LROT) W !,"Sample and source incompletely defined, test skipped." Q
|
|---|
| 30 | G4 Q:+LRSAMP=-1&(LRSPEC=-1)!$D(LRSAME)!$D(LRBLEND)
|
|---|
| 31 | I $D(LRFLOG),$P(LRFLOG,U,3)="MI" Q
|
|---|
| 32 | I '$D(LRLABKY) K % Q
|
|---|
| 33 | I $D(LRLWC),LRLWC="LC" Q
|
|---|
| 34 | W !,"Same specimen/source for the rest of the order" S %=2 D YN^DICN G G4:%=0 S:%=1 LRSAME=LRSAMP_U_LRSPEC
|
|---|
| 35 | Q
|
|---|
