AMQQSEC.m

AMQQSEC ; IHS/CMI/THL - CHECK SECURITY ACCESS FOR ATTRIBUTES ;

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

 ;-----

 I $D(Y),+Y,$D(^AMQQ(5,+Y,0)),$P(^(0),U,19)'="C" Q

 I $$KEYCHECK^AMQQUTIL("AMQQZCLIN") Q

 S Y=-1

 I '$D(AMQQNECO) W !,"Sorry, you do not have the security clearance to use this attribute",*7 Q

 S AMQQFAIL=8

 Q

 ;

PRINT ; ENTRY POINT FROM AMQQCMPL

 N X,Y,Z,%

 S Z=DUZ(2)

 S %=$P($G(^AMQQ(8,Z,0)),U,10)

 I %="" Q

 S Y=$P(^AMQQ(8,Z,0),U,9)

 S X=$O(^%ZIS(1,"C",IO,""))

 I 'X Q

 I Y="P" S Y=^%ZIS(1,X,"SUBTYPE"),Y=$P(^%ZIS(2,Y,0),U) I Y'["P-" Q

 I %="I",$D(^AMQQ(8,Z,1,"B",X)) Q

 I %="I" X "I 0" Q

 I '$D(^AMQQ(8,Z,1,"B",X)) Q

 I 0

 Q

 ;

AMQQSEC   ; IHS/CMI/THL - CHECK SECURITY ACCESS FOR ATTRIBUTES ;

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

 +2       ;-----

 +3        IF $DATA(Y)

               IF +Y

                   IF $DATA(^AMQQ(5,+Y,0))

                       IF $PIECE(^(0),U,19)'="C"

                           QUIT 

 +4        IF $$KEYCHECK^AMQQUTIL("AMQQZCLIN")

               QUIT 

 +5        SET Y=-1

 +6        IF '$DATA(AMQQNECO)

               WRITE !,"Sorry, you do not have the security clearance to use this attribute",*7

               QUIT 

 +7        SET AMQQFAIL=8

 +8        QUIT 

 +9       ;

PRINT     ; ENTRY POINT FROM AMQQCMPL

 +1        NEW X,Y,Z,%

 +2        SET Z=DUZ(2)

 +3        SET %=$PIECE($GET(^AMQQ(8,Z,0)),U,10)

 +4        IF %=""

               QUIT 

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

 +6        SET X=$ORDER(^%ZIS(1,"C",IO,""))

 +7        IF 'X

               QUIT 

 +8        IF Y="P"

               SET Y=^%ZIS(1,X,"SUBTYPE")

               SET Y=$PIECE(^%ZIS(2,Y,0),U)

               IF Y'["P-"

                   QUIT 

 +9        IF %="I"

               IF $DATA(^AMQQ(8,Z,1,"B",X))

                   QUIT 

 +10       IF %="I"

               XECUTE "I 0"

               QUIT 

 +11       IF '$DATA(^AMQQ(8,Z,1,"B",X))

               QUIT 

 +12       IF 0

 +13       QUIT 

 +14      ;