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

LRFASTS.m

Go to the documentation of this file. 
  1. LRFASTS ;VA/DALOI/FHS - ENHANCED LRFAST RTN ACCESSION/VERIFY PROCESS ;JUL 06, 2010 3:14 PM
  1.  ;;5.2;LAB SERVICE;**30,95,121,271,286,1027**;NOV 01, 1997
  1. EN ;
  1.  N DIC,DIR,DIRUT,DTOUT,DUOUT,LRPER,X,Y
  1.  D ^LRPARAM
  1.  S LRFASTS=""
  1.  I '$D(LRLABKY) W !!?10,"Not authorized to use this option " Q
  1.  S LRCW=8,LREND=0,LRPANEL=0
  1.  S DIR(0)="YO",DIR("A")="Do you want to review the data before and after you edit",DIR("B")="YES"
  1.  D ^DIR
  1.  I $D(DIRUT) D QUIT Q
  1.  I Y=0 S LRPER=""
  1.  S X=$$SELPL^LRVERA(DUZ(2))
  1.  I X<1 D QUIT Q
  1.  I X'=DUZ(2) N LRPL S LRPL=X
  1.  ;
  1.  K LRCDEF0,LRCDEF
  1.  D ^LRORD
  1.  ;
  1. QUIT ;
  1.  I $D(LRCSQ),'$O(^TMP("LRCAP",LRCSQ,DUZ,0)) K ^TMP("LRCAP",LRCSQ,DUZ),LRCSQ
  1.  I $D(LRCSQ),$P(LRPARAM,U,14) D STD^LRCAPV K LRIDIV
  1.  ;
  1.  K I10             ; IHS/OIRM TUC/AAB 11/06/96 -- IHS/OIT/MKK -- LR*5.2*1027 -- Restored line
  1.  K I12,LRCDEF,LRCDEF0,LRCDEF0X,LRCSQ,LRCW,LRFASTS,LRNTN,LRNX,LRPANEL,LRSSCX,LRDUF0,LRTEC,LRVF,LRXDP,X9,%,L1,LRAD,LREND,LRSN,QUOUT
  1.  K LRAL,LRALL,LRCAPMS,LRMA,SEX,S2,T1,AGE,N,D0,D1,DOB,I,LRFASTS,LRSLOW,DIR,X3,LRORDXS,LRADXS,LRSNXS,LRWP,LRWPC
  1.  K LRALERT,LRCSQQ,LRT,LRNOW,LRODTSV,LRSNSV,LRSUF0,LRTSNV,NOW,LRI,LRTNSV
  1.  ; ORVP,ORIFN Killed for OE/RR 2.5
  1.  K ORVP,ORIFN
  1.  ;
  1.  D SLOWK,^%ZISC
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. LRWU4 ;
  1.  N L,LRI,LRADXS,LRSNXS
  1.  Q:'$G(LRORD)
  1.  S LRORDXS=LRORD,LRADXS=0
  1.  F  S LRADXS=$O(^LRO(69,"C",LRORDXS,LRADXS)) Q:LRADXS<1  D
  1.  . S LRSNXS=0
  1.  . F  S LRSNXS=$O(^LRO(69,"C",LRORDXS,LRADXS,LRSNXS)) Q:LRSNXS<1  D
  1.  . . K LRSLOW
  1.  . . S LRSN=+LRSNXS,LRAD=+LRADXS,LRORD=+LRORDXS
  1.  . . Q:'LRSN!('LRAD)!('$O(^LRO(69,LRAD,1,LRSN,2,0)))
  1.  . . S LRI=0
  1.  . . F  S LRI=$O(^LRO(69,LRAD,1,LRSN,2,LRI)) Q:LRI<1  D
  1.  . . . S L=$G(^LRO(69,LRAD,1,LRSN,2,LRI,0))
  1.  . . . I $P(L,U,3),$P(L,U,4),$P(L,U,5) S LRSLOW($P(L,U,3,5))=""
  1.  . . S LRI=""
  1.  . . F  S LRI=$O(LRSLOW(LRI)) Q:LRI=""  D GO
  1.  ;
  1.  D SLOWK
  1.  Q
  1.  ;
  1.  ;
  1. GO ;
  1.  ; Protect variables
  1.  N LRAA,LRAD,LRAN,LRADXS,LRSNXS
  1.  S LRAD=$P(LRI,U,1),LRAA=$P(LRI,U,2),LRAN=$P(LRI,U,3)
  1.  ;
  1.  ; Protect subscript variable
  1.  N LRI
  1.  ;
  1.  I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D ^LRCAPV Q:$G(LREND)
  1.  ;
  1.  ; Check for different performing lab.
  1.  I $G(LRPL) N LRDUZ S LRDUZ(2)=LRPL
  1.  ;
  1.  D SLOW^LRVER
  1.  Q
  1.  ;
  1.  ;
  1. SLOWK ;
  1.  K I5,LRCSN,LRORIFN,LRWPC,X4
  1.  K K,LRACN,LRACN0,LRDAX,LRDOC,LRCDEF,LRCDEF0
  1.  K LRLBL,LRLBLBP,LRLL,LRLWC,LRMACH,LROD0,LROD1,LROD3,LROOS,LRORD,LROSD,LRYR
  1.  K LRAA,LRACD,LRAN,LRAOD,LRCAPLOC,LRAOD,LRCDT,LRCFL,LRCODEN,LRCS,LRDAT,LRDEL,LRDFN,LRDPF,LRDV,LRDVF,LREAL,LREDO,LRFFLG,LRFP,LRIDIV,LRIDT,LRIX,LRJ,LRK,LRBLBP,LRLCT,LRLDT,LRLLOC,LRM,LRMAX1
  1.  K LRMAX2,LRMAXX,LRMETH,LRMX,LRNAME,LRNOCODE,LROLLOC,LROT,LRPR,LRPRAC,LRRB,LRSAMP,LRSAVE,LRSPN,LRSS,LRSSX,LRST,LRSUB,LRSUM,LRSX,LRSXN,LRTEST,LRTN,LRTREA,LRTS,LRTX,LRTY,LRVRM,LRWL0,LRWLC,LRWRD,LRX,LRXD,LRWRD,SSN
  1.  K DR,GLB,H8,L,S5,T,TT
  1.  K HRCN            ; IHS/ANMC/CLS 08/18/96  -- IHS/OIT/MKK -- LR*5.2*1027 -- Restored line
  1.  Q