AMQQFAN ; IHS/CMI/THL - FREE TEXT ANALYTIC ROUTINES ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
VAR S AMQQSYMB=$P(AMQQX,";")
S AMQQVAL1=$P(AMQQX,";",2)
S AMQQVAL2=$P(AMQQX,";",3)
K AMQQNOT
SYMBOL I $E(AMQQSYMB)="'" S AMQQNOT="",AMQQSYMB=$E(AMQQSYMB,2,99)
S %=$F("[]=$-#?",AMQQSYMB)
I '%
E D @("A"_(%-1))
I ('$D(AMQQNOT)=$T)
EXIT K %,AMQQSYMB,AMQQVAL1,AMQQVAL2,AMQQVALU,AMQQNOT,AMQQX
Q
;
A1 I AMQQVALU[AMQQVAL1
Q
;
A2 I AMQQVALU]AMQQVAL1
Q
;
A3 I AMQQVALU=AMQQVAL1
Q
;
A4 I $E(AMQQVALU,1,$L(AMQQVAL1))=AMQQVAL1
Q
;
A5 I AMQQVALU]AMQQVAL1,AMQQVALU']AMQQVAL2
Q
;
A6 I $E(AMQQVALU,$L(AMQQVALU)-$L(AMQQVAL1)+1,250)=AMQQVAL1
Q
;
A7 X ("I AMQQVALU?"_AMQQVAL1)
Q
;
SER ; ENTRY POINT FOR COMPUTING SEARCH EFFICIENCY RATING
; ENTRY POINT FROM EXECUTING ^AMQQ(1,D0,3)
N AMQQSYMB,AMQQVALU,AMQQVAL1,AMQQVAL2,AMQQNOT,%
S AMQQSYMB=AMQQESBL,AMQQVALU=AMQQEVAL,AMQQVAL1=$P(AMQQECPR,";"),AMQQVAL2=$P(AMQQECPR,";",2)=""
D SYMBOL
Q
;
NAME ; ENTRY POINT FROM METADICTIONARY (PATIENT;NAME)
N AMQQSYMB,AMQQVALU,AMQQVAL1,AMQQVAL2,AMQQNOT,%
S AMQQSYMB=AMQP(.11)
S AMQQVALU=AMQP(.1)
S AMQQVAL1=AMQP(.101)
S AMQQVAL2=""
D SYMBOL
Q
;
TEXT ; ENTRY POINT FROM AMQQMULT
N X,Y,Z,%,AMQQSYMB,AMQQNOT
S X=AMQQVAL1
S Y=AMQQVAL2
S Z=AMQQVALU
N AMQQVAL1,AMQQVAL2
S AMQQSYMB=$P(X,":")
I X="'<:'>" S AMQQSYMB="-"
S AMQQVAL1=$P(Y,":")
S AMQQVAL2=$P(Y,":",2)
D SYMBOL
I S AMQQVALU=Z
Q
;
START ; ENTRY POINT FROM METADICTIONARY
N X,Y,Z,%
S Y=AMQP(.11)
I Y'="$",Y'="=" Q
S %=AMQP(.101)
S X=$E(%,$L(%))
S X=$A(X)-1
S X=$C(X)
S AMQP(.1)=$E(%,1,$L(%)-1)_X
I Y="$" S AMQP(.111)=AMQP(.101)_"~" Q
S AMQP(.111)=AMQP(.101)
Q
;
AMQQFAN ; IHS/CMI/THL - FREE TEXT ANALYTIC ROUTINES ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
VAR SET AMQQSYMB=$PIECE(AMQQX,";")
+1 SET AMQQVAL1=$PIECE(AMQQX,";",2)
+2 SET AMQQVAL2=$PIECE(AMQQX,";",3)
+3 KILL AMQQNOT
SYMBOL IF $EXTRACT(AMQQSYMB)="'"
SET AMQQNOT=""
SET AMQQSYMB=$EXTRACT(AMQQSYMB,2,99)
+1 SET %=$FIND("[]=$-#?",AMQQSYMB)
+2 IF '%
+3 IF '$TEST
DO @("A"_(%-1))
+4 IF ('$DATA(AMQQNOT)=$TEST)
EXIT KILL %,AMQQSYMB,AMQQVAL1,AMQQVAL2,AMQQVALU,AMQQNOT,AMQQX
+1 QUIT
+2 ;
A1 IF AMQQVALU[AMQQVAL1
+1 QUIT
+2 ;
A2 IF AMQQVALU]AMQQVAL1
+1 QUIT
+2 ;
A3 IF AMQQVALU=AMQQVAL1
+1 QUIT
+2 ;
A4 IF $EXTRACT(AMQQVALU,1,$LENGTH(AMQQVAL1))=AMQQVAL1
+1 QUIT
+2 ;
A5 IF AMQQVALU]AMQQVAL1
IF AMQQVALU']AMQQVAL2
+1 QUIT
+2 ;
A6 IF $EXTRACT(AMQQVALU,$LENGTH(AMQQVALU)-$LENGTH(AMQQVAL1)+1,250)=AMQQVAL1
+1 QUIT
+2 ;
A7 XECUTE ("I AMQQVALU?"_AMQQVAL1)
+1 QUIT
+2 ;
SER ; ENTRY POINT FOR COMPUTING SEARCH EFFICIENCY RATING
+1 ; ENTRY POINT FROM EXECUTING ^AMQQ(1,D0,3)
+2 NEW AMQQSYMB,AMQQVALU,AMQQVAL1,AMQQVAL2,AMQQNOT,%
+3 SET AMQQSYMB=AMQQESBL
SET AMQQVALU=AMQQEVAL
SET AMQQVAL1=$PIECE(AMQQECPR,";")
SET AMQQVAL2=$PIECE(AMQQECPR,";",2)=""
+4 DO SYMBOL
+5 QUIT
+6 ;
NAME ; ENTRY POINT FROM METADICTIONARY (PATIENT;NAME)
+1 NEW AMQQSYMB,AMQQVALU,AMQQVAL1,AMQQVAL2,AMQQNOT,%
+2 SET AMQQSYMB=AMQP(.11)
+3 SET AMQQVALU=AMQP(.1)
+4 SET AMQQVAL1=AMQP(.101)
+5 SET AMQQVAL2=""
+6 DO SYMBOL
+7 QUIT
+8 ;
TEXT ; ENTRY POINT FROM AMQQMULT
+1 NEW X,Y,Z,%,AMQQSYMB,AMQQNOT
+2 SET X=AMQQVAL1
+3 SET Y=AMQQVAL2
+4 SET Z=AMQQVALU
+5 NEW AMQQVAL1,AMQQVAL2
+6 SET AMQQSYMB=$PIECE(X,":")
+7 IF X="'<:'>"
SET AMQQSYMB="-"
+8 SET AMQQVAL1=$PIECE(Y,":")
+9 SET AMQQVAL2=$PIECE(Y,":",2)
+10 DO SYMBOL
+11 IF $TEST
SET AMQQVALU=Z
+12 QUIT
+13 ;
START ; ENTRY POINT FROM METADICTIONARY
+1 NEW X,Y,Z,%
+2 SET Y=AMQP(.11)
+3 IF Y'="$"
IF Y'="="
QUIT
+4 SET %=AMQP(.101)
+5 SET X=$EXTRACT(%,$LENGTH(%))
+6 SET X=$ASCII(X)-1
+7 SET X=$CHAR(X)
+8 SET AMQP(.1)=$EXTRACT(%,1,$LENGTH(%)-1)_X
+9 IF Y="$"
SET AMQP(.111)=AMQP(.101)_"~"
QUIT
+10 SET AMQP(.111)=AMQP(.101)
+11 QUIT
+12 ;
