- 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 ;
