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