AMQQAV1 ; IHS/CMI/THL - GETS OVERFLOW FROM AMQQAV ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
COMPF ; ENTRY POINT FROM AMQQAV
I AMQQNOCO>1 G COMPF2
I $D(AMQQXX) G COMPF1
W !,?(5*$D(AMQQZNM)),$S(AMQQATN'=699:"What: ",1:"Which month(S): ")
R X:DTIME E S X=U
I X=U S AMQQQUIT="" Q
I X="" Q
I X["^"!(X[":") W " <- Can't use ""^"" or"":""",*7,!! K AMQQCOMP G COMPF
I X?1."?",AMQQSYMB="?" W !!,"Enter the MUMPS pattern match code (e.g. '2N.E')",!! G COMPF
I X?1."?" W !!,"Enter the comparison text or value.",!! G COMPF
COMPF1 I X="@" S X=""
I $G(AMQQCOND)=82 D PATCK I '$D(X) W " ??",*7 G COMPF
I X["""" D QUOTES
I AMQQATN=699,X["-"!X D BIRMON
S AMQQCOMP=X
Q
;
COMPF2 I $D(AMQQXX) N Z S Z=X,X=$P(X,";") G COMPF21
R !,?(5*$D(AMQQZNM)),"Start with: ",X:DTIME E S AMQQQUIT="" Q
COMPF21 I X?1."?" D COMPFH2 G COMPF2
I X=U S AMQQQUIT="" Q
I X="" S X=" "
I X["^"!(X[":") W " <- Can't use ""^"" or"":""",*7,!! K AMQQCOMP G COMPF2
S AMQQCOMP=X
I $D(AMQQXX) S X=$P(Z,";",2) G F21
F2 R !,?(5*$D(AMQQZNM)),"End with: ",X:DTIME E S AMQQQUIT="" Q
F21 I X?1."?" D COMPFH2 G F2
I X=U S AMQQQUIT="" K AMQQCOMP Q
I X="" S X="|||||"
I (X_AMQQCOMP)["^"!((X_AMQQCOMP)[";") W !!,"Your answer must not contain a ""^"" or "";"" ... Try again",*7,!! K AMQQCOMP G COMPF2
S AMQQCOMP=AMQQCOMP_";"_X
Q
;
COMPFH2 W !!,"Enter a letter at the beginning and end of the range",!!
Q
;
COMPZ ; ENTRY POINT FROM AMQQAV
I AMQQNOCO>1 G COMPZ2
I $D(AMQQXX) G COMPZ1
W !,?(5*$D(AMQQZNM)),"Enter the value (NEG -> 4+): "
R X:DTIME E S X=U
I X=U S AMQQQUIT="" Q
I X="" Q
I X[U!X[";" W " ??",*7 G COMPZ
I X?1."?" W !!,"Choose from ""NEGATIVE"", ""TRACE"", 1+, 2+, 3+ or 4+",! G COMPZ
COMPZ1 S %=U_X
S Y="^NEGATIVE;NEGATIVE^TRACE;TRACE^1+;1+^2+;2+^3+;3+^4+;4+"
S Z=$F(Y,%)
I 'Z Q:$D(AMQQXX) W " ??",*7 G COMPZ
S %=$E(Y,Z,99)
S X=$P(%,";")
S Y=$P(%,";",2)
S Y=$P(Y,U)
W:'$D(AMQQXX) X
S AMQQCOMP=Y
Q
;
COMPZ2 W !,?(5*$D(AMQQZNM)),"Enter the first value (0 -> 4+): NEGATIVE// "
R X:DTIME E S X=U
I X=U S AMQQQUIT="" Q
I X="" S AMQQCOMP="NEGATIVE" W " (NEGATIVE)" G Z2
I X[U!X[";" W " ??",*7 G COMPZ2
I X?1."?" W !!,"Choose from ""NEGATIVE"", ""TRACE"", 1+, 2+, 3+ or 4+",! G COMPZ2
S %=U_X
S Y="^NEGATIVE;NEGATIVE^TRACE;TRACE^1+;1+^2+;2+^3+;3+^4+;4+"
S Z=$F(Y,%)
I 'Z W " ??",*7 G COMPZ2
S %=$E(Y,Z,99)
S X=$P(%,";")
S Y=$P(%,";",2)
S Y=$P(Y,U)
W X
S AMQQCOMP=Y
I $D(AMQQXX) S X=$P(Z,";",2) G Z21
Z2 W !,?(5*$D(AMQQZNM)),"Enter the second value (0 -> 4+): 4+// "
R X:DTIME E S X=U
Z21 I X=U S AMQQQUIT="" Q
I X="" S X="4+" S AMQQCOMP=AMQQCOMP_";"_X Q
I X[U!X[";" W " ??",*7 G Z2
I X?1."?" W !!,"Choose from ""NEGATIVE"", ""TRACE"", 1+, 2+, 3+ or 4+",! G Z2
S %=U_X
S Y="^NEGATIVE;NEGATIVE^TRACE;TRACE^1+;1+^2+;2+^3+;3+^4+;4+"
S Z=$F(Y,%)
I 'Z W " ??",*7 G Z2
S %=$E(Y,Z,99)
S X=$P(%,";")
S Y=$P(%,";",2)
S Y=$P(Y,U)
W X
S %="NEGATIVETRACE1+2+3+4+"
I $F(%,AMQQCOMP)>$F(%,Y) W " ??",*7 G Z2
S AMQQCOMP=AMQQCOMP_";"_Y
Q
;
COMPQ ; ENTRY POINT FROM AMQQAV
I $D(AMQQXX) G COMPQ1
R !,?(5*$D(AMQQZNM)),"Result (""POS"" or ""NEG""): POS// ",X:DTIME E S X=U
I X=U S AMQQQUIT="" Q
I X="" S X="POS" W " POS"
I X?1."?" W !!,"Enter ""POSITIVE"" or ""NEGATIVE""",! G COMPQ
COMPQ1 I "PN"'[$E(X) Q:$D(AMQQXX) W " ??",*7 G COMPQ
I $E(X)="P" W $E("POSITIVE",1+$L(X),99)
I $E(X)="N" W $E("NEGATIVE",1+$L(X),99)
S X=$E(X)
S AMQQCOMP=$S(X="P":"POS",1:"NEG")
Q
;
QUOTES F Q:X'["""" S X=$P(X,"""")_"@#$"_$P(X,"""",2,99)
F Q:X'["@#$" S X=$P(X,"@#$")_""""_""""_$P(X,"@#$",2,99)
Q
;
PATCK S AMQQPCK=X,X="I X?"_AMQQPCK
D ^DIM
I '$D(X) Q
S X=AMQQPCK K AMQQPCK
Q
;
BIRMON ;EP;TO INTERPRET BIRTH MONTH;
N Y,X1,X2,X3
S X=$TR(X," ","-")
S X1=$P(X,"-")
S X2=$P(X,"-",2)
I X2="",X1 S X2=X1
I 'X1 S X1=$S(X1["JAN":1,X1["FEB":2,X1["MAR":3,X1["APR":4,X1["MAY":5,X1["JUN":6,X1["JUL":7,X1["AUG":8,X1["SEP":9,X1["OCT":10,X1["NOV":11,X1["DEC":12,1:"")
I 'X2 S X2=$S(X2["JAN":1,X2["FEB":2,X2["MAR":3,X2["APR":4,X2["MAY":5,X2["JUN":6,X2["JUL":7,X2["AUG":8,X2["SEP":9,X2["OCT":10,X2["NOV":11,X2["DEC":12,1:"")
F X3=X1:1:X2 S X1(X3)=$S(X3=1:"JAN",X3=2:"FEB",X3=3:"MAR",X3=4:"APR",X3=5:"MAY",X3=6:"JUN",X3=7:"JUL",X3=8:"AUG",X3=9:"SEP",X3=10:"OCT",X3=11:"NOV",X3=12:"DEC",1:"")
S X=""
S Y=0
F S Y=$O(X1(Y)) Q:'Y S X=X_X1(Y)_" "
Q
;-----
BM(X,VAL) ;EP;
S X=$S(X=1:"JAN",X=2:"FEB",X=3:"MAR",X=4:"APR",X=5:"MAY",X=6:"JUN",X=7:"JUL",X=8:"AUG",X=9:"SEP",X=10:"OCT",X=11:"NOV",1:"DEC")
I VAL[X S VAL=1
E S VAL=0
Q VAL
;-----
AMQQAV1 ; IHS/CMI/THL - GETS OVERFLOW FROM AMQQAV ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
COMPF ; ENTRY POINT FROM AMQQAV
+1 IF AMQQNOCO>1
GOTO COMPF2
+2 IF $DATA(AMQQXX)
GOTO COMPF1
+3 WRITE !,?(5*$DATA(AMQQZNM)),$SELECT(AMQQATN'=699:"What: ",1:"Which month(S): ")
+4 READ X:DTIME
IF '$TEST
SET X=U
+5 IF X=U
SET AMQQQUIT=""
QUIT
+6 IF X=""
QUIT
+7 IF X["^"!(X[":")
WRITE " <- Can't use ""^"" or"":""",*7,!!
KILL AMQQCOMP
GOTO COMPF
+8 IF X?1."?"
IF AMQQSYMB="?"
WRITE !!,"Enter the MUMPS pattern match code (e.g. '2N.E')",!!
GOTO COMPF
+9 IF X?1."?"
WRITE !!,"Enter the comparison text or value.",!!
GOTO COMPF
COMPF1 IF X="@"
SET X=""
+1 IF $GET(AMQQCOND)=82
DO PATCK
IF '$DATA(X)
WRITE " ??",*7
GOTO COMPF
+2 IF X[""""
DO QUOTES
+3 IF AMQQATN=699
IF X["-"!X
DO BIRMON
+4 SET AMQQCOMP=X
+5 QUIT
+6 ;
COMPF2 IF $DATA(AMQQXX)
NEW Z
SET Z=X
SET X=$PIECE(X,";")
GOTO COMPF21
+1 READ !,?(5*$DATA(AMQQZNM)),"Start with: ",X:DTIME
IF '$TEST
SET AMQQQUIT=""
QUIT
COMPF21 IF X?1."?"
DO COMPFH2
GOTO COMPF2
+1 IF X=U
SET AMQQQUIT=""
QUIT
+2 IF X=""
SET X=" "
+3 IF X["^"!(X[":")
WRITE " <- Can't use ""^"" or"":""",*7,!!
KILL AMQQCOMP
GOTO COMPF2
+4 SET AMQQCOMP=X
+5 IF $DATA(AMQQXX)
SET X=$PIECE(Z,";",2)
GOTO F21
F2 READ !,?(5*$DATA(AMQQZNM)),"End with: ",X:DTIME
IF '$TEST
SET AMQQQUIT=""
QUIT
F21 IF X?1."?"
DO COMPFH2
GOTO F2
+1 IF X=U
SET AMQQQUIT=""
KILL AMQQCOMP
QUIT
+2 IF X=""
SET X="|||||"
+3 IF (X_AMQQCOMP)["^"!((X_AMQQCOMP)[";")
WRITE !!,"Your answer must not contain a ""^"" or "";"" ... Try again",*7,!!
KILL AMQQCOMP
GOTO COMPF2
+4 SET AMQQCOMP=AMQQCOMP_";"_X
+5 QUIT
+6 ;
COMPFH2 WRITE !!,"Enter a letter at the beginning and end of the range",!!
+1 QUIT
+2 ;
COMPZ ; ENTRY POINT FROM AMQQAV
+1 IF AMQQNOCO>1
GOTO COMPZ2
+2 IF $DATA(AMQQXX)
GOTO COMPZ1
+3 WRITE !,?(5*$DATA(AMQQZNM)),"Enter the value (NEG -> 4+): "
+4 READ X:DTIME
IF '$TEST
SET X=U
+5 IF X=U
SET AMQQQUIT=""
QUIT
+6 IF X=""
QUIT
+7 IF X[U!X[";"
WRITE " ??",*7
GOTO COMPZ
+8 IF X?1."?"
WRITE !!,"Choose from ""NEGATIVE"", ""TRACE"", 1+, 2+, 3+ or 4+",!
GOTO COMPZ
COMPZ1 SET %=U_X
+1 SET Y="^NEGATIVE;NEGATIVE^TRACE;TRACE^1+;1+^2+;2+^3+;3+^4+;4+"
+2 SET Z=$FIND(Y,%)
+3 IF 'Z
IF $DATA(AMQQXX)
QUIT
WRITE " ??",*7
GOTO COMPZ
+4 SET %=$EXTRACT(Y,Z,99)
+5 SET X=$PIECE(%,";")
+6 SET Y=$PIECE(%,";",2)
+7 SET Y=$PIECE(Y,U)
+8 IF '$DATA(AMQQXX)
WRITE X
+9 SET AMQQCOMP=Y
+10 QUIT
+11 ;
COMPZ2 WRITE !,?(5*$DATA(AMQQZNM)),"Enter the first value (0 -> 4+): NEGATIVE// "
+1 READ X:DTIME
IF '$TEST
SET X=U
+2 IF X=U
SET AMQQQUIT=""
QUIT
+3 IF X=""
SET AMQQCOMP="NEGATIVE"
WRITE " (NEGATIVE)"
GOTO Z2
+4 IF X[U!X[";"
WRITE " ??",*7
GOTO COMPZ2
+5 IF X?1."?"
WRITE !!,"Choose from ""NEGATIVE"", ""TRACE"", 1+, 2+, 3+ or 4+",!
GOTO COMPZ2
+6 SET %=U_X
+7 SET Y="^NEGATIVE;NEGATIVE^TRACE;TRACE^1+;1+^2+;2+^3+;3+^4+;4+"
+8 SET Z=$FIND(Y,%)
+9 IF 'Z
WRITE " ??",*7
GOTO COMPZ2
+10 SET %=$EXTRACT(Y,Z,99)
+11 SET X=$PIECE(%,";")
+12 SET Y=$PIECE(%,";",2)
+13 SET Y=$PIECE(Y,U)
+14 WRITE X
+15 SET AMQQCOMP=Y
+16 IF $DATA(AMQQXX)
SET X=$PIECE(Z,";",2)
GOTO Z21
Z2 WRITE !,?(5*$DATA(AMQQZNM)),"Enter the second value (0 -> 4+): 4+// "
+1 READ X:DTIME
IF '$TEST
SET X=U
Z21 IF X=U
SET AMQQQUIT=""
QUIT
+1 IF X=""
SET X="4+"
SET AMQQCOMP=AMQQCOMP_";"_X
QUIT
+2 IF X[U!X[";"
WRITE " ??",*7
GOTO Z2
+3 IF X?1."?"
WRITE !!,"Choose from ""NEGATIVE"", ""TRACE"", 1+, 2+, 3+ or 4+",!
GOTO Z2
+4 SET %=U_X
+5 SET Y="^NEGATIVE;NEGATIVE^TRACE;TRACE^1+;1+^2+;2+^3+;3+^4+;4+"
+6 SET Z=$FIND(Y,%)
+7 IF 'Z
WRITE " ??",*7
GOTO Z2
+8 SET %=$EXTRACT(Y,Z,99)
+9 SET X=$PIECE(%,";")
+10 SET Y=$PIECE(%,";",2)
+11 SET Y=$PIECE(Y,U)
+12 WRITE X
+13 SET %="NEGATIVETRACE1+2+3+4+"
+14 IF $FIND(%,AMQQCOMP)>$FIND(%,Y)
WRITE " ??",*7
GOTO Z2
+15 SET AMQQCOMP=AMQQCOMP_";"_Y
+16 QUIT
+17 ;
COMPQ ; ENTRY POINT FROM AMQQAV
+1 IF $DATA(AMQQXX)
GOTO COMPQ1
+2 READ !,?(5*$DATA(AMQQZNM)),"Result (""POS"" or ""NEG""): POS// ",X:DTIME
IF '$TEST
SET X=U
+3 IF X=U
SET AMQQQUIT=""
QUIT
+4 IF X=""
SET X="POS"
WRITE " POS"
+5 IF X?1."?"
WRITE !!,"Enter ""POSITIVE"" or ""NEGATIVE""",!
GOTO COMPQ
COMPQ1 IF "PN"'[$EXTRACT(X)
IF $DATA(AMQQXX)
QUIT
WRITE " ??",*7
GOTO COMPQ
+1 IF $EXTRACT(X)="P"
WRITE $EXTRACT("POSITIVE",1+$LENGTH(X),99)
+2 IF $EXTRACT(X)="N"
WRITE $EXTRACT("NEGATIVE",1+$LENGTH(X),99)
+3 SET X=$EXTRACT(X)
+4 SET AMQQCOMP=$SELECT(X="P":"POS",1:"NEG")
+5 QUIT
+6 ;
QUOTES FOR
IF X'[""""
QUIT
SET X=$PIECE(X,"""")_"@#$"_$PIECE(X,"""",2,99)
+1 FOR
IF X'["@#$"
QUIT
SET X=$PIECE(X,"@#$")_""""_""""_$PIECE(X,"@#$",2,99)
+2 QUIT
+3 ;
PATCK SET AMQQPCK=X
SET X="I X?"_AMQQPCK
+1 DO ^DIM
+2 IF '$DATA(X)
QUIT
+3 SET X=AMQQPCK
KILL AMQQPCK
+4 QUIT
+5 ;
BIRMON ;EP;TO INTERPRET BIRTH MONTH;
+1 NEW Y,X1,X2,X3
+2 SET X=$TRANSLATE(X," ","-")
+3 SET X1=$PIECE(X,"-")
+4 SET X2=$PIECE(X,"-",2)
+5 IF X2=""
IF X1
SET X2=X1
+6 IF 'X1
SET X1=$SELECT(X1["JAN":1,X1["FEB":2,X1["MAR":3,X1["APR":4,X1["MAY":5,X1["JUN":6,X1["JUL":7,X1["AUG":8,X1["SEP":9,X1["OCT":10,X1["NOV":11,X1["DEC":12,1:"")
+7 IF 'X2
SET X2=$SELECT(X2["JAN":1,X2["FEB":2,X2["MAR":3,X2["APR":4,X2["MAY":5,X2["JUN":6,X2["JUL":7,X2["AUG":8,X2["SEP":9,X2["OCT":10,X2["NOV":11,X2["DEC":12,1:"")
+8 FOR X3=X1:1:X2
SET X1(X3)=$SELECT(X3=1:"JAN",X3=2:"FEB",X3=3:"MAR",X3=4:"APR",X3=5:"MAY",X3=6:"JUN",X3=7:"JUL",X3=8:"AUG",X3=9:"SEP",X3=10:"OCT",X3=11:"NOV",X3=12:"DEC",1:"")
+9 SET X=""
+10 SET Y=0
+11 FOR
SET Y=$ORDER(X1(Y))
IF 'Y
QUIT
SET X=X_X1(Y)_" "
+12 QUIT
+13 ;-----
BM(X,VAL) ;EP;
+1 SET X=$SELECT(X=1:"JAN",X=2:"FEB",X=3:"MAR",X=4:"APR",X=5:"MAY",X=6:"JUN",X=7:"JUL",X=8:"AUG",X=9:"SEP",X=10:"OCT",X=11:"NOV",1:"DEC")
+2 IF VAL[X
SET VAL=1
+3 IF '$TEST
SET VAL=0
+4 QUIT VAL
+5 ;-----
