AMQQSQA1 ; IHS/CMI/THL - LINK SUBQUERY ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
RUN N AMQQSQST,AMQQNOCO,AMQQCOMP,AMQQSYMB,AMQQFTYP,AMQQCOND
I AMQQSQCT="R" D ^AMQQAVR Q
I AMQQSQCT="L",'$D(AMQQSQLF) D NEW Q
I AMQQSQCT="V" D NEW Q
I AMQQSQCT="M"!($D(AMQQSQLF)) D ^AMQQSQA2 Q
SETCOND S AMQQNOCO=AMQQSQNC
S AMQQSYMB=AMQQSQBS
S AMQQFTYP=$P(^AMQQ(4,AMQQSQTP,0),U)
S AMQQCOND=AMQQSQN
S (AMQQSQST,AMQQFTYP)=$S("TO"[AMQQSQCT:"N",AMQQSQCT="D":"D",1:$P(^AMQQ(4,AMQQSQTP,0),U))
GETVAL K AMQQCOMP
I $D(AMQQMMVV) S (AMQQCOMP,AMQQSQCV)=AMQQMMVV K AMQQMMVV Q
D ^AMQQAV
I $D(AMQQQUIT) K AMQQQUIT,AMQQCOMP S AMQQSQNV="" Q
I '$D(AMQQCOMP) K AMQQCOMP
I '$D(AMQQCOMP) W !!,"You must enter a value. Try again...",!!,*7 G GETVAL
S AMQQSQCV=AMQQCOMP
EXIT K %,Z
Q
;
NEW N AMQQLINK,AMQQATNM,AMQQCTXS,AMQQCOND,AMQQCONM,AMQQVCL,AMQQSER,AMQQORTX,AMQQSQFR,AMQQNVAR,AMQQFILT,AMQQSNOT,AMQQTAX,AMQQATN,AMQQSQCT,AMQQTNAR,AMQQTDIC,AMQQTLOK,AMQQTTX
D VAR
I $D(AMQQQUIT) Q
S AMQQSQQF=""
K %
Q
;
VAR S %=^AMQQ(5,+Y,0)
S AMQQATNM=$P(Y,U,2)
S AMQQLINK=$P(%,U,5)
S AMQQATN=+Y
S AMQQSBCT=$P(%,U,20)
I AMQQLINK=9 S AMQQLINK=+Y+($J/100000)
S Z=$P(^AMQQ(1,AMQQLINK,0),U,5)
S Z=$P(^AMQQ(4,Z,0),U)
I Z="L"!(Z="G") S AMQQTNAR=$P(%,U,15),AMQQTDIC=U_$P(%,U,16),AMQQTLOK=U_$P(%,U,18),AMQQTTX="" S:$D(^AMQQ(5,+Y,3)) AMQQTTX=^(3) D ^AMQQTX Q:$D(AMQQQUIT) G:'$D(AMQQTAX) VAR
S %=^AMQQ(1,AMQQLINK,0)
S AMQQCTXS=$P(%,U,7)
S AMQQVCL=$P(%,U,6)
S AMQQFTYP=$P(^AMQQ(4,$P(%,U,5),0),U)
I $D(AMQQTAX) D SET^AMQQAT Q
CND N AMQQCOND,AMQQMULT
I $D(AMQQYYMI) D AUTO Q
CND1 D GETCOND^AMQQAC
I X="" W "You must enter a condition or '^'",!,*7 S X=AMQQSQNM G CND1
I $D(AMQQQUIT) Q
I Y>0 S AMQQCOND=+Y,AMQQNOCO=$P(^AMQQ(5,+Y,0),U,8),AMQQCONM=$P(Y,U,2),AMQQSYMB=$P(^AMQQ(5,+Y,0),U,6) G VAL
I Y=-1,X="NULL" S AMQQCOND="",AMQQCOMP="NULL" D SPEC Q
I Y=-1,$E(X,1,3)="EXI" W $E("EXISTS",$L(X)+1,6) S AMQQCOND="",AMQQCOMP="EXISTS" D SPEC Q
I Y=-1,$D(AMQQXX) S AMQQFAIL=10 Q
I Y=-1 W " ??",*7 G CND1
I '$D(AMQQCOND) Q
VAL K AMQQCOMP
D ^AMQQAV
I $G(X)="" G CND1
I $D(AMQQQUIT) Q
I '$D(AMQQCOMP) G CND
D SET^AMQQAT
I (AMQQSQN=59!((AMQQSQN>315)&(AMQQSQN<319))) S AMQQSQCV=AMQQCOMP
Q
;
SPEC S AMQQQ=AMQQLINK_U_AMQQATNM_U_AMQQFTYP_"^^^^^'=^;;;"_AMQQCOMP_"^^^^^1"
Q
;
AUTO ;
S AMQQMMLL=@AMQQXXND@(AMQQYYMI,1,1,1),Y=$P(AMQQMMLL,";")
D EN1^AMQQAC
S AMQQCOMP=$P(AMQQMMLL,";",2,3)
D SET^AMQQAT
K AMQQMMLL
Q
;
SET ; ENTRY POINT FROM AMQQSQA0
N A,B,I,S,%
K AMQQSVAL
S %=$P($G(^AMQQ(5,AMQQSQSN,0)),U,5)
I % S:%=9 %=AMQQSQSN+($J/100000) S %=$P($G(^AMQQ(1,%,0)),U,6) I % S %="^DD("_%_",0)" I $D(@%) S S=$P(^(0),U,3)
I '$D(S) Q
F I=1:1 S A=$P(S,";",I) Q:A="" S C=$P(A,":"),B=$P(A,":",2) I $E(B,1,$L(X))=X S AMQQSVAL=C,Y="11^IS" W:'$D(AMQQXX) $E(B,$L(X)+1,99) Q
Q
;
AMQQSQA1 ; IHS/CMI/THL - LINK SUBQUERY ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
RUN NEW AMQQSQST,AMQQNOCO,AMQQCOMP,AMQQSYMB,AMQQFTYP,AMQQCOND
+1 IF AMQQSQCT="R"
DO ^AMQQAVR
QUIT
+2 IF AMQQSQCT="L"
IF '$DATA(AMQQSQLF)
DO NEW
QUIT
+3 IF AMQQSQCT="V"
DO NEW
QUIT
+4 IF AMQQSQCT="M"!($DATA(AMQQSQLF))
DO ^AMQQSQA2
QUIT
SETCOND SET AMQQNOCO=AMQQSQNC
+1 SET AMQQSYMB=AMQQSQBS
+2 SET AMQQFTYP=$PIECE(^AMQQ(4,AMQQSQTP,0),U)
+3 SET AMQQCOND=AMQQSQN
+4 SET (AMQQSQST,AMQQFTYP)=$SELECT("TO"[AMQQSQCT:"N",AMQQSQCT="D":"D",1:$PIECE(^AMQQ(4,AMQQSQTP,0),U))
GETVAL KILL AMQQCOMP
+1 IF $DATA(AMQQMMVV)
SET (AMQQCOMP,AMQQSQCV)=AMQQMMVV
KILL AMQQMMVV
QUIT
+2 DO ^AMQQAV
+3 IF $DATA(AMQQQUIT)
KILL AMQQQUIT,AMQQCOMP
SET AMQQSQNV=""
QUIT
+4 IF '$DATA(AMQQCOMP)
KILL AMQQCOMP
+5 IF '$DATA(AMQQCOMP)
WRITE !!,"You must enter a value. Try again...",!!,*7
GOTO GETVAL
+6 SET AMQQSQCV=AMQQCOMP
EXIT KILL %,Z
+1 QUIT
+2 ;
NEW NEW AMQQLINK,AMQQATNM,AMQQCTXS,AMQQCOND,AMQQCONM,AMQQVCL,AMQQSER,AMQQORTX,AMQQSQFR,AMQQNVAR,AMQQFILT,AMQQSNOT,AMQQTAX,AMQQATN,AMQQSQCT,AMQQTNAR,AMQQTDIC,AMQQTLOK,AMQQTTX
+1 DO VAR
+2 IF $DATA(AMQQQUIT)
QUIT
+3 SET AMQQSQQF=""
+4 KILL %
+5 QUIT
+6 ;
VAR SET %=^AMQQ(5,+Y,0)
+1 SET AMQQATNM=$PIECE(Y,U,2)
+2 SET AMQQLINK=$PIECE(%,U,5)
+3 SET AMQQATN=+Y
+4 SET AMQQSBCT=$PIECE(%,U,20)
+5 IF AMQQLINK=9
SET AMQQLINK=+Y+($JOB/100000)
+6 SET Z=$PIECE(^AMQQ(1,AMQQLINK,0),U,5)
+7 SET Z=$PIECE(^AMQQ(4,Z,0),U)
+8 IF Z="L"!(Z="G")
SET AMQQTNAR=$PIECE(%,U,15)
SET AMQQTDIC=U_$PIECE(%,U,16)
SET AMQQTLOK=U_$PIECE(%,U,18)
SET AMQQTTX=""
IF $DATA(^AMQQ(5,+Y,3))
SET AMQQTTX=^(3)
DO ^AMQQTX
IF $DATA(AMQQQUIT)
QUIT
IF '$DATA(AMQQTAX)
GOTO VAR
+9 SET %=^AMQQ(1,AMQQLINK,0)
+10 SET AMQQCTXS=$PIECE(%,U,7)
+11 SET AMQQVCL=$PIECE(%,U,6)
+12 SET AMQQFTYP=$PIECE(^AMQQ(4,$PIECE(%,U,5),0),U)
+13 IF $DATA(AMQQTAX)
DO SET^AMQQAT
QUIT
CND NEW AMQQCOND,AMQQMULT
+1 IF $DATA(AMQQYYMI)
DO AUTO
QUIT
CND1 DO GETCOND^AMQQAC
+1 IF X=""
WRITE "You must enter a condition or '^'",!,*7
SET X=AMQQSQNM
GOTO CND1
+2 IF $DATA(AMQQQUIT)
QUIT
+3 IF Y>0
SET AMQQCOND=+Y
SET AMQQNOCO=$PIECE(^AMQQ(5,+Y,0),U,8)
SET AMQQCONM=$PIECE(Y,U,2)
SET AMQQSYMB=$PIECE(^AMQQ(5,+Y,0),U,6)
GOTO VAL
+4 IF Y=-1
IF X="NULL"
SET AMQQCOND=""
SET AMQQCOMP="NULL"
DO SPEC
QUIT
+5 IF Y=-1
IF $EXTRACT(X,1,3)="EXI"
WRITE $EXTRACT("EXISTS",$LENGTH(X)+1,6)
SET AMQQCOND=""
SET AMQQCOMP="EXISTS"
DO SPEC
QUIT
+6 IF Y=-1
IF $DATA(AMQQXX)
SET AMQQFAIL=10
QUIT
+7 IF Y=-1
WRITE " ??",*7
GOTO CND1
+8 IF '$DATA(AMQQCOND)
QUIT
VAL KILL AMQQCOMP
+1 DO ^AMQQAV
+2 IF $GET(X)=""
GOTO CND1
+3 IF $DATA(AMQQQUIT)
QUIT
+4 IF '$DATA(AMQQCOMP)
GOTO CND
+5 DO SET^AMQQAT
+6 IF (AMQQSQN=59!((AMQQSQN>315)&(AMQQSQN<319)))
SET AMQQSQCV=AMQQCOMP
+7 QUIT
+8 ;
SPEC SET AMQQQ=AMQQLINK_U_AMQQATNM_U_AMQQFTYP_"^^^^^'=^;;;"_AMQQCOMP_"^^^^^1"
+1 QUIT
+2 ;
AUTO ;
+1 SET AMQQMMLL=@AMQQXXND@(AMQQYYMI,1,1,1)
SET Y=$PIECE(AMQQMMLL,";")
+2 DO EN1^AMQQAC
+3 SET AMQQCOMP=$PIECE(AMQQMMLL,";",2,3)
+4 DO SET^AMQQAT
+5 KILL AMQQMMLL
+6 QUIT
+7 ;
SET ; ENTRY POINT FROM AMQQSQA0
+1 NEW A,B,I,S,%
+2 KILL AMQQSVAL
+3 SET %=$PIECE($GET(^AMQQ(5,AMQQSQSN,0)),U,5)
+4 IF %
IF %=9
SET %=AMQQSQSN+($JOB/100000)
SET %=$PIECE($GET(^AMQQ(1,%,0)),U,6)
IF %
SET %="^DD("_%_",0)"
IF $DATA(@%)
SET S=$PIECE(^(0),U,3)
+5 IF '$DATA(S)
QUIT
+6 FOR I=1:1
SET A=$PIECE(S,";",I)
IF A=""
QUIT
SET C=$PIECE(A,":")
SET B=$PIECE(A,":",2)
IF $EXTRACT(B,1,$LENGTH(X))=X
SET AMQQSVAL=C
SET Y="11^IS"
IF '$DATA(AMQQXX)
WRITE $EXTRACT(B,$LENGTH(X)+1,99)
QUIT
+7 QUIT
+8 ;
