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
