AMQQQE.m

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      ;