- 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
- 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
