| 1 | LRORD1 ;DALOI/CJS/JAH - LAZY ACCESSION LOGGING ;8/10/04
|
|---|
| 2 | ;;5.2;LAB SERVICE;**1,8,121,153,201,286,291**;Sep 27, 1994
|
|---|
| 3 | L2 Q:$G(LREND)
|
|---|
| 4 | N LRBEQT,LRBEVT,LRBETS,LRBEX,LRBEY,LRBEZ,LRBETYP ; CIDC
|
|---|
| 5 | K LROT,LRSAME,LRKIL,LRGCOM,LRCCOM,LR696IEN,LRNATURE
|
|---|
| 6 | S LRWPC=LRWP G:$D(LROR) LRFIRST
|
|---|
| 7 | I '$D(LRADDTST) K DFN,DIC S PNM="",DIC(0)="EMQ"_$S($P(LRPARAM,U,6)&$D(LRLABKY):"L",1:"") W ! D ^LRDPA I (LRDFN=-1)!$D(DUOUT)!$D(DTOUT) Q
|
|---|
| 8 | I $D(LRADDTST),LRADDTST="" Q
|
|---|
| 9 | S:'$D(LREND) LREND=0 I LRORDR="" D COLTY^LRWU G DROP:LREND
|
|---|
| 10 | S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
|
|---|
| 11 | Q12 D LOC^LRWU G DROP:LREND
|
|---|
| 12 | Q11 D PRAC^LRWU1 G DROP:LREND
|
|---|
| 13 | K T,TT,LRDMAX,LRDTST,LRTMAX
|
|---|
| 14 | S DA=0
|
|---|
| 15 | F S DA=$O(^LRO(69,LRODT,1,"AA",LRDFN,DA)) Q:DA<1 I $S($D(^LRO(69,LRODT,1,DA,1)):$P(^(1),U,4)'="U",1:1) S S=$S($D(^LRO(69,LRODT,1,DA,4,1,0)):+^(0),1:0) D
|
|---|
| 16 | . S I=0 F S I=$O(^LRO(69,LRODT,1,DA,2,I)) Q:I<1 I $D(^(I,0)) S T(+^(0),DA)=S,X=+^(0) S:'$D(TT(X,S)) TT(X,S)=0 S TT(X,S)=TT(X,S)+1
|
|---|
| 17 | K DIC
|
|---|
| 18 | I $D(LRADDTST) S LRORD=+LRADDTST,LRADDTST="" G LRFIRST
|
|---|
| 19 | D ORDER^LROW2
|
|---|
| 20 | I $D(LRFLOG),$P(LRFLOG,U,3)="MI",$G(LRORDRR)'="R" K DUOUT D MICRO G L2:$D(DUOUT)!$D(DTOUT)
|
|---|
| 21 | ;
|
|---|
| 22 | LRFIRST S LRSX=1 G Q13:'LRFIRST!(LRWP<2)
|
|---|
| 23 | W !,"Choose one (or more, separated by commas) ('*' AFTER NUMBER TO CHANGE URGENCY) "
|
|---|
| 24 | F I=1:1:LRWPD D
|
|---|
| 25 | . N X
|
|---|
| 26 | . S X=^TMP("LRSTIK",$J,"B",I)
|
|---|
| 27 | . W !,X,?4,$P(^TMP("LRSTIK",$J,X),U,2)
|
|---|
| 28 | . S X=$G(^TMP("LRSTIK",$J,"B",I+LRWPD))
|
|---|
| 29 | . I X W ?39," ",X,?44,$P(^TMP("LRSTIK",$J,X),U,2)
|
|---|
| 30 | Q13 S LREDO=0
|
|---|
| 31 | LEDI ;
|
|---|
| 32 | ;
|
|---|
| 33 | ; If LEDI accessioning then check for pending orders in file #69.6
|
|---|
| 34 | I $G(LRRSTAT)="I",$G(LRRSITE("SMID"))'="",$G(LRSD("RUID"))'="" D I $O(LROT(0)) G BAR
|
|---|
| 35 | . D EN^LRORDB(LRSD("RUID"),LRRSITE("SMID"))
|
|---|
| 36 | G:LRWP'>1 Q13A
|
|---|
| 37 | W ! W:'LRFIRST "'?' for list, " S LRFIRST=0
|
|---|
| 38 | R "TEST number(s): ",LRSX:DTIME S:LRSX["?" LRFIRST=1 G LRFIRST:LRFIRST
|
|---|
| 39 | I LRSX=""!(LRSX["^") G BAR
|
|---|
| 40 | F I=1:1:$L(LRSX,",") D Q:LREDO
|
|---|
| 41 | . S LRSSX=$P(LRSX,",",I)
|
|---|
| 42 | . I LRSSX'?1.3N.1"*" S LREDO=1 Q
|
|---|
| 43 | . S LRSSX=$P(LRSSX,"*")
|
|---|
| 44 | . I '$D(^TMP("LRSTIK",$J,LRSSX)) S LREDO=1
|
|---|
| 45 | Q13A I LREDO W !,"Something was mistyped, try again." G Q13
|
|---|
| 46 | F LRK=1:1 S LRSSX=$P(LRSX,",",LRK) Q:LRSSX="" D
|
|---|
| 47 | . N X
|
|---|
| 48 | . S LRST=$S(LRSSX["*":1,1:0),LRSSX=+LRSSX
|
|---|
| 49 | . S X=^TMP("LRSTIK",$J,LRSSX)
|
|---|
| 50 | . S LRSAMP=$P(X,U,3),LRSPEC=$P(X,U,5),LRTSTS=+X
|
|---|
| 51 | . D Q20^LRORDD
|
|---|
| 52 | BAR S LRM=LRWPC+1,K=0 W !,"Other tests? N//" D % G Q14:'(%["Y")
|
|---|
| 53 | LRM D MORE^LRORD2
|
|---|
| 54 | Q14 D:$P(LRPARAM,U,17) ^LRORDD D ^LRORD2A D ENSTIK^LROW3 G LRM:'$D(%)&($D(LROT)'=11),DROP:$O(LROT(-1))="",LRM:'$D(%),DROP:%[U K DIC G DROP:'$D(LROT)!(%["N")
|
|---|
| 55 | S LRBEY=1 I +LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT)) D G DROP:'LRBEY
|
|---|
| 56 | .D BALROR^LRBEBA3(.LRORD) ; CIDC
|
|---|
| 57 | I ($D(LRBEY)<1)!$D(DUOUT)!$D(DTOUT) Q
|
|---|
| 58 | W !!,"LAB Order number: ",LRORD,!!
|
|---|
| 59 | I LRECT D G DROP:LRCDT<1
|
|---|
| 60 | . I $G(LRORDRR)="R",$G(LRSD("CDT")) D Q
|
|---|
| 61 | . . S LRCDT=LRSD("CDT")_"^"
|
|---|
| 62 | . . S LRORDTIM=$P(LRSD("CDT"),".",2)
|
|---|
| 63 | . . I 'LRORDTIM S $P(LRCDT,"^",2)=1
|
|---|
| 64 | . D TIME^LROE
|
|---|
| 65 | . I $G(LRCDT)<1 Q
|
|---|
| 66 | . S LRORDTIM=$P($P(LRCDT,U),".",2)
|
|---|
| 67 | D NOW^%DTC S LRNT=% S:'LRECT LRCDT=LRNT_"^1"
|
|---|
| 68 | S LRIDT=9999999-LRCDT
|
|---|
| 69 | D ^LRORDST Q:$D(LROR)
|
|---|
| 70 | I $D(LRFASTS) D LRWU4^LRFASTS
|
|---|
| 71 | Q:$G(LRKIK) G L2
|
|---|
| 72 | % R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
|
|---|
| 73 | ;
|
|---|
| 74 | Q20A ;from LRORD2
|
|---|
| 75 | MAX ; CHECK FOR MAXIUM ORDER FREQUENCY
|
|---|
| 76 | I $D(TT(LRTSTS,LRSPEC)),$D(^LAB(60,LRTSTS,3,"B",LRCS(LRCSN))) D EN2^LRORDD I %'["Y" Q
|
|---|
| 77 | S I7=0 F I9=0:0 S I9=$O(T(LRTSTS,I9)) Q:I9="" I $D(^LAB(60,LRTSTS,3,+$O(^LAB(60,LRTSTS,3,"B",LRSAMP,0)),0)),+$P(^(0),U,5),LRSPEC=T(LRTSTS,I9) S I7=1
|
|---|
| 78 | I I7 W $C(7),!!,"You have a duplicate: " S LRSN=0 F S LRSN=$O(T(LRTSTS,LRSN)) Q:LRSN<1 W " for ",$P(^LAB(60,LRTSTS,0),U) S LRZT=LRTSTS D ORDER^LROS S LRTSTS=LRZT
|
|---|
| 79 | I I7 W !,"You already have that test, do you really want another? N//" D %
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | URGG W !,"For ",$P(^TMP("LRSTIK",$J,LRSSX),U,2)
|
|---|
| 83 | D URG^LRORD2
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | ;
|
|---|
| 87 | DROP W !!,"ORDER CANCELED",$C(7),!! Q:$D(LROR) G L2 ; !($G(LREND)) G L2
|
|---|
| 88 | ;
|
|---|
| 89 | ;
|
|---|
| 90 | MICRO W !,"Is there one sample for this patient's order"
|
|---|
| 91 | S %=1 D YN^DICN
|
|---|
| 92 | I %=2!(%=-1) S:%=-1 DUOUT=1 Q
|
|---|
| 93 | I %=0 W !,"The collection sample and site/specimen will be used for all tests ordered",!,"at this time for this patient." G MICRO
|
|---|
| 94 | D GSNO^LRORD3 Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 95 | I +LRSAMP=-1&(LRSPEC=-1) W !,"Incompletely defined." G MICRO
|
|---|
| 96 | S LRSAME=LRSAMP_U_LRSPEC
|
|---|
| 97 | S LRECOM=0 D GCOM^LRORD2
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
| 100 | ;
|
|---|
| 101 | PRAC ;from LRFAST
|
|---|
| 102 | S X=$S(+DIC("B"):$P(^VA(200,+DIC("B"),0),U),1:"")
|
|---|
| 103 | W !,"PRACTITIONER: ",X,$S($L(X):"//",1:"")
|
|---|
| 104 | R X:DTIME
|
|---|
| 105 | I DIC("B"),X="" S Y=DIC("B") Q
|
|---|
| 106 | D ^DIC K DIC
|
|---|
| 107 | Q
|
|---|
