LRUWK ;REG/AVAMC - WORKLOAD UTILITY ;8/20/93 06:57
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUWK 614 printed Dec 13, 2024@02:22:26 Page 2
LRUWK ;REG/AVAMC - WORKLOAD UTILITY ;8/20/93 06:57
+1 ;;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
