AMQQPIR.m

AMQQPIR ; IHS/CMI/THL - Q-MAN PRE-INIT ROUTINE ;

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

 ;-----

 N X,Y,N,%

LAB K ^UTILITY("AMQQ",$J,"SAVE")

 I $O(^AMQQ(5,1000)) W !!,"One moment please..."

 F X=1000:0 S X=$O(^AMQQ(5,X)) Q:'X  D SAVE W "."

 K ^AMQQ(1),^(5),^(4),^(7)

SET F %=9009071,9009074,9009075,9009077 S ^UTILITY("XBDSET",$J,%)="D^D"

 D EN2^XBKD

 K ^UTILITY("XBDSET",$J)

 Q

 ;

SAVE S Y="^AMQQ(5,"_X_")"

 F N=1:1 S Y=$Q(@Y) Q:$P(Y,",",2)'=X  S ^UTILITY("AMQQ",$J,"SAVE",X,N)=Y_"|"_@Y

 Q

AMQQPIR   ; IHS/CMI/THL - Q-MAN PRE-INIT ROUTINE ;

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

 +2       ;-----

 +3        NEW X,Y,N,%

LAB        KILL ^UTILITY("AMQQ",$JOB,"SAVE")

 +1        IF $ORDER(^AMQQ(5,1000))

               WRITE !!,"One moment please..."

 +2        FOR X=1000:0

               SET X=$ORDER(^AMQQ(5,X))

               IF 'X

                   QUIT 

               DO SAVE

               WRITE "."

 +3        KILL ^AMQQ(1),^(5),^(4),^(7)

SET        FOR %=9009071,9009074,9009075,9009077

               SET ^UTILITY("XBDSET",$JOB,%)="D^D"

 +1        DO EN2^XBKD

 +2        KILL ^UTILITY("XBDSET",$JOB)

 +3        QUIT 

 +4       ;

SAVE       SET Y="^AMQQ(5,"_X_")"

 +1        FOR N=1:1

               SET Y=$QUERY(@Y)

               IF $PIECE(Y,",",2)'=X

                   QUIT 

               SET ^UTILITY("AMQQ",$JOB,"SAVE",X,N)=Y_"|"_@Y

 +2        QUIT