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