- 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