AMQQATS1 ; IHS/CMI/THL - SETS MULTIPLES ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
MULT S %=$P(Q,U,9)
I $P(%,";",6) S %=$P(%,";",1,5),AMQQSQNL="" S:$P(%,";",5)="" %=$P(%,";",1,4) S $P(Q,U,9)=%,AMQQQ=Q
I $P(Q,U,3)="E"!($P(Q,U,3)="V") D BP Q
F I=1,2,3,6,7 S AMQQF(I)=$P(%,";",I)
I $P(Q,U,3)="I" S AMQQF(4)=$P(%,";",4),AMQQF(5)="" S:$P(%,";",5)="ANY" AMQQF(5)="ANY",AMQQF(4)=AMQQF(4)_"~~ANY" G MY ; &&& FIXES IMMUNIZATION ANY BUG
I $P(Q,U,3)="F" S AMQQF(4)="'[",AMQQF(5)="```" D:$P(%,";",4)[":" TEXT G MY
I $P(Q,U,3)="S" S AMQQF(4)=$P($P(%,";",4),":"),AMQQF(5)=$P($P(%,";",4),":",2) G MY
I "QZ"'[$P(Q,U,3) S X=$P(%,":",2) I X'="",X'=+X D TEXT G MY
I $P(Q,U,16)>1,AMQQF(2)>9990000 S AMQQF(2)=AMQQF(1)+.0000001,AMQQF(1)=0 G MX
I $P(Q,U,16)>1,AMQQF(1)<1 S AMQQF(1)=AMQQF(2)-.0000001,AMQQF(2)=9999999
I AMQQF(1)>0,AMQQF(2)<9990000 S:AMQQF(1)=AMQQF(2) AMQQF(2)=AMQQF(2)+.2359 S AMQQF(1)=AMQQF(1)-.76
MX I $P(Q,U,3)="Z" D ZERO G MY
I $P(Q,U,3)="Q" D QUAL G MY
I $P(Q,U,17) S %=$P(Q,U,9) F I=1:1:5 S:'$D(AMQQF(I)) AMQQF(I)=$P(%,";",I) I I=5 G MY
MZ D RANGE
S AMQQF(4)=$P(X,":")
S AMQQF(5)=$P(X,":",2)
MY S %="0^9999999^9999999^-999999999^999999999^"_AMQQUATN_U_$D(AMQQMULT)
F I=1:1:7 I AMQQF(I)="" S AMQQF(I)=$P(%,U,I)
I $D(AMQQSQNL)!($D(^UTILITY("AMQQ",$J,"SQ",+$G(AMQQUSQN),"NULL"))&$D(AMQQFSQN))!$D(AMQQFSQX) K AMQQFSQX,AMQQSQNL,AMQQFSQN S %=$P(Q,U,9),$P(%,";",6)="NULL",$P(Q,U,9)=%
Q
;
ZERO S X=$P(%,";",4)
I $P(X,":",4)'="",$P(Q,U,8)="'" S Y=$P(X,":",2) D ZTR S AMQQF(5)=Y S Y=$P(X,":",4) D ZTR S AMQQF(4)=Y Q
I $P(X,":",4)'="" S Y=$P(X,":",2) D ZTR S Y=Y-.1,AMQQF(4)=Y S Y=$P(X,":",4) D ZTR S AMQQF(5)=Y Q
S Y=$P(X,":",2)
D ZTR
S X=$P(X,":")
I X=">" S AMQQF(4)=Y+.01,AMQQF(5)=9 Q
I X="<" S AMQQF(4)=-1,AMQQF(5)=Y-.01 Q
I X="=" S AMQQF(4)=Y,AMQQF(5)=Y Q
I X="'>" S AMQQF(4)=-1,AMQQF(5)=Y Q
I X="'<" S AMQQF(4)=Y,AMQQF(5)=9 Q
I X="'=" S AMQQF(4)=Y+.01,AMQQF(5)=Y-.01 Q
S AMQQF(4)=-1
S AMQQF(5)=5
Q
;
ZTR S Y=$E(Y)
S Y=$S(Y="N":0,Y="T":1,1:(Y+1))
Q
;
QUAL I %="" S AMQQF(4)=-1,AMQQF(5)=2 Q
S X=$P(%,";",4)
I X="=:POS"!(X="'=:NEG") S AMQQF(4)=1,AMQQF(5)=1 Q
I X="=:NEG"!(X="'=:POS") S AMQQF(4)=0,AMQQF(5)=0 Q
S AMQQF(4)=""
S AMQQF(5)=""
Q
;
RANGE S %=$P(AMQQCOMP,";",4)
S Y=$P(%,":")
S Z=$P(%,":",2)
S N=.00000001
I $P(%,":",4),$P(Q,U,16) S X=$P(%,":",4)_":"_Z Q
I $L(Y)=1,"[]?="[Y S X=Y_":"_Z I Z'=+Z S X="=:"_Z
I Y="=" S X=Z_":"_Z Q
I Y="'=" S X=(Z+N)_":"_(Z-N) Q
I $P(%,":",4) S X=(Z-N)_":"_($P(%,":",4)+.00000001) Q
S X=-999999999
I Y="<" S X=X_":"_(Z-N) Q
I Y="'>" S X=X_":"_Z Q
S X=999999999
I Y=">" S X=Z_":"_X Q
S X=(Z-N)_":"_X
Q
;
TEXT S Y=$P(%,";",4)
S AMQQF(4)=$P(Y,":",1)_":"_$P(Y,":",3)
S AMQQF(5)=$P(Y,":",2)_":"_$P(Y,":",4)
Q
;
BP N AMQQCOMP
I %'["~" S (AMQQCOMP,AMQQCOM2)=">:0",AMQQBOOL="!",AMQQCOMP=%_";>:0;>:0"
E S AMQQCOMP=$P(%,"~"),AMQQCOM2=$P(%,"~",2),AMQQBOOL=$P(%,"~",3)
S AMQQF(6)=$S($D(AMQQ("BP COHORT FLG")):"",1:2)
F I=1:1:5,7 S AMQQF(I)=$P(AMQQCOMP,";",I)
D MZ
S AMQQF=""
F I=1:1:7 S AMQQF=AMQQF_AMQQF(I)_U
S AMQQF=AMQQF_AMQQBOOL
S AMQQCOMP=";;;"_AMQQCOM2
D MZ
S AMQQF=AMQQF_U_AMQQF(4)_U_AMQQF(5)
F I=1:1:10 S AMQQF(I)=$P(AMQQF,U,I)
K AMQQBOOL,AMQQCOM2
Q
;
AMQQATS1 ; IHS/CMI/THL - SETS MULTIPLES ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
MULT SET %=$PIECE(Q,U,9)
+1 IF $PIECE(%,";",6)
SET %=$PIECE(%,";",1,5)
SET AMQQSQNL=""
IF $PIECE(%,";",5)=""
SET %=$PIECE(%,";",1,4)
SET $PIECE(Q,U,9)=%
SET AMQQQ=Q
+2 IF $PIECE(Q,U,3)="E"!($PIECE(Q,U,3)="V")
DO BP
QUIT
+3 FOR I=1,2,3,6,7
SET AMQQF(I)=$PIECE(%,";",I)
+4 ; &&& FIXES IMMUNIZATION ANY BUG
IF $PIECE(Q,U,3)="I"
SET AMQQF(4)=$PIECE(%,";",4)
SET AMQQF(5)=""
IF $PIECE(%,";",5)="ANY"
SET AMQQF(5)="ANY"
SET AMQQF(4)=AMQQF(4)_"~~ANY"
GOTO MY
+5 IF $PIECE(Q,U,3)="F"
SET AMQQF(4)="'["
SET AMQQF(5)="```"
IF $PIECE(%,";",4)["
DO TEXT
GOTO MY
+6 IF $PIECE(Q,U,3)="S"
SET AMQQF(4)=$PIECE($PIECE(%,";",4),":")
SET AMQQF(5)=$PIECE($PIECE(%,";",4),":",2)
GOTO MY
+7 IF "QZ"'[$PIECE(Q,U,3)
SET X=$PIECE(%,":",2)
IF X'=""
IF X'=+X
DO TEXT
GOTO MY
+8 IF $PIECE(Q,U,16)>1
IF AMQQF(2)>9990000
SET AMQQF(2)=AMQQF(1)+.0000001
SET AMQQF(1)=0
GOTO MX
+9 IF $PIECE(Q,U,16)>1
IF AMQQF(1)<1
SET AMQQF(1)=AMQQF(2)-.0000001
SET AMQQF(2)=9999999
+10 IF AMQQF(1)>0
IF AMQQF(2)<9990000
IF AMQQF(1)=AMQQF(2)
SET AMQQF(2)=AMQQF(2)+.2359
SET AMQQF(1)=AMQQF(1)-.76
MX IF $PIECE(Q,U,3)="Z"
DO ZERO
GOTO MY
+1 IF $PIECE(Q,U,3)="Q"
DO QUAL
GOTO MY
+2 IF $PIECE(Q,U,17)
SET %=$PIECE(Q,U,9)
FOR I=1:1:5
IF '$DATA(AMQQF(I))
SET AMQQF(I)=$PIECE(%,";",I)
IF I=5
GOTO MY
MZ DO RANGE
+1 SET AMQQF(4)=$PIECE(X,":")
+2 SET AMQQF(5)=$PIECE(X,":",2)
MY SET %="0^9999999^9999999^-999999999^999999999^"_AMQQUATN_U_$DATA(AMQQMULT)
+1 FOR I=1:1:7
IF AMQQF(I)=""
SET AMQQF(I)=$PIECE(%,U,I)
+2 IF $DATA(AMQQSQNL)!($DATA(^UTILITY("AMQQ",$JOB,"SQ",+$GET(AMQQUSQN),"NULL"))&$DATA(AMQQFSQN))!$DATA(AMQQFSQX)
KILL AMQQFSQX,AMQQSQNL,AMQQFSQN
SET %=$PIECE(Q,U,9)
SET $PIECE(%,";",6)="NULL"
SET $PIECE(Q,U,9)=%
+3 QUIT
+4 ;
ZERO SET X=$PIECE(%,";",4)
+1 IF $PIECE(X,":",4)'=""
IF $PIECE(Q,U,8)="'"
SET Y=$PIECE(X,":",2)
DO ZTR
SET AMQQF(5)=Y
SET Y=$PIECE(X,":",4)
DO ZTR
SET AMQQF(4)=Y
QUIT
+2 IF $PIECE(X,":",4)'=""
SET Y=$PIECE(X,":",2)
DO ZTR
SET Y=Y-.1
SET AMQQF(4)=Y
SET Y=$PIECE(X,":",4)
DO ZTR
SET AMQQF(5)=Y
QUIT
+3 SET Y=$PIECE(X,":",2)
+4 DO ZTR
+5 SET X=$PIECE(X,":")
+6 IF X=">"
SET AMQQF(4)=Y+.01
SET AMQQF(5)=9
QUIT
+7 IF X="<"
SET AMQQF(4)=-1
SET AMQQF(5)=Y-.01
QUIT
+8 IF X="="
SET AMQQF(4)=Y
SET AMQQF(5)=Y
QUIT
+9 IF X="'>"
SET AMQQF(4)=-1
SET AMQQF(5)=Y
QUIT
+10 IF X="'<"
SET AMQQF(4)=Y
SET AMQQF(5)=9
QUIT
+11 IF X="'="
SET AMQQF(4)=Y+.01
SET AMQQF(5)=Y-.01
QUIT
+12 SET AMQQF(4)=-1
+13 SET AMQQF(5)=5
+14 QUIT
+15 ;
ZTR SET Y=$EXTRACT(Y)
+1 SET Y=$SELECT(Y="N":0,Y="T":1,1:(Y+1))
+2 QUIT
+3 ;
QUAL IF %=""
SET AMQQF(4)=-1
SET AMQQF(5)=2
QUIT
+1 SET X=$PIECE(%,";",4)
+2 IF X="=:POS"!(X="'=:NEG")
SET AMQQF(4)=1
SET AMQQF(5)=1
QUIT
+3 IF X="=:NEG"!(X="'=:POS")
SET AMQQF(4)=0
SET AMQQF(5)=0
QUIT
+4 SET AMQQF(4)=""
+5 SET AMQQF(5)=""
+6 QUIT
+7 ;
RANGE SET %=$PIECE(AMQQCOMP,";",4)
+1 SET Y=$PIECE(%,":")
+2 SET Z=$PIECE(%,":",2)
+3 SET N=.00000001
+4 IF $PIECE(%,":",4)
IF $PIECE(Q,U,16)
SET X=$PIECE(%,":",4)_":"_Z
QUIT
+5 IF $LENGTH(Y)=1
IF "[]?="[Y
SET X=Y_":"_Z
IF Z'=+Z
SET X="=:"_Z
+6 IF Y="="
SET X=Z_":"_Z
QUIT
+7 IF Y="'="
SET X=(Z+N)_":"_(Z-N)
QUIT
+8 IF $PIECE(%,":",4)
SET X=(Z-N)_":"_($PIECE(%,":",4)+.00000001)
QUIT
+9 SET X=-999999999
+10 IF Y="<"
SET X=X_":"_(Z-N)
QUIT
+11 IF Y="'>"
SET X=X_":"_Z
QUIT
+12 SET X=999999999
+13 IF Y=">"
SET X=Z_":"_X
QUIT
+14 SET X=(Z-N)_":"_X
+15 QUIT
+16 ;
TEXT SET Y=$PIECE(%,";",4)
+1 SET AMQQF(4)=$PIECE(Y,":",1)_":"_$PIECE(Y,":",3)
+2 SET AMQQF(5)=$PIECE(Y,":",2)_":"_$PIECE(Y,":",4)
+3 QUIT
+4 ;
BP NEW AMQQCOMP
+1 IF %'["~"
SET (AMQQCOMP,AMQQCOM2)=">:0"
SET AMQQBOOL="!"
SET AMQQCOMP=%_";>:0;>:0"
+2 IF '$TEST
SET AMQQCOMP=$PIECE(%,"~")
SET AMQQCOM2=$PIECE(%,"~",2)
SET AMQQBOOL=$PIECE(%,"~",3)
+3 SET AMQQF(6)=$SELECT($DATA(AMQQ("BP COHORT FLG")):"",1:2)
+4 FOR I=1:1:5,7
SET AMQQF(I)=$PIECE(AMQQCOMP,";",I)
+5 DO MZ
+6 SET AMQQF=""
+7 FOR I=1:1:7
SET AMQQF=AMQQF_AMQQF(I)_U
+8 SET AMQQF=AMQQF_AMQQBOOL
+9 SET AMQQCOMP=";;;"_AMQQCOM2
+10 DO MZ
+11 SET AMQQF=AMQQF_U_AMQQF(4)_U_AMQQF(5)
+12 FOR I=1:1:10
SET AMQQF(I)=$PIECE(AMQQF,U,I)
+13 KILL AMQQBOOL,AMQQCOM2
+14 QUIT
+15 ;
