AMQQQE1.m

AMQQQE1 ; IHS/CMI/THL - AMQQQE SUBROUTINE...GETS OVERFLOW ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;-----

CHKOUT I $D(DTOUT)+$D(DUOUT)+(Y=-1)+(Y="") K DIRUT,DUOUT,DTOUT S AMQQQUIT="" Q

 Q

 ;

IMPORT ; ENTRY POINT FROM AMQQQE

 S DIR(0)="PO^1:EMQ"

 S DIR("A")="Enter file name"

 S DIR("?")="Enter the name of the file which has the word processing field."

 D ^DIR

 K DIR

 D CHKOUT

 I  Q

 S AMQQEFIL=Y

 S DIR(0)="PO^DD("_+Y_",:EMQ"

 S DIR("A")="Enter field name"

 S DIR("?")="Enter the name of the word processing field which has the script to be imported."

 D ^DIR

 K DIR

 D CHKOUT

 I  Q

 S AMQQEFLD=Y

 S DIR(0)="PO^"_+AMQQEFIL_":EMQ"

 S DIR("A")="Enter source file script name"

 S DIR("?")="Enter source file script name"

 D ^DIR

 K DIR

 D CHKOUT I  Q

 S AMQQESN=Y

 S DIR(0)="FO^3:30"

 S DIR("A")="Enter the new script name"

 S DIR("B")=$P(AMQQESN,U,2)

 S DIR("?")="You may enter a new name or press RETURN to keep the old one."

 D ^DIR

 K DIR

 D CHKOUT

 I  Q

 S AMQQETN=Y

 S X=AMQQETN

 D CR1^AMQQQE

 I Y=-1 Q

 S AMQQETE=Y

 D STUFF

 S Y=AMQQETE

 D COMPILE^AMQQQE

 K AMQQEFLD,AMQQEFIL,AMQQETE,AMQQESN,AMQQETN,%,Z,G,X

 Q

 ;

STUFF S %=+$P(^DD(+AMQQEFIL,+AMQQEFLD,0),U,4)

 S G=^DIC(+AMQQEFIL,0,"GL")_+AMQQESN_","_%_")"

 S Z="^AMQQ(2,"_+AMQQETE_",1)"

 S @Z@(0)=@G@(0)

 F X=0:0 S X=$O(@G@(X)) Q:'X  S @Z@(X,0)=@G@(X,0)

 Q

 ;

COPY ; ENTRY POINT FROM AMQQQE

C1 S AMQQESN=Y

 S DIR(0)="FO^3:30"

 S DIR("A")="Enter the new script name"

 D ^DIR

 K DIR

 D CHKOUT

 I  Q

 S (X,AMQQETN)=Y

 D CR1^AMQQQE

 I Y=-1 Q

 S AMQQETN=Y

 F N=1,2 D CRAM

 K AMQQESN,AMQQETN,Z,G,%,X

 W !!!,"Copy successfully completed.",!!

 S DIR(0)="E"

 D ^DIR

 K DIR

 Q

 ;

CRAM S G="^AMQQ(2,"_+AMQQESN_",N)"

 S Z="^AMQQ(2,"_+AMQQETN_",N)"

 I '$D(@G) Q

 S @Z@(0)=@G@(0)

 F X=0:0 S X=$O(@G@(X)) Q:'X  S @Z@(X,0)=@G@(X,0)

 Q

 ;

EDIT ; ENTRY POINT FROM AMQQQE

 S AMQQEE=Y

 D CHK^AMQQQE

 I  D FIX Q

 W !!!

 S DA=+AMQQEE

 S DR=5

 S DIE="^AMQQ(2,"

 D ^DIE

 K DIC,DIE,DA,DR,DO

 S Y=AMQQEE

 D COMPILE^AMQQQE

 K AMQQEE

 Q

 ;

FIX W !!,"This script was created by someone else.  If you want to edit it, you must"

 W !,"first copy it into a new name."

 W !!,"Want to copy it"

 S %=0

 D YN^DICN

 D CHKOUT

 I  Q

 I "Nn"[$E(%Y) Q

 W !!

 S Y=AMQQEE

 D C1

 Q

 ;

PURGE ; ENTRY POINT FROM AMQQQE

 D CHK^AMQQQE

 I  W !!,"Sorry...You cannot remove a script that was written by another person.",!!!!,*7 S DIR(0)="E" D ^DIR K DIR Q

 W !,"Are you sure you want to remove ",$P(Y,U,2)

 S %=0

 D YN^DICN

 D CHKOUT

 I  Q

 I "nN"[$E(%Y) Q

 S DA=+Y

 S DIK="^AMQQ(2,"

 D ^DIK

 K DIK,DA,DIC,%,%Y,X,Y

 W !!,"Script cancelled....",!

 Q

 ;

RUN ; ENTRY POINT FROM AMQQQE

 S AMQQYY=Y

 I '$P($G(^AMQQ(2,+Y,2,0)),U,4) W !!,"Sorry, for some reason I can't find the compiled version of this script!?!",!!!,*7 H 3 Q

 K AMQV,^UTILITY("AMQQ",$J),^UTILITY("AMQQ TAX",$J)

 D RESTORE^AMQQCMPS

 I '$D(AMQV(1)) Q

 S AMQQCCLS=$E($P(AMQV(0),"AMQQCCLS=""",2))

 I '$D(AMQQSURV) S AMQQCPLF="" K AMQV("OPTION") D OUTPUT^AMQQOPT K AMQQCPLF

 I $D(AMQQSURV) X AMQV(0) Q

 I $D(AMQQQUIT) Q

 I Y=-1,$G(AMQV("OPTION"))'="" D DOIT^AMQQCMPL Q

 I Y=-1 Q

 S AMQV("OPTION")=$P("LIST^PRINT^COUNT^COHORT^STORE^RMAN",U,Y)

 D DOIT^AMQQCMPL

 Q

 ;

EXTERNAL ; ENTRY POINT FOR EXTERNAL SCRIPT DRIVER

 D VAL^AMQQQ

 I $D(AMQQFAIL) Q

 Q

AMQQQE1   ; IHS/CMI/THL - AMQQQE SUBROUTINE...GETS OVERFLOW ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;-----

CHKOUT     IF $DATA(DTOUT)+$DATA(DUOUT)+(Y=-1)+(Y="")

               KILL DIRUT,DUOUT,DTOUT

               SET AMQQQUIT=""

               QUIT 

 +1        QUIT 

 +2       ;

IMPORT    ; ENTRY POINT FROM AMQQQE

 +1        SET DIR(0)="PO^1:EMQ"

 +2        SET DIR("A")="Enter file name"

 +3        SET DIR("?")="Enter the name of the file which has the word processing field."

 +4        DO ^DIR

 +5        KILL DIR

 +6        DO CHKOUT

 +7       IF $TEST

               QUIT 

 +8        SET AMQQEFIL=Y

 +9        SET DIR(0)="PO^DD("_+Y_",:EMQ"

 +10       SET DIR("A")="Enter field name"

 +11       SET DIR("?")="Enter the name of the word processing field which has the script to be imported."

 +12       DO ^DIR

 +13       KILL DIR

 +14       DO CHKOUT

 +15      IF $TEST

               QUIT 

 +16       SET AMQQEFLD=Y

 +17       SET DIR(0)="PO^"_+AMQQEFIL_":EMQ"

 +18       SET DIR("A")="Enter source file script name"

 +19       SET DIR("?")="Enter source file script name"

 +20       DO ^DIR

 +21       KILL DIR

 +22       DO CHKOUT

          IF $TEST

               QUIT 

 +23       SET AMQQESN=Y

 +24       SET DIR(0)="FO^3:30"

 +25       SET DIR("A")="Enter the new script name"

 +26       SET DIR("B")=$PIECE(AMQQESN,U,2)

 +27       SET DIR("?")="You may enter a new name or press RETURN to keep the old one."

 +28       DO ^DIR

 +29       KILL DIR

 +30       DO CHKOUT

 +31      IF $TEST

               QUIT 

 +32       SET AMQQETN=Y

 +33       SET X=AMQQETN

 +34       DO CR1^AMQQQE

 +35       IF Y=-1

               QUIT 

 +36       SET AMQQETE=Y

 +37       DO STUFF

 +38       SET Y=AMQQETE

 +39       DO COMPILE^AMQQQE

 +40       KILL AMQQEFLD,AMQQEFIL,AMQQETE,AMQQESN,AMQQETN,%,Z,G,X

 +41       QUIT 

 +42      ;

STUFF      SET %=+$PIECE(^DD(+AMQQEFIL,+AMQQEFLD,0),U,4)

 +1        SET G=^DIC(+AMQQEFIL,0,"GL")_+AMQQESN_","_%_")"

 +2        SET Z="^AMQQ(2,"_+AMQQETE_",1)"

 +3        SET @Z@(0)=@G@(0)

 +4        FOR X=0:0

               SET X=$ORDER(@G@(X))

               IF 'X

                   QUIT 

               SET @Z@(X,0)=@G@(X,0)

 +5        QUIT 

 +6       ;

COPY      ; ENTRY POINT FROM AMQQQE

C1         SET AMQQESN=Y

 +1        SET DIR(0)="FO^3:30"

 +2        SET DIR("A")="Enter the new script name"

 +3        DO ^DIR

 +4        KILL DIR

 +5        DO CHKOUT

 +6       IF $TEST

               QUIT 

 +7        SET (X,AMQQETN)=Y

 +8        DO CR1^AMQQQE

 +9        IF Y=-1

               QUIT 

 +10       SET AMQQETN=Y

 +11       FOR N=1,2

               DO CRAM

 +12       KILL AMQQESN,AMQQETN,Z,G,%,X

 +13       WRITE !!!,"Copy successfully completed.",!!

 +14       SET DIR(0)="E"

 +15       DO ^DIR

 +16       KILL DIR

 +17       QUIT 

 +18      ;

CRAM       SET G="^AMQQ(2,"_+AMQQESN_",N)"

 +1        SET Z="^AMQQ(2,"_+AMQQETN_",N)"

 +2        IF '$DATA(@G)

               QUIT 

 +3        SET @Z@(0)=@G@(0)

 +4        FOR X=0:0

               SET X=$ORDER(@G@(X))

               IF 'X

                   QUIT 

               SET @Z@(X,0)=@G@(X,0)

 +5        QUIT 

 +6       ;

EDIT      ; ENTRY POINT FROM AMQQQE

 +1        SET AMQQEE=Y

 +2        DO CHK^AMQQQE

 +3       IF $TEST

               DO FIX

               QUIT 

 +4        WRITE !!!

 +5        SET DA=+AMQQEE

 +6        SET DR=5

 +7        SET DIE="^AMQQ(2,"

 +8        DO ^DIE

 +9        KILL DIC,DIE,DA,DR,DO

 +10       SET Y=AMQQEE

 +11       DO COMPILE^AMQQQE

 +12       KILL AMQQEE

 +13       QUIT 

 +14      ;

FIX        WRITE !!,"This script was created by someone else.  If you want to edit it, you must"

 +1        WRITE !,"first copy it into a new name."

 +2        WRITE !!,"Want to copy it"

 +3        SET %=0

 +4        DO YN^DICN

 +5        DO CHKOUT

 +6       IF $TEST

               QUIT 

 +7        IF "Nn"[$EXTRACT(%Y)

               QUIT 

 +8        WRITE !!

 +9        SET Y=AMQQEE

 +10       DO C1

 +11       QUIT 

 +12      ;

PURGE     ; ENTRY POINT FROM AMQQQE

 +1        DO CHK^AMQQQE

 +2       IF $TEST

               WRITE !!,"Sorry...You cannot remove a script that was written by another person.",!!!!,*7

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

               QUIT 

 +3        WRITE !,"Are you sure you want to remove ",$PIECE(Y,U,2)

 +4        SET %=0

 +5        DO YN^DICN

 +6        DO CHKOUT

 +7       IF $TEST

               QUIT 

 +8        IF "nN"[$EXTRACT(%Y)

               QUIT 

 +9        SET DA=+Y

 +10       SET DIK="^AMQQ(2,"

 +11       DO ^DIK

 +12       KILL DIK,DA,DIC,%,%Y,X,Y

 +13       WRITE !!,"Script cancelled....",!

 +14       QUIT 

 +15      ;

RUN       ; ENTRY POINT FROM AMQQQE

 +1        SET AMQQYY=Y

 +2        IF '$PIECE($GET(^AMQQ(2,+Y,2,0)),U,4)

               WRITE !!,"Sorry, for some reason I can't find the compiled version of this script!?!",!!!,*7

               HANG 3

               QUIT 

 +3        KILL AMQV,^UTILITY("AMQQ",$JOB),^UTILITY("AMQQ TAX",$JOB)

 +4        DO RESTORE^AMQQCMPS

 +5        IF '$DATA(AMQV(1))

               QUIT 

 +6        SET AMQQCCLS=$EXTRACT($PIECE(AMQV(0),"AMQQCCLS=""",2))

 +7        IF '$DATA(AMQQSURV)

               SET AMQQCPLF=""

               KILL AMQV("OPTION")

               DO OUTPUT^AMQQOPT

               KILL AMQQCPLF

 +8        IF $DATA(AMQQSURV)

               XECUTE AMQV(0)

               QUIT 

 +9        IF $DATA(AMQQQUIT)

               QUIT 

 +10       IF Y=-1

               IF $GET(AMQV("OPTION"))'=""

                   DO DOIT^AMQQCMPL

                   QUIT 

 +11       IF Y=-1

               QUIT 

 +12       SET AMQV("OPTION")=$PIECE("LIST^PRINT^COUNT^COHORT^STORE^RMAN",U,Y)

 +13       DO DOIT^AMQQCMPL

 +14       QUIT 

 +15      ;

EXTERNAL  ; ENTRY POINT FOR EXTERNAL SCRIPT DRIVER

 +1        DO VAL^AMQQQ

 +2        IF $DATA(AMQQFAIL)

               QUIT 

 +3        QUIT