LR7OU3 ;slc/dcm - Match entries in file 60 to 64 ;8/11/97
;;5.2;LAB SERVICE;**121**;Sep 27, 1994
6 ;Find matches starting with file 60 ->64
N X,IFN,IFN1,Y,Z,CTR,CTR1
S IFN=0,CTR=0,CTR1=0 F S IFN=$O(^LAB(60,IFN)) Q:IFN<1 S MATCH=0,X=^(IFN,0) D
. S Y=$$A1($P(X,"^")) I $L(Y) W !,$P(X,"^")_" = "_Y,?60,"Match on name" S MATCH=1,CTR=CTR+1 Q
. S Y=$$A1($$UPPER^LR7OU1($P(X,"^"))) I $L(Y) W !,$P(X,"^")_" = "_Y,?60,"Match on U-case name" S MATCH=1,CTR=CTR+1 Q
. S IFN1=0 F S IFN1=$O(^LAB(60,IFN,5,IFN1)) Q:IFN1<1 S Z=$P(^(IFN1,0),"^") D Q:MATCH
. . S Y=$$A1(Z) I $L(Y) W !,$P(X,"^")_" = "_Y,?60,"Synonym match "_Z S MATCH=1,CTR=CTR+1 Q
. . S Y=$$A1($$UPPER^LR7OU1(Z)) I $L(Y) W !,$P(X,"^")_" = "_Y,?60,"Synonym U-case match "_Z S MATCH=1,CTR=CTR+1 Q
. I 'MATCH S M=$P($P(X," ",1),",") S IFN1=$E(M,1,$L(M)-1) F S IFN1=$O(^LAM("B",IFN1)) Q:IFN1=""!($P($P(IFN1," "),",")'=M) S Z=$O(^(IFN1,0)) I Z D
. . W !,$P(X,"^")_" ~ "_$P(^LAM(Z,0),"^"),?60,"Close match" S CTR1=CTR1+1,MATCH=1
. I 'MATCH S M=$$UPPER^LR7OU1($P($P(X," ",1),",")) S IFN1=$E(M,1,$L(M)-1) F S IFN1=$O(^LAM("B",IFN1)) Q:IFN1=""!($P($P(IFN1," "),",")'=M) S Z=$O(^(IFN1,0)) I Z D
. . W !,$P(X,"^")_" ~ "_$P(^LAM(Z,0),"^"),?60,"Close match" S CTR1=CTR1+1,MATCH=1
. I 'MATCH W !,$P(X,"^"),?65,"NO MATCH"
W !!,"TOTAL ENTRIES IN 64: "_$P(^LAM(0),"^",4),!,"TOTAL ENTRIES IN 60: "_$P(^LAB(60,0),"^",4),!,"TOTAL MATCHES: "_CTR,!,"TOTAL CLOSE MATCHES: "_CTR1
Q
A1(X) ;Find matching item in file 64
S X=$O(^LAM("B",X,0)) I X S X=$P(^LAM(X,0),"^")
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OU3 1542 printed Nov 22, 2024@17:15:55 Page 2
LR7OU3 ;slc/dcm - Match entries in file 60 to 64 ;8/11/97
+1 ;;5.2;LAB SERVICE;**121**;Sep 27, 1994
6 ;Find matches starting with file 60 ->64
+1 NEW X,IFN,IFN1,Y,Z,CTR,CTR1
+2 SET IFN=0
SET CTR=0
SET CTR1=0
FOR
SET IFN=$ORDER(^LAB(60,IFN))
if IFN<1
QUIT
SET MATCH=0
SET X=^(IFN,0)
Begin DoDot:1
+3 SET Y=$$A1($PIECE(X,"^"))
IF $LENGTH(Y)
WRITE !,$PIECE(X,"^")_" = "_Y,?60,"Match on name"
SET MATCH=1
SET CTR=CTR+1
QUIT
+4 SET Y=$$A1($$UPPER^LR7OU1($PIECE(X,"^")))
IF $LENGTH(Y)
WRITE !,$PIECE(X,"^")_" = "_Y,?60,"Match on U-case name"
SET MATCH=1
SET CTR=CTR+1
QUIT
+5 SET IFN1=0
FOR
SET IFN1=$ORDER(^LAB(60,IFN,5,IFN1))
if IFN1<1
QUIT
SET Z=$PIECE(^(IFN1,0),"^")
Begin DoDot:2
+6 SET Y=$$A1(Z)
IF $LENGTH(Y)
WRITE !,$PIECE(X,"^")_" = "_Y,?60,"Synonym match "_Z
SET MATCH=1
SET CTR=CTR+1
QUIT
+7 SET Y=$$A1($$UPPER^LR7OU1(Z))
IF $LENGTH(Y)
WRITE !,$PIECE(X,"^")_" = "_Y,?60,"Synonym U-case match "_Z
SET MATCH=1
SET CTR=CTR+1
QUIT
End DoDot:2
if MATCH
QUIT
+8 IF 'MATCH
SET M=$PIECE($PIECE(X," ",1),",")
SET IFN1=$EXTRACT(M,1,$LENGTH(M)-1)
FOR
SET IFN1=$ORDER(^LAM("B",IFN1))
if IFN1=""!($PIECE($PIECE(IFN1," "),",")'=M)
QUIT
SET Z=$ORDER(^(IFN1,0))
IF Z
Begin DoDot:2
+9 WRITE !,$PIECE(X,"^")_" ~ "_$PIECE(^LAM(Z,0),"^"),?60,"Close match"
SET CTR1=CTR1+1
SET MATCH=1
End DoDot:2
+10 IF 'MATCH
SET M=$$UPPER^LR7OU1($PIECE($PIECE(X," ",1),","))
SET IFN1=$EXTRACT(M,1,$LENGTH(M)-1)
FOR
SET IFN1=$ORDER(^LAM("B",IFN1))
if IFN1=""!($PIECE($PIECE(IFN1," "),",")'=M)
QUIT
SET Z=$ORDER(^(IFN1,0))
IF Z
Begin DoDot:2
+11 WRITE !,$PIECE(X,"^")_" ~ "_$PIECE(^LAM(Z,0),"^"),?60,"Close match"
SET CTR1=CTR1+1
SET MATCH=1
End DoDot:2
+12 IF 'MATCH
WRITE !,$PIECE(X,"^"),?65,"NO MATCH"
End DoDot:1
+13 WRITE !!,"TOTAL ENTRIES IN 64: "_$PIECE(^LAM(0),"^",4),!,"TOTAL ENTRIES IN 60: "_$PIECE(^LAB(60,0),"^",4),!,"TOTAL MATCHES: "_CTR,!,"TOTAL CLOSE MATCHES: "_CTR1
+14 QUIT
A1(X) ;Find matching item in file 64
+1 SET X=$ORDER(^LAM("B",X,0))
IF X
SET X=$PIECE(^LAM(X,0),"^")
+2 QUIT X
