- LRORD3 ;SLC/CJS/DALOI/FHS - MORE LAZY ACCESSION LOGGING ;2/6/91 13:01
- ;;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
- W !,"For ",$P(^TMP("LRSTIK",$J,LRSSX),U,2)
- GS ;from LRMIBL, LRORD, LRORD2
- 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
- S LRSAMP=-1,LRSPEC=-1 S:$D(LRSAME) LRSAMP=$P(LRSAME,U),LRSPEC=$P(LRSAME,U,2)
- K %
- 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 "
- I $D(%),%["N" W !!,"For other samples use the WARD COLLECT OR SEND PATIENT options",! Q
- I $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)
- G G2:LRUNQ Q:$D(LRSAME) W " the correct sample to collect? Y//" D % G G2:%'["N"
- F S J=$O(^LAB(60,LRTSTS,3,J)) Q:J<1 S LRCSN=LRCSN+1,LRCS(LRCSN)=+^(J,0)
- G GSNO:LRCSN<2
- W ! F I=1:1:LRCSN W !,I," ",$P(^LAB(62,LRCS(I),0),U)," ",$P(^(0),U,3)
- 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,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" 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) W !,"Unknown is not allowed." G W18A
- G3 S LRSPEC=+Y
- I +LRSAMP=-1&(LRSPEC=-1),$D(LROT) W !,"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
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRORD3 2353 printed Jan 18, 2025@03:19:35 Page 2
- LRORD3 ;SLC/CJS/DALOI/FHS - MORE LAZY ACCESSION LOGGING ;2/6/91 13:01
- +1 ;;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 WRITE !,"For ",$PIECE(^TMP("LRSTIK",$JOB,LRSSX),U,2)
- GS ;from LRMIBL, LRORD, LRORD2
- +1 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 $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 IF $DATA(%)
- IF %["N"
- WRITE !!,"For other samples use the WARD COLLECT OR SEND PATIENT options",!
- QUIT
- +6 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 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 '$DATA(LRSAME)
- WRITE !,$SELECT(LRUNQ:"The Sample ",1:""),"Is ",X," ",$PIECE(^(0),U,3)
- +9 if LRUNQ
- GOTO G2
- if $DATA(LRSAME)
- QUIT
- WRITE " the correct sample to collect? Y//"
- DO %
- if %'["N"
- GOTO G2
- +10 FOR
- SET J=$ORDER(^LAB(60,LRTSTS,3,J))
- if J<1
- QUIT
- SET LRCSN=LRCSN+1
- SET LRCS(LRCSN)=+^(J,0)
- +11 if LRCSN<2
- GOTO GSNO
- +12 WRITE !
- FOR I=1:1:LRCSN
- WRITE !,I," ",$PIECE(^LAB(62,LRCS(I),0),U)," ",$PIECE(^(0),U,3)
- +13 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
- 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"
- READ !,"Select SITE/SPECIMEN: ",X:DTIME
- +1 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
- +2 IF LRUNKNOW=+Y
- IF '$DATA(LRLABKY)
- WRITE !,"Unknown is not allowed."
- GOTO W18A
- G3 SET LRSPEC=+Y
- +1 IF +LRSAMP=-1&(LRSPEC=-1)
- IF $DATA(LROT)
- 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 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