LRUWK.m

LRUWK ; IHS/DIR/FJE - WORKLOAD UTILITY 06:57 ; 

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

X S LRT=$O(^LAB(60,"B",X,0)) G:'LRT OUT Q:$D(X("NOCODES"))

 F B=0:0 S B=$O(^LAB(60,LRT,9,B)) Q:'B  S LRT(B)=""

 Q:$D(LRT)=11

OUT W $C(7),!!,"Must have test in LAB TEST file (#60) called",!,"'",X,"'" W:'$D(X("NOCODES")) " with VERIFY WKLD CODES." K X S J=1 Q

 ;

A S LRT=$O(^LAB(60,"B",X,0)) G:'LRT OUT F B=0:0 S B=$O(^LAB(60,LRT,9.1,B)) Q:'B  S LRT(B)=""

 I $D(LRT)'=11 D OUT W " with ACCESSION WKLD CODES."

 Q

W W $C(7),!!,"Must have entry in WKLD CODE file (#64) called",!,"'",X,"'"," with WKLD CODE: ",Y K X,Y Q

 Q

LRUWK     ; IHS/DIR/FJE - WORKLOAD UTILITY 06:57 ; 

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

X          SET LRT=$ORDER(^LAB(60,"B",X,0))

           IF 'LRT

               GOTO OUT

           IF $DATA(X("NOCODES"))

               QUIT 

 +1        FOR B=0:0

               SET B=$ORDER(^LAB(60,LRT,9,B))

               IF 'B

                   QUIT 

               SET LRT(B)=""

 +2        IF $DATA(LRT)=11

               QUIT 

OUT        WRITE $CHAR(7),!!,"Must have test in LAB TEST file (#60) called",!,"'",X,"'"

           IF '$DATA(X("NOCODES"))

               WRITE " with VERIFY WKLD CODES."

           KILL X

           SET J=1

           QUIT 

 +1       ;

A          SET LRT=$ORDER(^LAB(60,"B",X,0))

           IF 'LRT

               GOTO OUT

           FOR B=0:0

               SET B=$ORDER(^LAB(60,LRT,9.1,B))

               IF 'B

                   QUIT 

               SET LRT(B)=""

 +1        IF $DATA(LRT)'=11

               DO OUT

               WRITE " with ACCESSION WKLD CODES."

 +2        QUIT 

W          WRITE $CHAR(7),!!,"Must have entry in WKLD CODE file (#64) called",!,"'",X,"'"," with WKLD CODE: ",Y

           KILL X,Y

           QUIT 

 +1        QUIT