- 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 Feb 18, 2025@23:48:17 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