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