AMQQCMPS ; IHS/CMI/THL - SAVE AND RESTORE Q-MAN SEARCH CODE FROM THE SCRIPT FILE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
SAVE S AMQQCPLN=0
K ^AMQQ(2,+AMQQYY,2)
S X="AMQV("""")"
F S X=$Q(@X) Q:$E(X,1,4)'="AMQV" S Z="C;"_X_";"_@X D SET
F X=0:0 S X=$O(^UTILITY("AMQQ TAX",$J,X)) Q:'X S Y="" F S Y=$O(^UTILITY("AMQQ TAX",$J,X,Y)) Q:Y="" S Z="T;"_X_";"_Y D SET
F X=0:0 S X=$O(^UTILITY("AMQQ",$J,"VAR NAME",X)) Q:'X S Z="V;"_X_";"_^(X) D SET
F X=0:0 S X=$O(^UTILITY("AMQQ",$J,"LIST",X)) Q:'X S Z="L;"_X_";"_^(X) D SET
S ^AMQQ(2,+AMQQYY,2,0)=U_U_+AMQQCPLN_U_AMQQCPLN_U_DT_U_U
EXIT K X,Y,Z,AMQQCPLN,%,A,I
Q
;
SET S AMQQCPLN=AMQQCPLN+1
S ^AMQQ(2,+AMQQYY,2,AMQQCPLN,0)=Z
Q
;
RESTORE ; ENTRY POINT FROM AMQQQE
F AMQQCPLN=0:0 S AMQQCPLN=$O(^AMQQ(2,+AMQQYY,2,AMQQCPLN)) Q:'AMQQCPLN S Z=^(AMQQCPLN,0) D @$P(Z,";")
REXIT K AMQQCPLN,X,Y,Z
Q
;
C S @$P(Z,";",2)=$P(Z,";",3,99)
Q
;
T S ^UTILITY("AMQQ TAX",$J,$P(Z,";",2),$P(Z,";",3))=""
Q
;
V S ^UTILITY("AMQQ",$J,"VAR NAME",$P(Z,";",2))=$P(Z,";",3,99)
Q
;
L S ^UTILITY("AMQQ",$J,"LIST",$P(Z,";",2))=$P(Z,";",3,99)
Q
;
M S @("^AMQQ(1,"_$P(Z,";",2))=$P(Z,";",3,99)
Q
;
OUTPUT ; - EP -
N X,Y,Z,%,A,I,AMQQYYI,AMQQYYX
I $D(@(AMQQYY_"0)")) G LIST
S AMQQYYN=0
S AMQQYYG=AMQQYY_"AMQQYYN)"
S %="DFN"
S X=0
F S X=$O(^UTILITY("AMQQ",$J,"VAR NAME",X)) Q:'X S Y=^(X),%=%_U_$P(^AMQQ(1,+Y,4,$P(Y,U,2),0),U)
S @AMQQYYG=%
LIST I '$D(^DPT(AMQP(0),0)) Q
S AMQQYYS=AMQP(0)
I $G(AMQQMULL),$D(^UTILITY("AMQQ",$J,"AG",AMQQMULL)) D MLIST Q
D LSET
Q
;
LSET F AMQQYYI=9:0 S AMQQYYI=$O(^UTILITY("AMQQ",$J,"VAR NAME",AMQQYYI)) Q:'AMQQYYI S Y=^(AMQQYYI),X=AMQP(AMQQYYI) D TRANS S AMQQYYS=AMQQYYS_U_X
S AMQQYYN=AMQQYYN+1
S @AMQQYYG=AMQQYYS
Q
;
TRANS I X="+"!(X="-")!(X="") Q
I +Y=7 S X=(DT-X)\10000 Q
I +Y,$P(Y,U,2),$D(^AMQQ(1,+Y,4,$P(Y,U,2),1)) N % X ^(1)
Q
;
MLIST F AMQQHOLD=0:0 S AMQQHOLD=$O(^UTILITY("AMQQ",$J,"AG",AMQQMULL,AMQQHOLD)) Q:'AMQQHOLD S AMQQYYAG=^(AMQQHOLD) D M1
K AMQQHOLD,^UTILITY("AMQQ",$J,"AG",AMQQMULL),X,Y,A,I,%,AMQQYYAG
Q
;
M1 S AMQQYYX=AMQQMUFV-1
F AMQQYYI=1:1:AMQQMUNV S AMQQYYX=$O(^UTILITY("AMQQ",$J,"VAR NAME",AMQQYYX)) Q:'AMQQYYX S Y=^(AMQQYYX),A=$P(Y,U,2) I A S AMQP(AMQQYYX)=$P(AMQQYYAG,U,A)
S AMQQYYS=AMQP(0)
D LSET
Q
;
AMQQCMPS ; IHS/CMI/THL - SAVE AND RESTORE Q-MAN SEARCH CODE FROM THE SCRIPT FILE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
SAVE SET AMQQCPLN=0
+1 KILL ^AMQQ(2,+AMQQYY,2)
+2 SET X="AMQV("""")"
+3 FOR
SET X=$QUERY(@X)
IF $EXTRACT(X,1,4)'="AMQV"
QUIT
SET Z="C;"_X_";"_@X
DO SET
+4 FOR X=0:0
SET X=$ORDER(^UTILITY("AMQQ TAX",$JOB,X))
IF 'X
QUIT
SET Y=""
FOR
SET Y=$ORDER(^UTILITY("AMQQ TAX",$JOB,X,Y))
IF Y=""
QUIT
SET Z="T;"_X_";"_Y
DO SET
+5 FOR X=0:0
SET X=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",X))
IF 'X
QUIT
SET Z="V;"_X_";"_^(X)
DO SET
+6 FOR X=0:0
SET X=$ORDER(^UTILITY("AMQQ",$JOB,"LIST",X))
IF 'X
QUIT
SET Z="L;"_X_";"_^(X)
DO SET
+7 SET ^AMQQ(2,+AMQQYY,2,0)=U_U_+AMQQCPLN_U_AMQQCPLN_U_DT_U_U
EXIT KILL X,Y,Z,AMQQCPLN,%,A,I
+1 QUIT
+2 ;
SET SET AMQQCPLN=AMQQCPLN+1
+1 SET ^AMQQ(2,+AMQQYY,2,AMQQCPLN,0)=Z
+2 QUIT
+3 ;
RESTORE ; ENTRY POINT FROM AMQQQE
+1 FOR AMQQCPLN=0:0
SET AMQQCPLN=$ORDER(^AMQQ(2,+AMQQYY,2,AMQQCPLN))
IF 'AMQQCPLN
QUIT
SET Z=^(AMQQCPLN,0)
DO @$PIECE(Z,";")
REXIT KILL AMQQCPLN,X,Y,Z
+1 QUIT
+2 ;
C SET @$PIECE(Z,";",2)=$PIECE(Z,";",3,99)
+1 QUIT
+2 ;
T SET ^UTILITY("AMQQ TAX",$JOB,$PIECE(Z,";",2),$PIECE(Z,";",3))=""
+1 QUIT
+2 ;
V SET ^UTILITY("AMQQ",$JOB,"VAR NAME",$PIECE(Z,";",2))=$PIECE(Z,";",3,99)
+1 QUIT
+2 ;
L SET ^UTILITY("AMQQ",$JOB,"LIST",$PIECE(Z,";",2))=$PIECE(Z,";",3,99)
+1 QUIT
+2 ;
M SET @("^AMQQ(1,"_$PIECE(Z,";",2))=$PIECE(Z,";",3,99)
+1 QUIT
+2 ;
OUTPUT ; - EP -
+1 NEW X,Y,Z,%,A,I,AMQQYYI,AMQQYYX
+2 IF $DATA(@(AMQQYY_"0)"))
GOTO LIST
+3 SET AMQQYYN=0
+4 SET AMQQYYG=AMQQYY_"AMQQYYN)"
+5 SET %="DFN"
+6 SET X=0
+7 FOR
SET X=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",X))
IF 'X
QUIT
SET Y=^(X)
SET %=%_U_$PIECE(^AMQQ(1,+Y,4,$PIECE(Y,U,2),0),U)
+8 SET @AMQQYYG=%
LIST IF '$DATA(^DPT(AMQP(0),0))
QUIT
+1 SET AMQQYYS=AMQP(0)
+2 IF $GET(AMQQMULL)
IF $DATA(^UTILITY("AMQQ",$JOB,"AG",AMQQMULL))
DO MLIST
QUIT
+3 DO LSET
+4 QUIT
+5 ;
LSET FOR AMQQYYI=9:0
SET AMQQYYI=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",AMQQYYI))
IF 'AMQQYYI
QUIT
SET Y=^(AMQQYYI)
SET X=AMQP(AMQQYYI)
DO TRANS
SET AMQQYYS=AMQQYYS_U_X
+1 SET AMQQYYN=AMQQYYN+1
+2 SET @AMQQYYG=AMQQYYS
+3 QUIT
+4 ;
TRANS IF X="+"!(X="-")!(X="")
QUIT
+1 IF +Y=7
SET X=(DT-X)\10000
QUIT
+2 IF +Y
IF $PIECE(Y,U,2)
IF $DATA(^AMQQ(1,+Y,4,$PIECE(Y,U,2),1))
NEW %
XECUTE ^(1)
+3 QUIT
+4 ;
MLIST FOR AMQQHOLD=0:0
SET AMQQHOLD=$ORDER(^UTILITY("AMQQ",$JOB,"AG",AMQQMULL,AMQQHOLD))
IF 'AMQQHOLD
QUIT
SET AMQQYYAG=^(AMQQHOLD)
DO M1
+1 KILL AMQQHOLD,^UTILITY("AMQQ",$JOB,"AG",AMQQMULL),X,Y,A,I,%,AMQQYYAG
+2 QUIT
+3 ;
M1 SET AMQQYYX=AMQQMUFV-1
+1 FOR AMQQYYI=1:1:AMQQMUNV
SET AMQQYYX=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",AMQQYYX))
IF 'AMQQYYX
QUIT
SET Y=^(AMQQYYX)
SET A=$PIECE(Y,U,2)
IF A
SET AMQP(AMQQYYX)=$PIECE(AMQQYYAG,U,A)
+2 SET AMQQYYS=AMQP(0)
+3 DO LSET
+4 QUIT
+5 ;
