Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRORD1

LRORD1.m

Go to the documentation of this file. 
  1. LRORD1 ;DALOI/CJS/JAH - LAZY ACCESSION LOGGING ;8/10/04
  1.  ;;5.2;LAB SERVICE;**1003,1004,1006,1009,1010,1011,1013,1014,1015,1021,1027,1030,1031**;NOV 01, 1997
  1.  ;
  1.  ;;VA LR Patch(s): 1,8,121,153,201,286,291
  1.  ;
  1. L2 ; EP
  1.  Q:$G(LREND)
  1.  N LRBEQT,LRBEVT,LRBETS,LRBEX,LRBEY,LRBEZ,LRBETYP    ; CIDC
  1.  K LROT,LRSAME,LRKIL,LRGCOM,LRCCOM,LR696IEN,LRNATURE
  1.  S LRWPC=LRWP G:$D(LROR) LRFIRST
  1.  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
  1.  I $D(LRADDTST),LRADDTST="" Q
  1.  S:'$D(LREND) LREND=0 I LRORDR="" D COLTY^LRWU G DROP:LREND
  1.  S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
  1. Q12 ; EP
  1.  D LOC^LRWU G DROP:LREND
  1. Q11 ; EP
  1.  D PRAC^LRWU1 G DROP:LREND
  1.  K T,TT,LRDMAX,LRDTST,LRTMAX
  1.  S DA=0
  1.  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
  1.  . 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
  1.  K DIC
  1.  I $D(LRADDTST) S LRORD=+LRADDTST,LRADDTST="" G LRFIRST
  1.  D ORDER^LROW2
  1.  I $D(LRFLOG),$P(LRFLOG,U,3)="MI",$G(LRORDRR)'="R" K DUOUT D MICRO G L2:$D(DUOUT)!$D(DTOUT)
  1.  ;
  1. LRFIRST ; EP
  1.  S LRSX=1 G Q13:'LRFIRST!(LRWP<2)
  1.  W !,"Choose one (or more, separated by commas)  ('*' AFTER NUMBER TO CHANGE URGENCY) "
  1.  F I=1:1:LRWPD D
  1.  . N X
  1.  . S X=^TMP("LRSTIK",$J,"B",I)
  1.  . W !,X,?4,$P(^TMP("LRSTIK",$J,X),U,2)
  1.  . S X=$G(^TMP("LRSTIK",$J,"B",I+LRWPD))
  1.  . I X W ?39," ",X,?44,$P(^TMP("LRSTIK",$J,X),U,2)
  1. Q13 S LREDO=0
  1. LEDI ; EP
  1.  ;
  1.  ; If LEDI accessioning then check for pending orders in file #69.6
  1.  I $G(LRRSTAT)="I",$G(LRRSITE("SMID"))'="",$G(LRSD("RUID"))'="" D  I $O(LROT(0)) G BAR
  1.  . D EN^LRORDB(LRSD("RUID"),LRRSITE("SMID"))
  1.  G:LRWP'>1 Q13A
  1.  W ! W:'LRFIRST "'?' for list,  " S LRFIRST=0
  1.  R "TEST number(s): ",LRSX:DTIME S:LRSX["?" LRFIRST=1 G LRFIRST:LRFIRST
  1.  I LRSX=""!(LRSX["^") G BAR
  1.  F I=1:1:$L(LRSX,",") D  Q:LREDO
  1.  . S LRSSX=$P(LRSX,",",I)
  1.  . I LRSSX'?1.3N.1"*" S LREDO=1 Q
  1.  . S LRSSX=$P(LRSSX,"*")
  1.  . I '$D(^TMP("LRSTIK",$J,LRSSX)) S LREDO=1
  1. Q13A I LREDO W !,"Something was mistyped, try again." G Q13
  1.  ;
  1.  F LRK=1:1 S LRSSX=$P(LRSX,",",LRK) Q:LRSSX=""  D
  1.  . N X
  1.  . S LRST=$S(LRSSX["*":1,1:0),LRSSX=+LRSSX
  1.  . S X=^TMP("LRSTIK",$J,LRSSX)
  1.  . S LRSAMP=$P(X,U,3),LRSPEC=$P(X,U,5),LRTSTS=+X
  1.  . D Q20^LRORDD
  1.  ;
  1. BAR S LRM=LRWPC+1,K=0 W !,"Other tests? N//" D % G Q14:'(%["Y")
  1.  ;
  1. LRM D MORE^LRORD2
  1.  ;
  1. 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")
  1.  ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
  1.  D Q14A
  1.  D ENSTIK^LROW3                   ; IHS/MSC/MKK - LR*5.2*1031
  1.  G LRM:'$D(%)&($D(LROT)'=11),DROP:$O(LROT(-1))="",LRM:'$D(%),DROP:%[U
  1.  K DIC
  1.  G DROP:'$D(LROT)!(%["N")
  1.  ; ----- END IHS/OIT/MKK - LR*5.2*1030
  1.  ;
  1.  ;
  1.  S LRBEY=1 I +LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT)) D  G DROP:'LRBEY
  1.  .D BALROR^LRBEBA3(.LRORD)  ; CIDC
  1.  I ($D(LRBEY)<1)!$D(DUOUT)!$D(DTOUT) Q
  1.  ;
  1.  W !!,"LAB Order number: ",LRORD,!!
  1.  I LRECT D  G DROP:LRCDT<1
  1.  . I $G(LRORDRR)="R",$G(LRSD("CDT")) D  Q
  1.  . . S LRCDT=LRSD("CDT")_"^"
  1.  . . S LRORDTIM=$P(LRSD("CDT"),".",2)
  1.  . . I 'LRORDTIM S $P(LRCDT,"^",2)=1
  1.  . D TIME^LROE
  1.  . I $G(LRCDT)<1 Q
  1.  . S LRORDTIM=$P($P(LRCDT,U),".",2)
  1.  D NOW^%DTC S LRNT=% S:'LRECT LRCDT=LRNT_"^1"
  1.  S LRIDT=9999999-LRCDT
  1.  D ^LRORDST Q:$D(LROR)
  1.  ;
  1.  D ASKATORD^BLRAAORU(LRORD)           ; IHS/OIT/MKK - LR*5.2*1030
  1.  ;
  1.  I $D(LRFASTS) D LRWU4^LRFASTS
  1.  ;
  1.  ; --- BEGIN IHS MODIFICATION cmi/anch/maw REF LAB -- LR*5.2*1021
  1.  I '$G(BLRGUI),$G(^BLRSITE(DUZ(2),"RL")),'$P($G(^BLRSITE(DUZ(2),"RL")),U,22) D BLRRL^LROE  ;cmi/flag/maw 7/28/03 for reference lab shipping manifest 6/22/10 added check of LEDI
  1.  ;--- END IHS MODIFICATION cmi/anch/maw end REF LAB -- LR*5.2*1021
  1.  ;
  1.  Q:$G(LRKIK)  G L2
  1.  ;
  1. % R %:DTIME Q:%=""!(%["N")!(%["Y")  W !,"Answer 'Y' or 'N': " G %
  1.  ;
  1.  ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
  1.  ; Being done because the % variable is being reset somewhere
  1. Q14A ; EP
  1.  NEW %ORIGQ14
  1.  S %ORIGQ14=$G(%)    ; Save off original % variable
  1.  ;
  1.  NEW %
  1.  S %=$G(%ORIGQ14)    ; Done in case the other routines need the % variable to be set
  1.  D:$P(LRPARAM,U,17) ^LRORDD
  1.  D ^LRORD2A
  1.  ; D ENSTIK^LROW3                 ; IHS/MSC/MKK - LR*5.2*1031 -- Don't call ENSTIK^LROW3 here
  1.  ;
  1.  Q
  1.  ; ----- END IHS/OIT/MKK - LR*5.2*1030
  1.  ;
  1. Q20A ;from LRORD2
  1. MAX ; CHECK FOR MAXIUM ORDER FREQUENCY
  1.  I $D(TT(LRTSTS,LRSPEC)),$D(^LAB(60,LRTSTS,3,"B",LRCS(LRCSN))) D EN2^LRORDD I %'["Y" Q
  1.  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
  1.  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
  1.  I I7 W !,"You already have that test, do you really want another? N//" D %
  1.  Q
  1.  ;
  1. URGG ; W !,"For ",$P(^TMP("LRSTIK",$J,LRSSX),U,2)
  1.  W:'$G(BLRGUI) !,"For ",$P(^TMP("LRSTIK",$J,LRSSX),U,2)    ; IHS/OIT/MKK - LR*5.2*1027
  1.  D URG^LRORD2
  1.  Q
  1.  ;
  1.  ;
  1. DROP W !!,"ORDER CANCELED",$C(7),!! Q:$D(LROR)  G L2 ; !($G(LREND))  G L2
  1.  ;
  1.  ;
  1. MICRO ; EP
  1.  W !,"Is there one sample for this patient's order"
  1.  S %=1 D YN^DICN
  1.  I %=2!(%=-1) S:%=-1 DUOUT=1 Q
  1.  I %=0 W !,"The collection sample and site/specimen will be used for all tests ordered",!,"at this time for this patient." G MICRO
  1.  D GSNO^LRORD3 Q:$D(DUOUT)!$D(DTOUT)
  1.  I +LRSAMP=-1&(LRSPEC=-1) W !,"Incompletely defined." G MICRO
  1.  S LRSAME=LRSAMP_U_LRSPEC
  1.  S LRECOM=0 D GCOM^LRORD2
  1.  Q
  1.  ;
  1.  ;
  1. PRAC ;from LRFAST
  1.  S X=$S(+DIC("B"):$P(^VA(200,+DIC("B"),0),U),1:"")
  1.  W !,"PRACTITIONER: ",X,$S($L(X):"//",1:"")
  1.  R X:DTIME
  1.  I DIC("B"),X="" S Y=DIC("B") Q
  1.  D ^DIC K DIC
  1.  Q