- 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 ;
