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

LRKDIFF3.m

Go to the documentation of this file. 
  1. 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
  1.  D:'$D(LRPARAM) ^LRPARAM S LREND=0
  1.  S LRLL=LWL,LRTYPE=$P(^LRO(68.2,LRLL,0),U,3)
  1.  S LRPROF=$N(^LRO(68.2,LRLL,10,0)) I LRPROF<1 W !,"No profile defined." Q
  1.  S B=$N(^LRO(68.2,LRLL,10,LRPROF))
  1.  I B>0 S DIC(0)="AEQ",DIC="^LRO(68.2,"_LRLL_",10," D ^DIC G STOP:Y<1 S LRPROF=+Y
  1.  S X=^LRO(68.2,LRLL,10,LRPROF,0),LRPANEL=$P(X,U,1)
  1.  G ^LRMIEDZ:$P(^LRO(68,LRAA,0),U,2)="MI",STOP:$P(^(0),U,2)'="CH"
  1.  S LREND=0 D EXPAND G STOP:LREND!($N(LRVTS(0))<0)
  1.  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)
  1.  S Y=^LRO(68,LRAA,0),LRTSE=-1
  1.  G QUIT:LREND
  1.  S (LRTRAY,X2)=TRAY,(LRCUP,X3)=CUP,%H=$H-60 D YMD^LRX S LRTM60=9999999-X,LRSQ=ISQN
  1.  K LRTEST,C5,LRSET,LRLDT,DIC,LRNM,LRNG,LRDEL,T,LRFP,LRAB,LRVER,Y,Z
  1.  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
  1.  W !,PNM,?40,HRCN  ;IHS/ANMC/CLS 10/14/90 HRCN
  1.  D VER^LRVR1 G END:LREND
  1.  Q
  1. 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
  1.  G QUIT
  1. STOP S LREND=1 Q
  1. QUIT D ^LRGVK Q
  1. EXPAND D EXPLODE^LRGP2 Q:$N(LRVTS(0))  S LREND=1 Q