LAKDIFF3.m

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