- LR7OU3 ; IHS/DIR/AAB - Match entries in file 60 to 64 ; [ 8/11/97 ]
- ;;5.2;LR;**1003**;JUN 01, 1998
- ;
- ;;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
- LR7OU3 ; IHS/DIR/AAB - Match entries in file 60 to 64 ; [ 8/11/97 ]
- +1 ;;5.2;LR;**1003**;JUN 01, 1998
- +2 ;
- +3 ;;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
