AMQQQ1 ; IHS/CMI/THL - SCRIPT INTERPRETER FOR MULTIPLES ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
I AMQQFTYP="G"!(AMQQFTYP="L") D TAX,CHECK I Q
VAR S AMQQSQAA=AMQQUATN
S AMQQSQSN=AMQQATN
S AMQQSQST=AMQQFTYP
S AMQQZZFN=0
S AMQQZZNN=$D(AMQQXXNN)
RUN F S AMQQXXGN=$O(@AMQQXXGG) Q:'AMQQXXGN S AMQQZZZZ=@AMQQXXGI I "+*"'[$E(AMQQZZZZ) D LEV I Q
I '$D(AMQQFAIL),$D(@AMQQXXND)=11,AMQQZZNN S @AMQQXXND@(AMQQZZFN+1,1)="NULL"
EXIT K AMQQZZZZ,AMQQZZNN,AMQQXXNN,AMQQZZAA,AMQQZZFN,AMQQXXMN
I AMQQXXGN="" S AMQQXXGN=999
Q
;
LEV F I=0:1 S %=$E(AMQQZZZZ,I+1) Q:%'="."
I I<AMQQXXLV S AMQQXXGN=AMQQXXGN-1,AMQQXXLV=I Q
I I>AMQQXXLV S AMQQFAIL=10 I 1 Q
S AMQQZZZZ=$E(AMQQZZZZ,AMQQXXLV+1,999)
D ANAL
CHECK I $D(AMQQQUIT)!($D(AMQQFAIL))
Q
;
ANAL S (AMQQZZAA,X)=$P(AMQQZZZZ,";")
I AMQQXXLV>1,X="BETWEEN" S @AMQQXXND=@AMQQXXND_";"_$P(AMQQZZZZ,";",2,3) Q
I $E(X)="-" S AMQQZZMN="",(X,AMQQZZAA)=$E(X,2,999)
S AMQQSQNN=AMQQUSQN
I $G(AMQQZZAA)="NULL" S AMQQZZFN=AMQQZZFN+1,@AMQQXXND@(AMQQZZFN,1)="NULL" Q
D EN1^AMQQSQA0
I $D(AMQQXX),'$D(Y),X="NULL" G SET
I $G(Y)=-1 K AMQQZZMN S AMQQFAIL=10 Q
S AMQQZZFN=AMQQZZFN+1
S AMQQSQCT=$P(^AMQQ(5,+Y,0),U,20)
I AMQQSQCT="L" S AMQQZZAA=Y D LINK Q
I AMQQSQCT="M" D MULT Q
S AMQQZZCC=Y
S %=$P(^AMQQ(5,+Y,0),U,21)
S AMQQSYMB=$P(^(0),U,6)
S AMQQNOCO=$P(^(0),U,8)
S AMQQFTYP=$P(^AMQQ(4,%,0),U)
I $P(^AMQQ(5,+Y,0),U,20)="C" S AMQQCOMP="" G SET
D VALUE
I $D(AMQQFAIL) Q
SET S @AMQQXXND@(AMQQZZFN,1)=AMQQZZCC_";"_AMQQCOMP
Q
;
TAX D TAX^AMQQQ0
D CHECK
I Q
S $P(@AMQQXXND,";",2,3)="MTAX;"_AMQQURGN
I 0
Q
;
LINK S @AMQQXXND@(AMQQZZFN,1)=Y
S AMQQZZZZ=$P(AMQQZZZZ,";",2,9)
D ATT
I $D(AMQQFAIL) Q
Q
;
MULT ; SUBQUERIES
S %=AMQQXXND
N AMQQXXND,AMQQATN,AMQQXXNN,AMQQFTYP
S %=$E(%,1,$L(%)-1)_","_AMQQZZFN_",1)"
S AMQQXXND=%
S AMQQATN=+Y
S %=^AMQQ(5,AMQQATN,0)
S %=$P(%,U,5)
S %=^AMQQ(1,%,0)
S %=$P(%,U,5)
S AMQQFTYP=$P(^AMQQ(4,%,0),U)
I $D(AMQQZMN) K AMQQZZMN S AMQQXXNN=""
I AMQQFTYP="G"!(AMQQFTYP="L") N AMQQXXXX S AMQQXXXX=AMQQZZZZ,AMQQXXMT=Y D TAX,CHECK I Q
I $D(AMQQXXMT) S Y=AMQQXXMT
S @AMQQXXND=Y_$S($D(AMQQXXMT):";MTAX;",1:";MULT;")_AMQQURGN
K AMQQXXMT
RECURSE S AMQQXXLV=AMQQXXLV+1
N AMQQZZAA,AMQQZZFN,AMQQZZMN,AMQQZZNN,AMQQZZZZ,AMQQSQAA,AMQQSQSN,AMQQSQST
D VAR
S AMQQXXLV=AMQQXXLV-1
S AMQQXXGN=AMQQXXGN-1
Q
;
VALUE S Y=AMQQZZCC
S X=$P(AMQQZZZZ,";",2,3)
S AMQQATNM=$P(Y,U,2)
K AMQQCOMP
I AMQQFTYP="U" S AMQQCOMP=$P(AMQQZZZZ,";",2) Q
D ^AMQQAV
I '$D(AMQQCOMP) S AMQQFAIL=10
Q
;
ATT N AMQQFTYP,Y,AMQQCOND
S Y=AMQQZZAA
S %=$P(^AMQQ(5,+Y,0),U,5)
S %=$P(^AMQQ(1,%,0),U,5)
S AMQQFTYP=$P(^AMQQ(4,%,0),U)
S X=$P(AMQQZZZZ,";")
D CONDIC^AMQQAC
I Y=-1 S AMQQFAIL=10 Q
N AMQQZZCC,AMQQCOMP
S AMQQZZCC=Y
N Y,AMQQNOCO
S AMQQNOCO=+$P(^AMQQ(5,+AMQQZZCC,0),U,8)
D VALUE
I Y=-1 S AMQQFAIL=10 Q
S @AMQQXXND@(AMQQZZFN,1,1,1)=AMQQZZCC_";"_AMQQCOMP
Q
;
AMQQQ1 ; IHS/CMI/THL - SCRIPT INTERPRETER FOR MULTIPLES ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
+3 IF AMQQFTYP="G"!(AMQQFTYP="L")
DO TAX
DO CHECK
IF $TEST
QUIT
VAR SET AMQQSQAA=AMQQUATN
+1 SET AMQQSQSN=AMQQATN
+2 SET AMQQSQST=AMQQFTYP
+3 SET AMQQZZFN=0
+4 SET AMQQZZNN=$DATA(AMQQXXNN)
RUN FOR
SET AMQQXXGN=$ORDER(@AMQQXXGG)
IF 'AMQQXXGN
QUIT
SET AMQQZZZZ=@AMQQXXGI
IF "+*"'[$EXTRACT(AMQQZZZZ)
DO LEV
IF $TEST
QUIT
+1 IF '$DATA(AMQQFAIL)
IF $DATA(@AMQQXXND)=11
IF AMQQZZNN
SET @AMQQXXND@(AMQQZZFN+1,1)="NULL"
EXIT KILL AMQQZZZZ,AMQQZZNN,AMQQXXNN,AMQQZZAA,AMQQZZFN,AMQQXXMN
+1 IF AMQQXXGN=""
SET AMQQXXGN=999
+2 QUIT
+3 ;
LEV FOR I=0:1
SET %=$EXTRACT(AMQQZZZZ,I+1)
IF %'="."
QUIT
+1 IF I<AMQQXXLV
SET AMQQXXGN=AMQQXXGN-1
SET AMQQXXLV=I
QUIT
+2 IF I>AMQQXXLV
SET AMQQFAIL=10
IF 1
QUIT
+3 SET AMQQZZZZ=$EXTRACT(AMQQZZZZ,AMQQXXLV+1,999)
+4 DO ANAL
CHECK IF $DATA(AMQQQUIT)!($DATA(AMQQFAIL))
+1 QUIT
+2 ;
ANAL SET (AMQQZZAA,X)=$PIECE(AMQQZZZZ,";")
+1 IF AMQQXXLV>1
IF X="BETWEEN"
SET @AMQQXXND=@AMQQXXND_";"_$PIECE(AMQQZZZZ,";",2,3)
QUIT
+2 IF $EXTRACT(X)="-"
SET AMQQZZMN=""
SET (X,AMQQZZAA)=$EXTRACT(X,2,999)
+3 SET AMQQSQNN=AMQQUSQN
+4 IF $GET(AMQQZZAA)="NULL"
SET AMQQZZFN=AMQQZZFN+1
SET @AMQQXXND@(AMQQZZFN,1)="NULL"
QUIT
+5 DO EN1^AMQQSQA0
+6 IF $DATA(AMQQXX)
IF '$DATA(Y)
IF X="NULL"
GOTO SET
+7 IF $GET(Y)=-1
KILL AMQQZZMN
SET AMQQFAIL=10
QUIT
+8 SET AMQQZZFN=AMQQZZFN+1
+9 SET AMQQSQCT=$PIECE(^AMQQ(5,+Y,0),U,20)
+10 IF AMQQSQCT="L"
SET AMQQZZAA=Y
DO LINK
QUIT
+11 IF AMQQSQCT="M"
DO MULT
QUIT
+12 SET AMQQZZCC=Y
+13 SET %=$PIECE(^AMQQ(5,+Y,0),U,21)
+14 SET AMQQSYMB=$PIECE(^(0),U,6)
+15 SET AMQQNOCO=$PIECE(^(0),U,8)
+16 SET AMQQFTYP=$PIECE(^AMQQ(4,%,0),U)
+17 IF $PIECE(^AMQQ(5,+Y,0),U,20)="C"
SET AMQQCOMP=""
GOTO SET
+18 DO VALUE
+19 IF $DATA(AMQQFAIL)
QUIT
SET SET @AMQQXXND@(AMQQZZFN,1)=AMQQZZCC_";"_AMQQCOMP
+1 QUIT
+2 ;
TAX DO TAX^AMQQQ0
+1 DO CHECK
+2 IF $TEST
QUIT
+3 SET $PIECE(@AMQQXXND,";",2,3)="MTAX;"_AMQQURGN
+4 IF 0
+5 QUIT
+6 ;
LINK SET @AMQQXXND@(AMQQZZFN,1)=Y
+1 SET AMQQZZZZ=$PIECE(AMQQZZZZ,";",2,9)
+2 DO ATT
+3 IF $DATA(AMQQFAIL)
QUIT
+4 QUIT
+5 ;
MULT ; SUBQUERIES
+1 SET %=AMQQXXND
+2 NEW AMQQXXND,AMQQATN,AMQQXXNN,AMQQFTYP
+3 SET %=$EXTRACT(%,1,$LENGTH(%)-1)_","_AMQQZZFN_",1)"
+4 SET AMQQXXND=%
+5 SET AMQQATN=+Y
+6 SET %=^AMQQ(5,AMQQATN,0)
+7 SET %=$PIECE(%,U,5)
+8 SET %=^AMQQ(1,%,0)
+9 SET %=$PIECE(%,U,5)
+10 SET AMQQFTYP=$PIECE(^AMQQ(4,%,0),U)
+11 IF $DATA(AMQQZMN)
KILL AMQQZZMN
SET AMQQXXNN=""
+12 IF AMQQFTYP="G"!(AMQQFTYP="L")
NEW AMQQXXXX
SET AMQQXXXX=AMQQZZZZ
SET AMQQXXMT=Y
DO TAX
DO CHECK
IF $TEST
QUIT
+13 IF $DATA(AMQQXXMT)
SET Y=AMQQXXMT
+14 SET @AMQQXXND=Y_$SELECT($DATA(AMQQXXMT):";MTAX;",1:";MULT;")_AMQQURGN
+15 KILL AMQQXXMT
RECURSE SET AMQQXXLV=AMQQXXLV+1
+1 NEW AMQQZZAA,AMQQZZFN,AMQQZZMN,AMQQZZNN,AMQQZZZZ,AMQQSQAA,AMQQSQSN,AMQQSQST
+2 DO VAR
+3 SET AMQQXXLV=AMQQXXLV-1
+4 SET AMQQXXGN=AMQQXXGN-1
+5 QUIT
+6 ;
VALUE SET Y=AMQQZZCC
+1 SET X=$PIECE(AMQQZZZZ,";",2,3)
+2 SET AMQQATNM=$PIECE(Y,U,2)
+3 KILL AMQQCOMP
+4 IF AMQQFTYP="U"
SET AMQQCOMP=$PIECE(AMQQZZZZ,";",2)
QUIT
+5 DO ^AMQQAV
+6 IF '$DATA(AMQQCOMP)
SET AMQQFAIL=10
+7 QUIT
+8 ;
ATT NEW AMQQFTYP,Y,AMQQCOND
+1 SET Y=AMQQZZAA
+2 SET %=$PIECE(^AMQQ(5,+Y,0),U,5)
+3 SET %=$PIECE(^AMQQ(1,%,0),U,5)
+4 SET AMQQFTYP=$PIECE(^AMQQ(4,%,0),U)
+5 SET X=$PIECE(AMQQZZZZ,";")
+6 DO CONDIC^AMQQAC
+7 IF Y=-1
SET AMQQFAIL=10
QUIT
+8 NEW AMQQZZCC,AMQQCOMP
+9 SET AMQQZZCC=Y
+10 NEW Y,AMQQNOCO
+11 SET AMQQNOCO=+$PIECE(^AMQQ(5,+AMQQZZCC,0),U,8)
+12 DO VALUE
+13 IF Y=-1
SET AMQQFAIL=10
QUIT
+14 SET @AMQQXXND@(AMQQZZFN,1,1,1)=AMQQZZCC_";"_AMQQCOMP
+15 QUIT
+16 ;
