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

LAKDIFF3.m

Go to the documentation of this file.
LAKDIFF3 ;DALOI/DLG - LAB ROUTINE DATA VERIFICATION BY WORKLIST OF KEYBOARD DIFFS ; 7/28/88  10:01 AM
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**52,60**;Sep 27, 1994
 ;
 N B,LRCUP,LRORU3,LRPANEL,LRPROF,LRSQ,LRTM60,LRTRAY,LRTSE,LRTYPE,X,Y
 ;
 S LREND=0,LRLL=LWL,LRTYPE=$P(^LRO(68.2,LRLL,0),U,3)
 ;
 S LRPROF=$O(^LRO(68.2,LRLL,10,0))
 I LRPROF<1 W !,"No profile defined." Q
 S B=$O(^LRO(68.2,LRLL,10,LRPROF))
 I B>0 D  Q:LREND
 . N DIC,X,Y
 . S DIC(0)="AEQ",DIC="^LRO(68.2,"_LRLL_",10,"
 . D ^DIC
 . I Y<1 S LREND=1 Q
 . S LRPROF=+Y
 ;
 S X=^LRO(68.2,LRLL,10,LRPROF,0),LRPANEL=$P(X,U,1)
 ;
 I $P(^LRO(68,LRAA,0),U,2)'="CH" S LREND=1 Q
 ;
 K LRORD,LRVTS,LRTSTS
 D EXPLODE^LRGP2
 I '$O(LRVTS(0)) S LREND=1 Q
 ;
 S I=0
 F  S I=$O(LRORD(I)) Q:I<1  S J=LRORD(I),X=$P(^LAB(60,J,0),U,5),LRORD(I)=$P(X,";",2)
 ;
 K LRTEST,C5,LRSET,LRLDT,DIC,LRNM,LRNG,LRDEL,T,LRFP,LRAB,LRVER,Y,Z
 ;
 S LRTM60=9999999-$$HTFM^XLFDT($H-$P($G(^LAB(69.9,1,0)),U,7),1)
 S LRTRAY=TRAY,LRCUP=CUP,LRSQ=ISQN,LRTSE=-1
 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRODT=$P(X,U,4),LRSN=$P(X,U,5)
 S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
 ;
 W !,PNM,?40,SSN
 ;
 D VER^LRVR1
 ;
 I 'LREND,$G(LRAA),$G(LRAD),$G(LRAN) S $P(^LRO(68,LRAA,1,LRAD,2),"^",4)=$G(LRAN)
 ;
 Q