AMQQATS ; IHS/CMI/THL - MAKE "Q" LINE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
NEW N AMQQFTYP,AMQQLINK,AMQQSYMB,AMQQVCL,AMQQCOMP,AMQQCOND
RUN D VAR
I $P(Q,U,4) D ^AMQQATS1,SET G EXIT
S X(1)=$P(AMQQCOMP,";")
S X(2)=$P(AMQQCOMP,";",2)
D @("FILTER"_AMQQFTYP)
I $D(AMQQCOMP),$D(X(3)),$D(X(4)),$P(AMQQCOMP,";",4)="EXISTS" S AMQQF(1)=X(3),AMQQF(2)=X(4)
D SET
EXIT K AMQQF,%,I,Q,X,Y,N,AMQQFSQN,AMQQFSQX
Q
;
VAR S Q=AMQQQ
S AMQQLINK=+Q
S AMQQFTYP=$P(Q,U,3)
S AMQQCOMP=$P(Q,U,9)
S AMQQVCL=$P(Q,U,10)
S AMQQSYMB=$P(Q,U,8)
S AMQQCOND=$P(Q,U,7)
Q
;
SET I $P(Q,U,3)="L",$D(AMQQURGN),$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"--")) S $P(Q,U,18)=3
S %=""
F I=1:1 Q:'$D(AMQQF(I)) S %=%_AMQQF(I)_";"
I +Q=166!(+Q=178)!(+Q=86) S %=$P(Q,U,9)
S $P(Q,U,15)=%
I $D(AMQQSQQF) S ^UTILITY("AMQQ",$J,"QQ",AMQQSQQF)=Q Q
I $D(AMQQGVF) Q
;SET ^UTILITY("AMQQ",$J,"Q", GLOBAL NODE
S ^UTILITY("AMQQ",$J,"Q",AMQQUATN)=Q
S %=$P(Q,U,11)
S X=1-(+%)
S ^UTILITY("AMQQ",$J,"WEIGHT",X,AMQQUATN)=$P(%,":",2)
Q
;
FILTERD S X(3)=0
S X(4)=99999999
S X(5)=.0000001
D ANAL
Q
;
FILTERB S X(3)=-1
S X(4)=1.01
S X(5)=.000001
D ANAL
Q
;
FILTERN S X(3)=-9999999
S X(4)=9999999
S X(5)=.000001
D ANAL
Q
;
FILTERY S AMQQF(1)=X(1)
S AMQQF(2)=X(2)
S AMQQF(3)=$P($P(Q,U,9),";",3)
S AMQQF(4)=$P($P(Q,U,9),";",4)
Q
;
FILTERC S AMQQF(1)=X(1)
S AMQQF(2)=X(2)
Q
;
FILTERG ;;
FILTERL ; I $D(AMQQURGN),$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"--")) S $P(Q,U,18)=3 Q
F %=1,2 S AMQQF(%)=$P(AMQQCOMP,";",4)
Q
;
FILTERS S AMQQF(1)=AMQQSYMB
I AMQQCOMP=";;;EXISTS" S AMQQF(2)="",AMQQF(3)="~~~~" Q
S %=$E(AMQQCOMP,$L(AMQQCOMP))
S %=$A(%)
S %=$C(%-1)_"~~~~~"
S AMQQF(2)=$E(AMQQCOMP,1,$L(AMQQCOMP)-1)_%
S AMQQF(3)=AMQQCOMP
Q
;
FILTERF I AMQQSYMB'="-" S AMQQF(1)=AMQQSYMB,AMQQF(2)=AMQQCOMP,AMQQF(3)="" Q
S AMQQF(1)="-"
S AMQQF(3)=$P(AMQQCOMP,";",2),%=$P(AMQQCOMP,";")
S X=$E(%,$L(%))
S %=$E(%,1,$L(%)-1)
S X=$C($A(X)-1)
S %=%_X_"~~~~~"
S AMQQF(2)=%
Q
;
FILTERA S %DT=""
S X="T+1"
D ^%DT
S X(3)=Y
S %=AMQQSYMB
I %="'<" S X(1)=X(1)-1,%=">" G FAG
I %="'>" S X(1)=X(1)+1,%="<" G FAL
FAG I %=">" S AMQQF(1)=0,AMQQF(2)=X(3)-((X(1)+1)*10000),%="><" G FSET
FAL I %="<" S AMQQF(2)=99999999,AMQQF(1)=DT-(X(1)*10000),%="><" G FSET
I %="=" S AMQQF(1)=DT-((X(1)+1)*10000),AMQQF(2)=X(3)-(X(1)*10000),%="><" G FSET
I %="'=",AMQQCOMP["EXIST" S AMQQF(1)=0,AMQQF(2)=9999999 G FSET
I %="'=" S AMQQF(1)=DT-(X(1)*10000),AMQQF(2)=X(3)-((X(1)+1)*10000),%="'><" G FSET
I %="><",'+AMQQCOMP S AMQQCOMP=$P(AMQQCOMP,";",2)+1,%="<",$P(Q,U,9)=AMQQCOMP,X(1)=X(2)+1 G FAL
I %="><" S AMQQF(1)=DT-((X(2)+1)*10000),AMQQF(2)=X(3)-(X(1)*10000) G FSET
S AMQQF(1)=DT-(X(1)*10000)
S AMQQF(2)=(X(3)-(X(2)*10000))-10000
FSET S $P(Q,U,8)=%
S AMQQSYMB=%
Q
;
ANAL I AMQQSYMB=">" S AMQQF(1)=X(1),AMQQF(2)=X(4) Q
I AMQQSYMB="<" S AMQQF(1)=X(3),AMQQF(2)=X(1) Q
I AMQQSYMB="=",AMQQFTYP="D",X(1)=X(2),X(1)=X(1)\1 S AMQQF(2)=X(1)+.99,AMQQF(1)=X(1)-.76 Q
I AMQQSYMB="=" S AMQQF(1)=X(1)-X(5),AMQQF(2)=X(1)+X(5) Q
I AMQQSYMB="><" S AMQQF(1)=X(1)-X(5),AMQQF(2)=X(2)+X(5) Q
I AMQQSYMB="'>" S AMQQF(1)=X(3),AMQQF(2)=X(1)+X(5) Q
I AMQQSYMB="'<" S AMQQF(1)=X(1)-X(5),AMQQF(2)=X(4) Q
I AMQQSYMB="'=" S AMQQF(1)=X(1),AMQQF(2)=X(1) Q
S AMQQF(1)=X(2)
S AMQQF(2)=X(1)
Q
;
DOC S X="LINK^ATTRIBUTE NAME^F TYPE^CONTEXT SWITCH^CONDITION^NUMBER OF CONDITIONS^CONDITION NAME^SYMBOL^COMPARISON VALUE^VALIDITY CODE LOCATION^SEARCH EFFICIENCY RATING^OR TEXT^INDEXED^NUMBER OF VARIABLES^FILTERS^NOT"
W !!
F I=1:1:16 W !,I,") ",$P(X,U,I)
Q
;
AMQQATS ; IHS/CMI/THL - MAKE "Q" LINE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
NEW NEW AMQQFTYP,AMQQLINK,AMQQSYMB,AMQQVCL,AMQQCOMP,AMQQCOND
RUN DO VAR
+1 IF $PIECE(Q,U,4)
DO ^AMQQATS1
DO SET
GOTO EXIT
+2 SET X(1)=$PIECE(AMQQCOMP,";")
+3 SET X(2)=$PIECE(AMQQCOMP,";",2)
+4 DO @("FILTER"_AMQQFTYP)
+5 IF $DATA(AMQQCOMP)
IF $DATA(X(3))
IF $DATA(X(4))
IF $PIECE(AMQQCOMP,";",4)="EXISTS"
SET AMQQF(1)=X(3)
SET AMQQF(2)=X(4)
+6 DO SET
EXIT KILL AMQQF,%,I,Q,X,Y,N,AMQQFSQN,AMQQFSQX
+1 QUIT
+2 ;
VAR SET Q=AMQQQ
+1 SET AMQQLINK=+Q
+2 SET AMQQFTYP=$PIECE(Q,U,3)
+3 SET AMQQCOMP=$PIECE(Q,U,9)
+4 SET AMQQVCL=$PIECE(Q,U,10)
+5 SET AMQQSYMB=$PIECE(Q,U,8)
+6 SET AMQQCOND=$PIECE(Q,U,7)
+7 QUIT
+8 ;
SET IF $PIECE(Q,U,3)="L"
IF $DATA(AMQQURGN)
IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,"--"))
SET $PIECE(Q,U,18)=3
+1 SET %=""
+2 FOR I=1:1
IF '$DATA(AMQQF(I))
QUIT
SET %=%_AMQQF(I)_";"
+3 IF +Q=166!(+Q=178)!(+Q=86)
SET %=$PIECE(Q,U,9)
+4 SET $PIECE(Q,U,15)=%
+5 IF $DATA(AMQQSQQF)
SET ^UTILITY("AMQQ",$JOB,"QQ",AMQQSQQF)=Q
QUIT
+6 IF $DATA(AMQQGVF)
QUIT
+7 ;SET ^UTILITY("AMQQ",$J,"Q", GLOBAL NODE
+8 SET ^UTILITY("AMQQ",$JOB,"Q",AMQQUATN)=Q
+9 SET %=$PIECE(Q,U,11)
+10 SET X=1-(+%)
+11 SET ^UTILITY("AMQQ",$JOB,"WEIGHT",X,AMQQUATN)=$PIECE(%,":",2)
+12 QUIT
+13 ;
FILTERD SET X(3)=0
+1 SET X(4)=99999999
+2 SET X(5)=.0000001
+3 DO ANAL
+4 QUIT
+5 ;
FILTERB SET X(3)=-1
+1 SET X(4)=1.01
+2 SET X(5)=.000001
+3 DO ANAL
+4 QUIT
+5 ;
FILTERN SET X(3)=-9999999
+1 SET X(4)=9999999
+2 SET X(5)=.000001
+3 DO ANAL
+4 QUIT
+5 ;
FILTERY SET AMQQF(1)=X(1)
+1 SET AMQQF(2)=X(2)
+2 SET AMQQF(3)=$PIECE($PIECE(Q,U,9),";",3)
+3 SET AMQQF(4)=$PIECE($PIECE(Q,U,9),";",4)
+4 QUIT
+5 ;
FILTERC SET AMQQF(1)=X(1)
+1 SET AMQQF(2)=X(2)
+2 QUIT
+3 ;
FILTERG ;;
FILTERL ; I $D(AMQQURGN),$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"--")) S $P(Q,U,18)=3 Q
+1 FOR %=1,2
SET AMQQF(%)=$PIECE(AMQQCOMP,";",4)
+2 QUIT
+3 ;
FILTERS SET AMQQF(1)=AMQQSYMB
+1 IF AMQQCOMP=";;;EXISTS"
SET AMQQF(2)=""
SET AMQQF(3)="~~~~"
QUIT
+2 SET %=$EXTRACT(AMQQCOMP,$LENGTH(AMQQCOMP))
+3 SET %=$ASCII(%)
+4 SET %=$CHAR(%-1)_"~~~~~"
+5 SET AMQQF(2)=$EXTRACT(AMQQCOMP,1,$LENGTH(AMQQCOMP)-1)_%
+6 SET AMQQF(3)=AMQQCOMP
+7 QUIT
+8 ;
FILTERF IF AMQQSYMB'="-"
SET AMQQF(1)=AMQQSYMB
SET AMQQF(2)=AMQQCOMP
SET AMQQF(3)=""
QUIT
+1 SET AMQQF(1)="-"
+2 SET AMQQF(3)=$PIECE(AMQQCOMP,";",2)
SET %=$PIECE(AMQQCOMP,";")
+3 SET X=$EXTRACT(%,$LENGTH(%))
+4 SET %=$EXTRACT(%,1,$LENGTH(%)-1)
+5 SET X=$CHAR($ASCII(X)-1)
+6 SET %=%_X_"~~~~~"
+7 SET AMQQF(2)=%
+8 QUIT
+9 ;
FILTERA SET %DT=""
+1 SET X="T+1"
+2 DO ^%DT
+3 SET X(3)=Y
+4 SET %=AMQQSYMB
+5 IF %="'<"
SET X(1)=X(1)-1
SET %=">"
GOTO FAG
+6 IF %="'>"
SET X(1)=X(1)+1
SET %="<"
GOTO FAL
FAG IF %=">"
SET AMQQF(1)=0
SET AMQQF(2)=X(3)-((X(1)+1)*10000)
SET %="><"
GOTO FSET
FAL IF %="<"
SET AMQQF(2)=99999999
SET AMQQF(1)=DT-(X(1)*10000)
SET %="><"
GOTO FSET
+1 IF %="="
SET AMQQF(1)=DT-((X(1)+1)*10000)
SET AMQQF(2)=X(3)-(X(1)*10000)
SET %="><"
GOTO FSET
+2 IF %="'="
IF AMQQCOMP["EXIST"
SET AMQQF(1)=0
SET AMQQF(2)=9999999
GOTO FSET
+3 IF %="'="
SET AMQQF(1)=DT-(X(1)*10000)
SET AMQQF(2)=X(3)-((X(1)+1)*10000)
SET %="'><"
GOTO FSET
+4 IF %="><"
IF '+AMQQCOMP
SET AMQQCOMP=$PIECE(AMQQCOMP,";",2)+1
SET %="<"
SET $PIECE(Q,U,9)=AMQQCOMP
SET X(1)=X(2)+1
GOTO FAL
+5 IF %="><"
SET AMQQF(1)=DT-((X(2)+1)*10000)
SET AMQQF(2)=X(3)-(X(1)*10000)
GOTO FSET
+6 SET AMQQF(1)=DT-(X(1)*10000)
+7 SET AMQQF(2)=(X(3)-(X(2)*10000))-10000
FSET SET $PIECE(Q,U,8)=%
+1 SET AMQQSYMB=%
+2 QUIT
+3 ;
ANAL IF AMQQSYMB=">"
SET AMQQF(1)=X(1)
SET AMQQF(2)=X(4)
QUIT
+1 IF AMQQSYMB="<"
SET AMQQF(1)=X(3)
SET AMQQF(2)=X(1)
QUIT
+2 IF AMQQSYMB="="
IF AMQQFTYP="D"
IF X(1)=X(2)
IF X(1)=X(1)\1
SET AMQQF(2)=X(1)+.99
SET AMQQF(1)=X(1)-.76
QUIT
+3 IF AMQQSYMB="="
SET AMQQF(1)=X(1)-X(5)
SET AMQQF(2)=X(1)+X(5)
QUIT
+4 IF AMQQSYMB="><"
SET AMQQF(1)=X(1)-X(5)
SET AMQQF(2)=X(2)+X(5)
QUIT
+5 IF AMQQSYMB="'>"
SET AMQQF(1)=X(3)
SET AMQQF(2)=X(1)+X(5)
QUIT
+6 IF AMQQSYMB="'<"
SET AMQQF(1)=X(1)-X(5)
SET AMQQF(2)=X(4)
QUIT
+7 IF AMQQSYMB="'="
SET AMQQF(1)=X(1)
SET AMQQF(2)=X(1)
QUIT
+8 SET AMQQF(1)=X(2)
+9 SET AMQQF(2)=X(1)
+10 QUIT
+11 ;
DOC SET X="LINK^ATTRIBUTE NAME^F TYPE^CONTEXT SWITCH^CONDITION^NUMBER OF CONDITIONS^CONDITION NAME^SYMBOL^COMPARISON VALUE^VALIDITY CODE LOCATION^SEARCH EFFICIENCY RATING^OR TEXT^INDEXED^NUMBER OF VARIABLES^FILTERS^NOT"
+1 WRITE !!
+2 FOR I=1:1:16
WRITE !,I,") ",$PIECE(X,U,I)
+3 QUIT
+4 ;
