AMQQQE ; IHS/CMI/THL - SCRIPT EDITOR ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
LOOP F D SEL I $D(AMQQQUIT) Q
Q
;
SEL S Y=5
D CHKOUT I Q
I Y=-1 Q
I Y=0 S AMQQQUIT="" Q
W !!
D @$P("COPY^EDIT^IMPORT^PURGE^RUN^VIEW^WRITE^^HELPME",U,Y)
Q
EXIT K X,Y,%,%Y,AMQQXX,AMQQYY,AMQQFAIL,I
Q
;
WRITE S DIR("A")="Script name"
K AMQQFAIL
W1 W !
S DIR(0)="9009072,.01"
D ^DIR
K DIR
D CHKOUT
I Q
CR1 ; ENTRY POINT FROM AMQQE1
S Y=$O(^AMQQ(2,"B",X,""))
S Y=$S('Y:-1,1:(Y_U_X))
I Y=-1 D ADD Q
I DUZ'=$P(^AMQQ(2,+Y,0),U,2) W !!,*7,"This script already exists...Try another name.",!! G WRITE
W !!,*7,"This script already exists. Want to overwrite"
S %=2
D YN^DICN
I $D(DTOUT)+$D(DUOUT) Q
I "Nn"[$E(%Y) W ! G WRITE
S DIK="^AMQQ(2,"
S DA=+Y
S AMQQQENA=$P(Y,U,2)
D ^DIK
K DIK,DA,DIC
S X=AMQQQENA
K AMQQQENA
ADD W !!
S DIC="^AMQQ(2,"
S DIC(0)="L"
S DIC("DR")="1////"_DUZ_";2///"_DT_";5"
I $D(AMQQESN) S DIC("DR")="1////"_DUZ_";2///"_DT
D ^DIC
K DIC
I $D(AMQQESN) Q
I $D(DUOUT)+$D(DTOUT)+(Y=-1) K DUOUT,DTOUT Q
I '$P($G(^AMQQ(2,+Y,1,0)),U,4) S AMQQQUIT="" Q
COMPILE ; ENTRY POINT FROM ^AMQQQE1
S AMQQXX="^AMQQ(2,"_+Y_",1,"
S AMQQYY=Y
W !!
D WAIT^DICD
W !!
D SEARCH^AMQQ
I $D(AMQQFAIL) D FAIL K AMQQFAIL S AMQQQUIT="" G PAUSE
I $D(AMQQQUIT) Q
W !,"OK, I have saved your script """,$P(AMQQYY,U,2),""" and its compiled"
W !,"search code in the Q-Man Script file. It is ready for use at any time!"
PAUSE W !!! S DIR(0)="E" D ^DIR K DIR
Q
;
FAIL S %=AMQQFAIL
S %=$S(%<5:"SUBJECT",%=5:"TAXONOMY",%=6:"ATTRIBUTE",%=7:"CONDITION",8:"VALUE",9:"OR GROUP",1:"SUBQUERY")
W !!,"Script error detected...Unable to compile...Request terminated"
W !,"Source of error: ",%,!,"Use the EDIT function to correct script error.",*7
K AMQQFAIL
Q
;
HELPME W !!!,"Select a code from the list or type '??' for more information",!!
S DIR(0)="E"
D ^DIR
K DIR
Q
;
CHK ; ENTRY POINT FROM AMQQE1
I +Y,$P($G(^AMQQ(2,+Y,0)),U,2)'=DUZ
Q
;
GET S DIC("A")="Enter the name of the Q-Man script: "
K AMQQFAIL
GET1 S DIC="^AMQQ(2,"
S DIC(0)="AEQ"
S DIC("S")="I $P($G(^AMQQ(2,Y,1,0)),U,4)"
D ^DIC
K DIC
CHKOUT I $D(DTOUT)+$D(DUOUT)+(Y=-1) K DIRUT,DUOUT,DTOUT S AMQQQUIT="" Q
I Y="" S Y=-1 Q
Q
;
RUN ;EP;TO RUN A SCRIPT
W:$D(IOF) @IOF
S DIC("A")="Enter the name of the search logic to be run: "
S DIC="^AMQQ(2,"
S DIC(0)="AEQ"
D ^DIC
K DIC
D CHKOUT
I Q
D RUN^AMQQQE1
Q
;
PURGE D GET
Q:$T
D PURGE^AMQQQE1
Q
;
VIEW D GET
I Q
S (I,%)=0
F S %=$O(^AMQQ(2,+Y,1,%)) Q:'% S I=I+1,Z="" W ! X:'(I#(IOSL-4)) "I I>1 W ""<>"" R Z:DTIME S:'$T Z=U W $C(13),?9,$C(13)" Q:Z=U W ^(%,0)
W !!
S DIR(0)="E"
D ^DIR
K DIR
Q
;
IMPORT D IMPORT^AMQQQE1
Q
;
EDIT D GET
Q:$T
D EDIT^AMQQQE1
Q
;
COPY S DIC("A")="Copy from what script: "
D GET1
Q:$T
D COPY^AMQQQE1
Q
;
STORE ; ENTRY POINT FROM AMQQCMPL
S DIR("A")="Store logic under what name"
S AMQQESN=""
D W1
I $D(AMQQQUIT) Q
K AMQQESN
S AMQQCPLF=""
S AMQQYY=Y
W "OK, I will store this search logic for future use.",!!!
H 2
Q
;
AMQQQE ; IHS/CMI/THL - SCRIPT EDITOR ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
LOOP FOR
DO SEL
IF $DATA(AMQQQUIT)
QUIT
+1 QUIT
+2 ;
SEL SET Y=5
+1 DO CHKOUT
IF $TEST
QUIT
+2 IF Y=-1
QUIT
+3 IF Y=0
SET AMQQQUIT=""
QUIT
+4 WRITE !!
+5 DO @$PIECE("COPY^EDIT^IMPORT^PURGE^RUN^VIEW^WRITE^^HELPME",U,Y)
+6 QUIT
EXIT KILL X,Y,%,%Y,AMQQXX,AMQQYY,AMQQFAIL,I
+1 QUIT
+2 ;
WRITE SET DIR("A")="Script name"
+1 KILL AMQQFAIL
W1 WRITE !
+1 SET DIR(0)="9009072,.01"
+2 DO ^DIR
+3 KILL DIR
+4 DO CHKOUT
+5 IF $TEST
QUIT
CR1 ; ENTRY POINT FROM AMQQE1
+1 SET Y=$ORDER(^AMQQ(2,"B",X,""))
+2 SET Y=$SELECT('Y:-1,1:(Y_U_X))
+3 IF Y=-1
DO ADD
QUIT
+4 IF DUZ'=$PIECE(^AMQQ(2,+Y,0),U,2)
WRITE !!,*7,"This script already exists...Try another name.",!!
GOTO WRITE
+5 WRITE !!,*7,"This script already exists. Want to overwrite"
+6 SET %=2
+7 DO YN^DICN
+8 IF $DATA(DTOUT)+$DATA(DUOUT)
QUIT
+9 IF "Nn"[$EXTRACT(%Y)
WRITE !
GOTO WRITE
+10 SET DIK="^AMQQ(2,"
+11 SET DA=+Y
+12 SET AMQQQENA=$PIECE(Y,U,2)
+13 DO ^DIK
+14 KILL DIK,DA,DIC
+15 SET X=AMQQQENA
+16 KILL AMQQQENA
ADD WRITE !!
+1 SET DIC="^AMQQ(2,"
+2 SET DIC(0)="L"
+3 SET DIC("DR")="1////"_DUZ_";2///"_DT_";5"
+4 IF $DATA(AMQQESN)
SET DIC("DR")="1////"_DUZ_";2///"_DT
+5 DO ^DIC
+6 KILL DIC
+7 IF $DATA(AMQQESN)
QUIT
+8 IF $DATA(DUOUT)+$DATA(DTOUT)+(Y=-1)
KILL DUOUT,DTOUT
QUIT
+9 IF '$PIECE($GET(^AMQQ(2,+Y,1,0)),U,4)
SET AMQQQUIT=""
QUIT
COMPILE ; ENTRY POINT FROM ^AMQQQE1
+1 SET AMQQXX="^AMQQ(2,"_+Y_",1,"
+2 SET AMQQYY=Y
+3 WRITE !!
+4 DO WAIT^DICD
+5 WRITE !!
+6 DO SEARCH^AMQQ
+7 IF $DATA(AMQQFAIL)
DO FAIL
KILL AMQQFAIL
SET AMQQQUIT=""
GOTO PAUSE
+8 IF $DATA(AMQQQUIT)
QUIT
+9 WRITE !,"OK, I have saved your script """,$PIECE(AMQQYY,U,2),""" and its compiled"
+10 WRITE !,"search code in the Q-Man Script file. It is ready for use at any time!"
PAUSE WRITE !!!
SET DIR(0)="E"
DO ^DIR
KILL DIR
+1 QUIT
+2 ;
FAIL SET %=AMQQFAIL
+1 SET %=$SELECT(%<5:"SUBJECT",%=5:"TAXONOMY",%=6:"ATTRIBUTE",%=7:"CONDITION",8:"VALUE",9:"OR GROUP",1:"SUBQUERY")
+2 WRITE !!,"Script error detected...Unable to compile...Request terminated"
+3 WRITE !,"Source of error: ",%,!,"Use the EDIT function to correct script error.",*7
+4 KILL AMQQFAIL
+5 QUIT
+6 ;
HELPME WRITE !!!,"Select a code from the list or type '??' for more information",!!
+1 SET DIR(0)="E"
+2 DO ^DIR
+3 KILL DIR
+4 QUIT
+5 ;
CHK ; ENTRY POINT FROM AMQQE1
+1 IF +Y
IF $PIECE($GET(^AMQQ(2,+Y,0)),U,2)'=DUZ
+2 QUIT
+3 ;
GET SET DIC("A")="Enter the name of the Q-Man script: "
+1 KILL AMQQFAIL
GET1 SET DIC="^AMQQ(2,"
+1 SET DIC(0)="AEQ"
+2 SET DIC("S")="I $P($G(^AMQQ(2,Y,1,0)),U,4)"
+3 DO ^DIC
+4 KILL DIC
CHKOUT IF $DATA(DTOUT)+$DATA(DUOUT)+(Y=-1)
KILL DIRUT,DUOUT,DTOUT
SET AMQQQUIT=""
QUIT
+1 IF Y=""
SET Y=-1
QUIT
+2 QUIT
+3 ;
RUN ;EP;TO RUN A SCRIPT
+1 IF $DATA(IOF)
WRITE @IOF
+2 SET DIC("A")="Enter the name of the search logic to be run: "
+3 SET DIC="^AMQQ(2,"
+4 SET DIC(0)="AEQ"
+5 DO ^DIC
+6 KILL DIC
+7 DO CHKOUT
+8 IF $TEST
QUIT
+9 DO RUN^AMQQQE1
+10 QUIT
+11 ;
PURGE DO GET
+1 IF $TEST
QUIT
+2 DO PURGE^AMQQQE1
+3 QUIT
+4 ;
VIEW DO GET
+1 IF $TEST
QUIT
+2 SET (I,%)=0
+3 FOR
SET %=$ORDER(^AMQQ(2,+Y,1,%))
IF '%
QUIT
SET I=I+1
SET Z=""
WRITE !
IF '(I#(IOSL-4))
XECUTE "I I>1 W ""<>"" R Z:DTIME S:'$T Z=U W $C(13),?9,$C(13)"
IF Z=U
QUIT
WRITE ^(%,0)
+4 WRITE !!
+5 SET DIR(0)="E"
+6 DO ^DIR
+7 KILL DIR
+8 QUIT
+9 ;
IMPORT DO IMPORT^AMQQQE1
+1 QUIT
+2 ;
EDIT DO GET
+1 IF $TEST
QUIT
+2 DO EDIT^AMQQQE1
+3 QUIT
+4 ;
COPY SET DIC("A")="Copy from what script: "
+1 DO GET1
+2 IF $TEST
QUIT
+3 DO COPY^AMQQQE1
+4 QUIT
+5 ;
STORE ; ENTRY POINT FROM AMQQCMPL
+1 SET DIR("A")="Store logic under what name"
+2 SET AMQQESN=""
+3 DO W1
+4 IF $DATA(AMQQQUIT)
QUIT
+5 KILL AMQQESN
+6 SET AMQQCPLF=""
+7 SET AMQQYY=Y
+8 WRITE "OK, I will store this search logic for future use.",!!!
+9 HANG 2
+10 QUIT
+11 ;
