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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAKDIFF3 1251 printed Oct 16, 2024@17:43:43 Page 2
LAKDIFF3 ;DALOI/DLG - LAB ROUTINE DATA VERIFICATION BY WORKLIST OF KEYBOARD DIFFS ; 7/28/88 10:01 AM
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**52,60**;Sep 27, 1994
+2 ;
+3 NEW B,LRCUP,LRORU3,LRPANEL,LRPROF,LRSQ,LRTM60,LRTRAY,LRTSE,LRTYPE,X,Y
+4 ;
+5 SET LREND=0
SET LRLL=LWL
SET LRTYPE=$PIECE(^LRO(68.2,LRLL,0),U,3)
+6 ;
+7 SET LRPROF=$ORDER(^LRO(68.2,LRLL,10,0))
+8 IF LRPROF<1
WRITE !,"No profile defined."
QUIT
+9 SET B=$ORDER(^LRO(68.2,LRLL,10,LRPROF))
+10 IF B>0
Begin DoDot:1
+11 NEW DIC,X,Y
+12 SET DIC(0)="AEQ"
SET DIC="^LRO(68.2,"_LRLL_",10,"
+13 DO ^DIC
+14 IF Y<1
SET LREND=1
QUIT
+15 SET LRPROF=+Y
End DoDot:1
if LREND
QUIT
+16 ;
+17 SET X=^LRO(68.2,LRLL,10,LRPROF,0)
SET LRPANEL=$PIECE(X,U,1)
+18 ;
+19 IF $PIECE(^LRO(68,LRAA,0),U,2)'="CH"
SET LREND=1
QUIT
+20 ;
+21 KILL LRORD,LRVTS,LRTSTS
+22 DO EXPLODE^LRGP2
+23 IF '$ORDER(LRVTS(0))
SET LREND=1
QUIT
+24 ;
+25 SET I=0
+26 FOR
SET I=$ORDER(LRORD(I))
if I<1
QUIT
SET J=LRORD(I)
SET X=$PIECE(^LAB(60,J,0),U,5)
SET LRORD(I)=$PIECE(X,";",2)
+27 ;
+28 KILL LRTEST,C5,LRSET,LRLDT,DIC,LRNM,LRNG,LRDEL,T,LRFP,LRAB,LRVER,Y,Z
+29 ;
+30 SET LRTM60=9999999-$$HTFM^XLFDT($HOROLOG-$PIECE($GET(^LAB(69.9,1,0)),U,7),1)
+31 SET LRTRAY=TRAY
SET LRCUP=CUP
SET LRSQ=ISQN
SET LRTSE=-1
+32 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRODT=$PIECE(X,U,4)
SET LRSN=$PIECE(X,U,5)
+33 SET LRORU3=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
+34 ;
+35 WRITE !,PNM,?40,SSN
+36 ;
+37 DO VER^LRVR1
+38 ;
+39 IF 'LREND
IF $GET(LRAA)
IF $GET(LRAD)
IF $GET(LRAN)
SET $PIECE(^LRO(68,LRAA,1,LRAD,2),"^",4)=$GET(LRAN)
+40 ;
+41 QUIT
