AMQQSQAC.m

AMQQSQAC  ; IHS/CMI/TJL - CONTEXT MANAGER FOR ATTRIBUTES ;

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

 ;-----

SPEC I AMQQSQSN=378 S DIC("S")="I $P(^(0),U,4)=29" Q

 I $D(AMQQSQCF) S DIC("S")="I $P(^(0),U,21)=9,'$P(^(0),U,10)" Q

 I $D(AMQQGVF)!($G(AMQQSQSN)=226) S DIC("S")="I $P(^(0),U,4)=17!($P(^(0),U,21)=16)" Q

 I $G(AMQQSQSN)=35 S DIC("S")="I $P(^(0),U,4)=16" Q

 I $D(AMQQSQDV) S DIC("S")="I $P(^(0),U,21)="_$S(AMQQSQDV=306:18,1:7) Q

DICS ; ENTRY POINT FROM AMQQN2

 N X,Y,% S Y=U

 S %=$P($G(^AMQQ(5,+$G(AMQQSQSN),5)),U,3)

 I %'="" S X=% G DICS1

 F  S %=$O(^AMQQ(7,"B",%)) Q:%=""  I %[" ATTRIBUTES" S Z=$O(^(%,"")),Y=Y_Z_U

 S %=$P($G(^AMQQ(5,+$G(AMQQSQSN),0)),U,4)

 I Y[(U_(%+1)_U) S X=%+1

DICS1 S AMQQSQZF(1)=$O(^AMQQ(4,"B",AMQQSQST,""))

 S AMQQSQZF(2)=$S($D(X):X,1:-1)

 S DIC("S")="D EVAL^AMQQSQAC"

 Q

 ;

EVAL ; ENTRY POINT FOR DIC("S") OF ^AMQQ(5) LOOKUP

 I Y>1000 X "I 0" Q

 I "^59^316^317^318^"[(U_Y_U) X "I 0" Q

 I $G(AMQQSQSN)=617,$P(^(0),U,4)=51 Q

 I $P(^AMQQ(5,Y,0),U,20)="M",'$D(AMQQSQSN)!('$D(^(5))) Q

 I $P(^AMQQ(5,Y,0),U,20)="V" Q

 I $P(^AMQQ(5,Y,0),U,20)="M",$G(AMQQSQSN)'=$P(^AMQQ(5,Y,5),U) Q

 I $P(^AMQQ(5,Y,0),U,20)="L",$P($G(^MCAR(690.99,+$G(AMQQSQSN),2)),U,4)=7,$P($G(^AUTTDXPR(Y,0)),U,6),$P($G(^AMQQ(5,Y,5)),U,2),$P(^AMQQ(5,Y,5),U,2)=$P($G(^AMQQ(5,AMQQSQSN,5)),U,2),$P(^AMQQ(1,$P(^AMQQ(5,Y,0),U,5),0),U,2)=2 S AMQQSQLF="" Q

 I $P(^AMQQ(5,Y,0),U,20)="L",+$G(^AMQQ(5,Y,5))=AMQQSQSN,$P(^AMQQ(1,$P(^AMQQ(5,Y,0),U,5),0),U,2)'=2 Q

 I $P(^AMQQ(5,Y,0),U,21)=16 Q

 I $P(^AMQQ(5,Y,0),U,21)=AMQQSQZF(1) Q

 I $P(^AMQQ(5,Y,0),U,21)=7 Q

 I $P(^AMQQ(5,Y,0),U,4)=AMQQSQZF(2) Q

 Q

 ;

AMQQSQAC  ; IHS/CMI/TJL - CONTEXT MANAGER FOR ATTRIBUTES ;

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

 +2       ;-----

SPEC       IF AMQQSQSN=378

               SET DIC("S")="I $P(^(0),U,4)=29"

               QUIT 

 +1        IF $DATA(AMQQSQCF)

               SET DIC("S")="I $P(^(0),U,21)=9,'$P(^(0),U,10)"

               QUIT 

 +2        IF $DATA(AMQQGVF)!($GET(AMQQSQSN)=226)

               SET DIC("S")="I $P(^(0),U,4)=17!($P(^(0),U,21)=16)"

               QUIT 

 +3        IF $GET(AMQQSQSN)=35

               SET DIC("S")="I $P(^(0),U,4)=16"

               QUIT 

 +4        IF $DATA(AMQQSQDV)

               SET DIC("S")="I $P(^(0),U,21)="_$SELECT(AMQQSQDV=306:18,1:7)

               QUIT 

DICS      ; ENTRY POINT FROM AMQQN2

 +1        NEW X,Y,%

           SET Y=U

 +2        SET %=$PIECE($GET(^AMQQ(5,+$GET(AMQQSQSN),5)),U,3)

 +3        IF %'=""

               SET X=%

               GOTO DICS1

 +4        FOR 

               SET %=$ORDER(^AMQQ(7,"B",%))

               IF %=""

                   QUIT 

               IF %[" ATTRIBUTES"

                   SET Z=$ORDER(^(%,""))

                   SET Y=Y_Z_U

 +5        SET %=$PIECE($GET(^AMQQ(5,+$GET(AMQQSQSN),0)),U,4)

 +6        IF Y[(U_(%+1)_U)

               SET X=%+1

DICS1      SET AMQQSQZF(1)=$ORDER(^AMQQ(4,"B",AMQQSQST,""))

 +1        SET AMQQSQZF(2)=$SELECT($DATA(X):X,1:-1)

 +2        SET DIC("S")="D EVAL^AMQQSQAC"

 +3        QUIT 

 +4       ;

EVAL      ; ENTRY POINT FOR DIC("S") OF ^AMQQ(5) LOOKUP

 +1        IF Y>1000

               XECUTE "I 0"

               QUIT 

 +2        IF "^59^316^317^318^"[(U_Y_U)

               XECUTE "I 0"

               QUIT 

 +3        IF $GET(AMQQSQSN)=617

               IF $PIECE(^(0),U,4)=51

                   QUIT 

 +4        IF $PIECE(^AMQQ(5,Y,0),U,20)="M"

               IF '$DATA(AMQQSQSN)!('$DATA(^(5)))

                   QUIT 

 +5        IF $PIECE(^AMQQ(5,Y,0),U,20)="V"

               QUIT 

 +6        IF $PIECE(^AMQQ(5,Y,0),U,20)="M"

               IF $GET(AMQQSQSN)'=$PIECE(^AMQQ(5,Y,5),U)

                   QUIT 

 +7        IF $PIECE(^AMQQ(5,Y,0),U,20)="L"

               IF $PIECE($GET(^MCAR(690.99,+$GET(AMQQSQSN),2)),U,4)=7

                   IF $PIECE($GET(^AUTTDXPR(Y,0)),U,6)

                       IF $PIECE($GET(^AMQQ(5,Y,5)),U,2)

                           IF $PIECE(^AMQQ(5,Y,5),U,2)=$PIECE($GET(^AMQQ(5,AMQQSQSN,5)),U,2)

                               IF $PIECE(^AMQQ(1,$PIECE(^AMQQ(5,Y,0),U,5),0),U,2)=2

                                   SET AMQQSQLF=""

                                   QUIT 

 +8        IF $PIECE(^AMQQ(5,Y,0),U,20)="L"

               IF +$GET(^AMQQ(5,Y,5))=AMQQSQSN

                   IF $PIECE(^AMQQ(1,$PIECE(^AMQQ(5,Y,0),U,5),0),U,2)'=2

                       QUIT 

 +9        IF $PIECE(^AMQQ(5,Y,0),U,21)=16

               QUIT 

 +10       IF $PIECE(^AMQQ(5,Y,0),U,21)=AMQQSQZF(1)

               QUIT 

 +11       IF $PIECE(^AMQQ(5,Y,0),U,21)=7

               QUIT 

 +12       IF $PIECE(^AMQQ(5,Y,0),U,4)=AMQQSQZF(2)

               QUIT 

 +13       QUIT 

 +14      ;