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
Q
;
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
Q
;
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
Q
;
KILL K AMQQNOCO,AMQQCOMP,AMQQSYMB,AMQQFTYP,AMQQCOND,AMQQSQST,AMQQATNM,AMQQLINK,AMQQATN,AMQQTNAR,AMQQTDIC,AMQQTLOK,AMQQTTX,AMQQTAX,AMQQQUIT,AMQQCTXS,AMQQVCL,AMQQFTYP,AMQQTAX,AMQQMULT
Q
;
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 ;
