Routine: AMQQSQUP

AMQQSQUP ; IHS/CMI/THL - SCREEN ATTRIBUTES WITH VALUE OF PARENT ATTRIBUTES ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;-----

 N AMQQUPN S AMQQUPN=AMQQSQSN

RUN N AMQQNOCO,AMQQCOMP,AMQQSYMB,AMQQFTYP,AMQQCOND,AMQQSQST,AMQQATNM,AMQQLINK,AMQQATN,AMQQTNAR,AMQQTDIC,AMQQTLOK,AMQQTTX,AMQQTAX,AMQQQUIT,AMQQCTXS,AMQQVCL,AMQQFTYP,AMQQTAX,AMQQMULT,AMQQCONM,AMQQSBCT

 D VAR

 I $G(AMQQCOMP)="" G EXIT

 D SET

 D KILL

 S %=$G(^AMQQ(5,AMQQUPN,5))

 I % S AMQQUPN=% G RUN

EXIT K X

VAR S Y=+^AMQQ(5,AMQQUPN,5)

 S AMQQATNM=$P(^AMQQ(5,Y,0),U)

 S AMQQUPN=Y

 S %=^AMQQ(5,+Y,0)

 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) Q

 W !!,"Please specify the ",AMQQATNM," =>",!

CND D GETCOND^AMQQAC

 I $D(AMQQQUIT) Q

 I X="" W !,"You must specify a condition!!",*7,! G CND

 I X=U Q

 I Y=-1 W " ??",*7 G CND

 S AMQQCOND=+Y

 S AMQQCONM=$P(Y,U,2)

 S AMQQSYMB=$P(^AMQQ(5,+Y,0),U,6)

 S AMQQNOCO=$P(^AMQQ(5,+Y,0),U,8)

 K AMQQCOMP

 D ^AMQQAV

 I $D(AMQQQUIT) Q

 I $G(X)="" G CND

 I '$D(AMQQCOMP) G CND

SET ;

 S AMQQSQUF=""

 S AMQQSQCV=$G(AMQQSQUF)_AMQQUPN_":"_AMQQFTYP_":"_$G(AMQQSYMB)_":"_AMQQCOMP_"~"

 S AMQQSQNM=""

 S AMQQSQF1="PARENT"

 S AMQQSQF2="AMQQF3"

 S AMQQSQCT="P"

 S AMQQSQTP=$P(^AMQQ(1,AMQQLINK,0),U,5)

 S AMQQSQN=AMQQSQSN

KILL K AMQQNOCO,AMQQCOMP,AMQQSYMB,AMQQFTYP,AMQQCOND,AMQQSQST,AMQQATNM,AMQQLINK,AMQQATN,AMQQTNAR,AMQQTDIC,AMQQTLOK,AMQQTTX,AMQQTAX,AMQQQUIT,AMQQCTXS,AMQQVCL,AMQQFTYP,AMQQTAX,AMQQMULT

AMQQSQUP  ; IHS/CMI/THL - SCREEN ATTRIBUTES WITH VALUE OF PARENT ATTRIBUTES ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;-----

 +3        NEW AMQQUPN

           SET AMQQUPN=AMQQSQSN

RUN        NEW AMQQNOCO,AMQQCOMP,AMQQSYMB,AMQQFTYP,AMQQCOND,AMQQSQST,AMQQATNM,AMQQLINK,AMQQATN,AMQQTNAR,AMQQTDIC,AMQQTLOK,AMQQTTX,AMQQTAX,AMQQQUIT,AMQQCTXS,AMQQVCL,AMQQFTYP,AMQQTAX,AMQQMULT,AMQQCONM,AMQQSBCT

 +1        DO VAR

 +2        IF $GET(AMQQCOMP)=""

               GOTO EXIT

 +3        DO SET

 +4        DO KILL

 +5        SET %=$GET(^AMQQ(5,AMQQUPN,5))

 +6        IF %

               SET AMQQUPN=%

               GOTO RUN

EXIT       KILL X

 +1        QUIT

 +2       ;

VAR        SET Y=+^AMQQ(5,AMQQUPN,5)

 +1        SET AMQQATNM=$PIECE(^AMQQ(5,Y,0),U)

 +2        SET AMQQUPN=Y

 +3        SET %=^AMQQ(5,+Y,0)

 +4        SET AMQQLINK=$PIECE(%,U,5)

 +5        SET AMQQATN=+Y

 +6        SET AMQQSBCT=$PIECE(%,U,20)

 +7        IF AMQQLINK=9

               SET AMQQLINK=+Y+($JOB/100000)

 +8        SET Z=$PIECE(^AMQQ(1,AMQQLINK,0),U,5)

 +9        SET Z=$PIECE(^AMQQ(4,Z,0),U)

 +10       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

 +11       SET %=^AMQQ(1,AMQQLINK,0)

 +12       SET AMQQCTXS=$PIECE(%,U,7)

 +13       SET AMQQVCL=$PIECE(%,U,6)

 +14       SET AMQQFTYP=$PIECE(^AMQQ(4,$PIECE(%,U,5),0),U)

 +15       IF $DATA(AMQQTAX)

               QUIT

 +16       WRITE !!,"Please specify the ",AMQQATNM," =>",!

CND        DO GETCOND^AMQQAC

 +1        IF $DATA(AMQQQUIT)

               QUIT

 +2        IF X=""

               WRITE !,"You must specify a condition!!",*7,!

               GOTO CND

 +3        IF X=U

               QUIT

 +4        IF Y=-1

               WRITE " ??",*7

               GOTO CND

 +5        SET AMQQCOND=+Y

 +6        SET AMQQCONM=$PIECE(Y,U,2)

 +7        SET AMQQSYMB=$PIECE(^AMQQ(5,+Y,0),U,6)

 +8        SET AMQQNOCO=$PIECE(^AMQQ(5,+Y,0),U,8)

 +9        KILL AMQQCOMP

 +10       DO ^AMQQAV

 +11       IF $DATA(AMQQQUIT)

               QUIT

 +12       IF $GET(X)=""

               GOTO CND

 +13       IF '$DATA(AMQQCOMP)

               GOTO CND

 +14       QUIT

 +15      ;

SET       ;

 +1        SET AMQQSQUF=""

 +2        SET AMQQSQCV=$GET(AMQQSQUF)_AMQQUPN_":"_AMQQFTYP_":"_$GET(AMQQSYMB)_":"_AMQQCOMP_"~"

 +3        SET AMQQSQNM=""

 +4        SET AMQQSQF1="PARENT"

 +5        SET AMQQSQF2="AMQQF3"

 +6        SET AMQQSQCT="P"

 +7        SET AMQQSQTP=$PIECE(^AMQQ(1,AMQQLINK,0),U,5)

 +8        SET AMQQSQN=AMQQSQSN

 +9        QUIT

 +10      ;

KILL       KILL AMQQNOCO,AMQQCOMP,AMQQSYMB,AMQQFTYP,AMQQCOND,AMQQSQST,AMQQATNM,AMQQLINK,AMQQATN,AMQQTNAR,AMQQTDIC,AMQQTLOK,AMQQTTX,AMQQTAX,AMQQQUIT,AMQQCTXS,AMQQVCL,AMQQFTYP,AMQQTAX,AMQQMULT

 +1        QUIT

 +2       ;

AMQQSQUP.m