AMQQQ0 ; IHS/CMI/THL - AMQQQ SUBROUTINE PARSES SCRIPTS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
S AMQQXXII=0
RUN F AMQQXXGN=0:0 S AMQQXXGN=$O(@AMQQXXGG) Q:'AMQQXXGN S AMQQXXXX=@AMQQXXGI D ANAL,CHECK I Q
EXIT K AMQQXXGN,^UTILITY("AMQQ",$J,"XXTAX"),%,A,I
Q
;
ANAL S AMQQXXXX=$P(AMQQXXXX,"**")
I "*+"[$E(AMQQXXXX) Q
K AMQQXXAA,AMQQXXCC,AMQQXXVV
I $E(AMQQXXXX)="-" S AMQQXXNN="",AMQQXXXX=$E(AMQQXXXX,2,999),A=AMQQXXXX D STRIP^AMQQQ S AMQQXXXX=A
I AMQQXXXX["!" D KONG Q
D ATT
D CHECK
I Q
I $D(AMQQXXNF) K AMQQXXNF G A1
I AMQQCTXS D MULT Q
I AMQQFTYP="G"!(AMQQFTYP="L") D TAX,CHECK Q:$T S AMQQXXCC="TAX" G A1
I $D(AMQQONE) S (AMQQXXVV,AMQQXXCC)="" D SET Q
D COND
D CHECK
I Q
D VAL
D CHECK
I Q
A1 D SET
Q
;
ATT S X=$P(AMQQXXXX,";")
D AUTO^AMQQATA
I Y=-1,AMQQXXXX'[";" D NATL Q
I Y'=-1 D ^AMQQSEC
I Y=-1 K AMQQXXNN S AMQQFAIL=6 Q
SETATT S AMQQXXAA=Y
S %=^AMQQ(5,+Y,0)
S AMQQLINK=$P(%,U,5)
S AMQQATN=+Y
I AMQQLINK=9 S AMQQATNM=$P(Y,U,2) D ^AMQQATAL
S %=^AMQQ(1,AMQQLINK,0)
S AMQQCTXS=$P(%,U,7)
S AMQQFTYP=$P(^AMQQ(4,$P(%,U,5),0),U)
Q
;
COND S X=$P(AMQQXXXX,";",2)
K AMQQCOND
I X="" S (AMQQCOND,AMQQXXCC)="" Q
I "^NULL^ALL^ANY^EXISTS^"[(U_X_U) S:X="ALL" X="EXISTS" S AMQQXXCC=X,AMQQCOND=";;;"_X Q
D AUTO^AMQQAC
I Y=-1 S AMQQFAIL=7 Q
SETCOND S AMQQCOND=+Y
S AMQQNOCO=$P(^AMQQ(5,+Y,0),U,8)
S AMQQCONM=$P(Y,U,2)
S AMQQSYMB=$P(^AMQQ(5,+Y,0),U,6)
S AMQQXXCC=Y
Q
;
VAL S (AMQQXXVV,X)=$P(AMQQXXXX,";",3)
K AMQQCOMP
I X="",$G(AMQQCOND) S AMQQFAIL=8 Q
D ^AMQQAV
I '$D(AMQQCOMP) S AMQQFAIL=8 Q
S AMQQXXVV=AMQQCOMP
Q
;
SET S AMQQXXII=$G(AMQQXXII)+1
S AMQQXX(AMQQXXII,1)=AMQQXXAA_";"_$G(AMQQXXCC)_";"_AMQQXXVV
Q
;
TAX ; ENTRY POINT FROM AMQQ1
I $P(AMQQXXXX,";",2)="=" G T1
I $P(AMQQXXXX,";",2)="'=" S AMQQXXNT="INVERSE" G T1
I $D(AMQQONE) G T2
S AMQQFAIL=9 Q
T1 I $P(AMQQXXXX,";",3)="" S AMQQFAIL=8 Q
D TGRP
I $D(AMQQFAIL) Q
T2 K AMQQTAX
S %=^AMQQ(5,AMQQATN,0)
S AMQQTNAR=$P(%,U,15)
S AMQQTDIC=U_$P(%,U,16)
S AMQQTLOK=U_$P(%,U,18)
S AMQQTTX=$G(^AMQQ(5,AMQQATN,3))
S AMQQXXN=0
D ^AMQQTX
K AMQQXXTT,AMQQXXTN
I '$D(AMQQTAX) S AMQQFAIL=8 Q
I $D(AMQQXXNT) S AMQQSCMP=AMQQXXNT K AMQQXXNT D SCMP^AMQQTX S AMQQXXVV=AMQQCOMP I 1
E S AMQQXXVV=AMQQTAX
K AMQQTAX
Q
;
TGRP S %=$P(AMQQXXXX,";",3)
I $E(%)="[" S X=$E(%,2,999),X=$P(X,"]") I $D(^UTILITY("AMQQ",$J,"XXTAX",X)) S AMQQXXTT=X Q
S AMQQXXI=AMQQXXGN
S AMQQXXX1=%
D TG1
K AMQQXXX1
Q
;
TG1 N AMQQXXGN
S AMQQXXGN=AMQQXXI
S AMQQXXTT="XXTEMP"
S AMQQXXTN=0
K ^UTILITY("AMQQ",$J,"XXTAX",AMQQXXTT)
TG11 F I=1:1 S %=$P(AMQQXXX1,",",I) Q:%="" S AMQQXXTN=AMQQXXTN+1,^UTILITY("AMQQ",$J,"XXTAX",AMQQXXTT,AMQQXXTN)=%
S AMQQXXGN=$O(@AMQQXXGG)
I 'AMQQXXGN Q
S %=@AMQQXXGI
I $E(%)="+" S AMQQXXX1=$E(%,2,999) G TG11
Q
;
CHECK I $D(AMQQQUIT)!($D(AMQQFAIL))
Q
;
KONG F AMQQXXXI=1:1 S AMQQXXX1=$P(AMQQXXXX,"!",AMQQXXXI) Q:AMQQXXX1="" D OR,CHECK I Q
K AMQQXXX1,AMQQXXXI
Q
;
OR N AMQQXXXX
S AMQQXXXX=AMQQXXX1
D ATT,CHECK
I Q
I AMQQCTXS S AMQQFAIL=9 Q
I AMQQFTYP="G"!(AMQQFTYP="L") D TAX G OR1
D COND
D CHECK
I Q
D VAL
D CHECK
I Q
OR1 I AMQQXXXI=1 S AMQQXXII=$G(AMQQXXII)+1
S AMQQXX(AMQQXXII,AMQQXXXI)=AMQQXXAA_";"_$G(AMQQXXCC)_";"_AMQQXXVV
Q
;
MULT S AMQQXXII=$G(AMQQXXII)+1
S AMQQXX(AMQQXXII,1)=Y_";MULT"
S AMQQXXLV=1
S AMQQXXND="AMQQXX("_AMQQXXII_",1)"
D ^AMQQQ1
Q
;
NATL K AMQQTAX D ^AMQQN2
I $D(AMQQFAIL) S Y=-1 K AMQQXXNN G NEXIT
I $D(AMQQTAX) S AMQQXXAA=AMQQNATT,AMQQXXCC=AMQQNCND,AMQQXXVV=AMQQTAX,AMQQXXNF="" S:$D(^UTILITY("AMQQ TAX",$J,AMQQTAX,"--")) AMQQXXVV=AMQQXXVV_";INVERSE" G NEXIT
S Y=AMQQNATT
D SETATT
S Y=AMQQNCND
D SETCOND
S AMQQXXVV=AMQQNVAL,AMQQXXNF=""
NEXIT K AMQQNATT,AMQQNCND,AMQQNVAL,AMQQNTYP,AMQQTNAR,AMQQTDIC,AMQQTAX,AMQQTLOK,AMQQTTX,AMQQXXN,AMQQXXNT
Q
;
AMQQQ0 ; IHS/CMI/THL - AMQQQ SUBROUTINE PARSES SCRIPTS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 SET AMQQXXII=0
RUN FOR AMQQXXGN=0:0
SET AMQQXXGN=$ORDER(@AMQQXXGG)
IF 'AMQQXXGN
QUIT
SET AMQQXXXX=@AMQQXXGI
DO ANAL
DO CHECK
IF $TEST
QUIT
EXIT KILL AMQQXXGN,^UTILITY("AMQQ",$JOB,"XXTAX"),%,A,I
+1 QUIT
+2 ;
ANAL SET AMQQXXXX=$PIECE(AMQQXXXX,"**")
+1 IF "*+"[$EXTRACT(AMQQXXXX)
QUIT
+2 KILL AMQQXXAA,AMQQXXCC,AMQQXXVV
+3 IF $EXTRACT(AMQQXXXX)="-"
SET AMQQXXNN=""
SET AMQQXXXX=$EXTRACT(AMQQXXXX,2,999)
SET A=AMQQXXXX
DO STRIP^AMQQQ
SET AMQQXXXX=A
+4 IF AMQQXXXX["!"
DO KONG
QUIT
+5 DO ATT
+6 DO CHECK
+7 IF $TEST
QUIT
+8 IF $DATA(AMQQXXNF)
KILL AMQQXXNF
GOTO A1
+9 IF AMQQCTXS
DO MULT
QUIT
+10 IF AMQQFTYP="G"!(AMQQFTYP="L")
DO TAX
DO CHECK
IF $TEST
QUIT
SET AMQQXXCC="TAX"
GOTO A1
+11 IF $DATA(AMQQONE)
SET (AMQQXXVV,AMQQXXCC)=""
DO SET
QUIT
+12 DO COND
+13 DO CHECK
+14 IF $TEST
QUIT
+15 DO VAL
+16 DO CHECK
+17 IF $TEST
QUIT
A1 DO SET
+1 QUIT
+2 ;
ATT SET X=$PIECE(AMQQXXXX,";")
+1 DO AUTO^AMQQATA
+2 IF Y=-1
IF AMQQXXXX'[";"
DO NATL
QUIT
+3 IF Y'=-1
DO ^AMQQSEC
+4 IF Y=-1
KILL AMQQXXNN
SET AMQQFAIL=6
QUIT
SETATT SET AMQQXXAA=Y
+1 SET %=^AMQQ(5,+Y,0)
+2 SET AMQQLINK=$PIECE(%,U,5)
+3 SET AMQQATN=+Y
+4 IF AMQQLINK=9
SET AMQQATNM=$PIECE(Y,U,2)
DO ^AMQQATAL
+5 SET %=^AMQQ(1,AMQQLINK,0)
+6 SET AMQQCTXS=$PIECE(%,U,7)
+7 SET AMQQFTYP=$PIECE(^AMQQ(4,$PIECE(%,U,5),0),U)
+8 QUIT
+9 ;
COND SET X=$PIECE(AMQQXXXX,";",2)
+1 KILL AMQQCOND
+2 IF X=""
SET (AMQQCOND,AMQQXXCC)=""
QUIT
+3 IF "^NULL^ALL^ANY^EXISTS^"[(U_X_U)
IF X="ALL"
SET X="EXISTS"
SET AMQQXXCC=X
SET AMQQCOND=";;;"_X
QUIT
+4 DO AUTO^AMQQAC
+5 IF Y=-1
SET AMQQFAIL=7
QUIT
SETCOND SET AMQQCOND=+Y
+1 SET AMQQNOCO=$PIECE(^AMQQ(5,+Y,0),U,8)
+2 SET AMQQCONM=$PIECE(Y,U,2)
+3 SET AMQQSYMB=$PIECE(^AMQQ(5,+Y,0),U,6)
+4 SET AMQQXXCC=Y
+5 QUIT
+6 ;
VAL SET (AMQQXXVV,X)=$PIECE(AMQQXXXX,";",3)
+1 KILL AMQQCOMP
+2 IF X=""
IF $GET(AMQQCOND)
SET AMQQFAIL=8
QUIT
+3 DO ^AMQQAV
+4 IF '$DATA(AMQQCOMP)
SET AMQQFAIL=8
QUIT
+5 SET AMQQXXVV=AMQQCOMP
+6 QUIT
+7 ;
SET SET AMQQXXII=$GET(AMQQXXII)+1
+1 SET AMQQXX(AMQQXXII,1)=AMQQXXAA_";"_$GET(AMQQXXCC)_";"_AMQQXXVV
+2 QUIT
+3 ;
TAX ; ENTRY POINT FROM AMQQ1
+1 IF $PIECE(AMQQXXXX,";",2)="="
GOTO T1
+2 IF $PIECE(AMQQXXXX,";",2)="'="
SET AMQQXXNT="INVERSE"
GOTO T1
+3 IF $DATA(AMQQONE)
GOTO T2
+4 SET AMQQFAIL=9
QUIT
T1 IF $PIECE(AMQQXXXX,";",3)=""
SET AMQQFAIL=8
QUIT
+1 DO TGRP
+2 IF $DATA(AMQQFAIL)
QUIT
T2 KILL AMQQTAX
+1 SET %=^AMQQ(5,AMQQATN,0)
+2 SET AMQQTNAR=$PIECE(%,U,15)
+3 SET AMQQTDIC=U_$PIECE(%,U,16)
+4 SET AMQQTLOK=U_$PIECE(%,U,18)
+5 SET AMQQTTX=$GET(^AMQQ(5,AMQQATN,3))
+6 SET AMQQXXN=0
+7 DO ^AMQQTX
+8 KILL AMQQXXTT,AMQQXXTN
+9 IF '$DATA(AMQQTAX)
SET AMQQFAIL=8
QUIT
+10 IF $DATA(AMQQXXNT)
SET AMQQSCMP=AMQQXXNT
KILL AMQQXXNT
DO SCMP^AMQQTX
SET AMQQXXVV=AMQQCOMP
IF 1
+11 IF '$TEST
SET AMQQXXVV=AMQQTAX
+12 KILL AMQQTAX
+13 QUIT
+14 ;
TGRP SET %=$PIECE(AMQQXXXX,";",3)
+1 IF $EXTRACT(%)="["
SET X=$EXTRACT(%,2,999)
SET X=$PIECE(X,"]")
IF $DATA(^UTILITY("AMQQ",$JOB,"XXTAX",X))
SET AMQQXXTT=X
QUIT
+2 SET AMQQXXI=AMQQXXGN
+3 SET AMQQXXX1=%
+4 DO TG1
+5 KILL AMQQXXX1
+6 QUIT
+7 ;
TG1 NEW AMQQXXGN
+1 SET AMQQXXGN=AMQQXXI
+2 SET AMQQXXTT="XXTEMP"
+3 SET AMQQXXTN=0
+4 KILL ^UTILITY("AMQQ",$JOB,"XXTAX",AMQQXXTT)
TG11 FOR I=1:1
SET %=$PIECE(AMQQXXX1,",",I)
IF %=""
QUIT
SET AMQQXXTN=AMQQXXTN+1
SET ^UTILITY("AMQQ",$JOB,"XXTAX",AMQQXXTT,AMQQXXTN)=%
+1 SET AMQQXXGN=$ORDER(@AMQQXXGG)
+2 IF 'AMQQXXGN
QUIT
+3 SET %=@AMQQXXGI
+4 IF $EXTRACT(%)="+"
SET AMQQXXX1=$EXTRACT(%,2,999)
GOTO TG11
+5 QUIT
+6 ;
CHECK IF $DATA(AMQQQUIT)!($DATA(AMQQFAIL))
+1 QUIT
+2 ;
KONG FOR AMQQXXXI=1:1
SET AMQQXXX1=$PIECE(AMQQXXXX,"!",AMQQXXXI)
IF AMQQXXX1=""
QUIT
DO OR
DO CHECK
IF $TEST
QUIT
+1 KILL AMQQXXX1,AMQQXXXI
+2 QUIT
+3 ;
OR NEW AMQQXXXX
+1 SET AMQQXXXX=AMQQXXX1
+2 DO ATT
DO CHECK
+3 IF $TEST
QUIT
+4 IF AMQQCTXS
SET AMQQFAIL=9
QUIT
+5 IF AMQQFTYP="G"!(AMQQFTYP="L")
DO TAX
GOTO OR1
+6 DO COND
+7 DO CHECK
+8 IF $TEST
QUIT
+9 DO VAL
+10 DO CHECK
+11 IF $TEST
QUIT
OR1 IF AMQQXXXI=1
SET AMQQXXII=$GET(AMQQXXII)+1
+1 SET AMQQXX(AMQQXXII,AMQQXXXI)=AMQQXXAA_";"_$GET(AMQQXXCC)_";"_AMQQXXVV
+2 QUIT
+3 ;
MULT SET AMQQXXII=$GET(AMQQXXII)+1
+1 SET AMQQXX(AMQQXXII,1)=Y_";MULT"
+2 SET AMQQXXLV=1
+3 SET AMQQXXND="AMQQXX("_AMQQXXII_",1)"
+4 DO ^AMQQQ1
+5 QUIT
+6 ;
NATL KILL AMQQTAX
DO ^AMQQN2
+1 IF $DATA(AMQQFAIL)
SET Y=-1
KILL AMQQXXNN
GOTO NEXIT
+2 IF $DATA(AMQQTAX)
SET AMQQXXAA=AMQQNATT
SET AMQQXXCC=AMQQNCND
SET AMQQXXVV=AMQQTAX
SET AMQQXXNF=""
IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQTAX,"--"))
SET AMQQXXVV=AMQQXXVV_";INVERSE"
GOTO NEXIT
+3 SET Y=AMQQNATT
+4 DO SETATT
+5 SET Y=AMQQNCND
+6 DO SETCOND
+7 SET AMQQXXVV=AMQQNVAL
SET AMQQXXNF=""
NEXIT KILL AMQQNATT,AMQQNCND,AMQQNVAL,AMQQNTYP,AMQQTNAR,AMQQTDIC,AMQQTAX,AMQQTLOK,AMQQTTX,AMQQXXN,AMQQXXNT
+1 QUIT
+2 ;
