LRKDIFF3.m

LRKDIFF3 ;SLC/DLG- LAB ROUTINE DATA VERIFICATION BY WORKLIST OF KEYBOARD DIFFS ; 7/28/88  10:01 AM ; [ 10/14/90  8:58 PM ]

 ;;V~5.0~;LAB;;02/27/90 17:09

 D:'$D(LRPARAM) ^LRPARAM S LREND=0

 S LRLL=LWL,LRTYPE=$P(^LRO(68.2,LRLL,0),U,3)

 S LRPROF=$N(^LRO(68.2,LRLL,10,0)) I LRPROF<1 W !,"No profile defined." Q

 S B=$N(^LRO(68.2,LRLL,10,LRPROF))

 I B>0 S DIC(0)="AEQ",DIC="^LRO(68.2,"_LRLL_",10," D ^DIC G STOP:Y<1 S LRPROF=+Y

 S X=^LRO(68.2,LRLL,10,LRPROF,0),LRPANEL=$P(X,U,1)

 G ^LRMIEDZ:$P(^LRO(68,LRAA,0),U,2)="MI",STOP:$P(^(0),U,2)'="CH"

 S LREND=0 D EXPAND G STOP:LREND!($N(LRVTS(0))<0)

 F I=0:0 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)

 S Y=^LRO(68,LRAA,0),LRTSE=-1

 G QUIT:LREND

 S (LRTRAY,X2)=TRAY,(LRCUP,X3)=CUP,%H=$H-60 D YMD^LRX S LRTM60=9999999-X,LRSQ=ISQN

 K LRTEST,C5,LRSET,LRLDT,DIC,LRNM,LRNG,LRDEL,T,LRFP,LRAB,LRVER,Y,Z

 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRODT=$P(X,U,4),LRSN=$P(X,U,5),LRDFN=+X,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX

 W !,PNM,?40,HRCN  ;IHS/ANMC/CLS 10/14/90 HRCN

 D VER^LRVR1 G END:LREND

 Q

END I $D(LRAN),$D(LRAD) S:'$D(^LRO(68,LRAA,1,LRAD,2)) ^(2)="^^" S ^(2)=$P(^(2),U,1,3)_U_LRAN_U_$P(^(2),U,5,99),LREND=1

 G QUIT

STOP S LREND=1 Q

QUIT D ^LRGVK Q

EXPAND D EXPLODE^LRGP2 Q:$N(LRVTS(0))  S LREND=1 Q

LRKDIFF3  ;SLC/DLG- LAB ROUTINE DATA VERIFICATION BY WORKLIST OF KEYBOARD DIFFS ; 7/28/88  10:01 AM ; [ 10/14/90  8:58 PM ]

 +1       ;;V~5.0~;LAB;;02/27/90 17:09

 +2        IF '$DATA(LRPARAM)

               DO ^LRPARAM

           SET LREND=0

 +3        SET LRLL=LWL

           SET LRTYPE=$PIECE(^LRO(68.2,LRLL,0),U,3)

 +4 

*** ERROR ***

           SET LRPROF=$N(^LRO(68.2,LRLL,10,0))

           IF LRPROF<1

               WRITE !,"No profile defined."

               QUIT 

 +5 

*** ERROR ***

           SET B=$N(^LRO(68.2,LRLL,10,LRPROF))

 +6        IF B>0

               SET DIC(0)="AEQ"

               SET DIC="^LRO(68.2,"_LRLL_",10,"

               DO ^DIC

               IF Y<1

                   GOTO STOP

               SET LRPROF=+Y

 +7        SET X=^LRO(68.2,LRLL,10,LRPROF,0)

           SET LRPANEL=$PIECE(X,U,1)

 +8        IF $PIECE(^LRO(68,LRAA,0),U,2)="MI"

               GOTO ^LRMIEDZ

           IF $PIECE(^(0),U,2)'="CH"

               GOTO STOP

 +9        SET LREND=0

           DO EXPAND