XQABGEN ;ISC-SF/JLI - GENERATE ALPHA/BETA TEST INITIALIZATION ROUTINE ;1/21/93 11:50 ;
;;7.1;KERNEL;;May 11, 1993
;;
ENTRY I '$D(DKP) S DIC=9.4,DIC(0)="MAEQ" D ^DIC Q:Y'>0 S DKP=+Y
S DKP(0)=^DIC(9.4,+DKP,0),XQABPKG=$P(DKP(0),U),XQABNMSP=$P(DKP(0),U,2),XQABROU=XQABNMSP_$S($L(XQABNMSP)<4:"INITY",1:"INIY")
K ^TMP($J,"XQAB") S X="XQABMAKE",XCNP=0,DIF="^TMP($J,""XQAB""," X ^%ZOSF("LOAD")
S ^(0)=XQABROU_" "_$P(^TMP($J,"XQAB",1,0)," ",2,200)
S ^TMP($J,"XQAB",XCNP,0)="PKGNAM ;;"_XQABPKG_";",XCNP=XCNP+1
ABTEST W !!,"Is this version of the ",XQABPKG,!?5,"an Alpha or Beta test version (Y/N) ? " R X:DTIME G:'$T!(X[U) KILL S X=$E(X_".") I "NnYy"'[X W $C(7)," ??",!!,"ANSWER EITHER YES OR NO OR '^' TO EXIT" G ABTEST
S XQABTEST=$S("Nn"[X:0,1:1),^TMP($J,"XQAB",XCNP,0)="ABTEST ;;"_$S(XQABTEST:"YES;",1:"NO;"),XCNP=XCNP+1
ADRESS W !!,"Enter as an adressee for installation messages a mailgroup in NETWORK MAIL",!,"format, e.g., G.GROUPNAME@DOMAIN.NAME" W:XQABTEST " This same address will",!,"be used for reports on Alpha/Beta Option Usage"
R !?10,"Addressee: ",X:DTIME G:'$T!(X[U) KILL D UCASE I X'?1"G."1U.E1"@"1U.E W $C(7)," ??" G ADRESS
S XQABADRS=X S X=$P(X,"@",2),DIC=4.2,DIC(0)=$S(X="":"A",1:"")_"EQM" D ^DIC G:Y'>0 ADRESS S XQABADRS=$P(XQABADRS,"@",1)_"@"_$P(Y,U,2),^TMP($J,"XQAB",XCNP,0)="ADRESS ;;"_XQABADRS_";",XCNP=XCNP+1
MESG R !!,"Do you want a message returned upon installation (Y/N) ? ",X:DTIME G:'$T!(X[U) KILL S X=$E(X,1) I "YyNn"'[X W $C(7)," ??",!,"ENTER Y (YES) OR N (NO) OR '^' TO EXIT" G MESG
S ^TMP($J,"XQAB",XCNP,0)="SENMSG ;;"_$S("Yy"[X:"YES",1:"NO")_";",XCNP=XCNP+1
G:'XQABTEST FINISH
VERS R !,"ENTER Version Number: ",X:DTIME I X'?.E1"V"1N.N&(X'?.E1"T"1N.N) W !,"Enter the version number as nVm or nTm where n and m are numbers,",!,"and n may have one decimal place.",!! G VERS
S ^TMP($J,"XQAB",XCNP,0)="VERS ;;"_X_";",XCNP=XCNP+1
S XQABOPT=XQABNMSP,XQABOPTN=1,^TMP($J,"XQAB",XCNP,0)="OPT"_XQABOPTN_" ;;"_XQABOPT_";"
XCLUD W !!,"For the namespace '",XQABOPT,"' are there any namespaces (other than '",XQABOPT,"Z'",!?20,"that should be EXCLUDED (Y/N) ? N// " R X:DTIME G:'$T!(X[U) KILL S:X="" X="N" S X=$E(X_".",1)
I "YyNn"'[X W !!,"ENTER 'Y' OR 'YES' IF SOME OPTIONS BEGINNING WITH '",XQABOPT,"' SHOULD BE",!,"EXCLUDED FROM THE ANALYSIS, E.G., '",XQABOPT,"A'" G XCLUD
I "Yy"[X D XCLUD1
NMSPAC R !!,"Enter ANOTHER namespace used by options in this package: ",X:DTIME G:'$T!(X[U) KILL
I X["?" W !,"If this package supports options with names which begin with ANOTHER namespace",!,"than ",$S(XQABOPTN=1:"that",1:"those")," already entered, then enter THAT namespace now." G NMSPAC
D UCASE I $L(X)<5,X?1U.UN!(X?1"%"1U.UN) S XQABOPTN=XQABOPTN+1,XQABOPT=X,XCNP=XCNP+1 S ^TMP($J,"XQAB",XCNP,0)="OPT"_XQABOPTN_" ;;"_XQABOPT_";" G XCLUD
I X'="" W !,"The namespace or prefix must be four or fewer characters long, beginning",!,"with a letter and followed by letters and/or digits. Enter a RETURN if there",!,"are no additional namespaces to include." G NMSPAC
FINISH S DIE="^TMP($J,""XQAB"",",XCN=0,X=XQABROU X ^%ZOSF("SAVE")
KILL K DIC,DIE,DIF,I,X,XCN,XCNP,XQABADRS,XQABTEST,XQABOPT,XQABNMSP,XQABOPTN,XQABPKG,XQABROU,Y
K ^TMP($J,"XQAB")
Q
UCASE F I=1:1 Q:X'?.E1L.E I $E(X,I)?1L S X=$E(X,1,I-1)_$C($A($E(X,I))-32)_$E(X,I+1,$L(X))
Q
;
XCLUD1 R !!?10,"Enter the FULL namespace or prefix to be excluded: ",X:DTIME Q:'$T!(X[U)!(X="") D UCASE
I $E(X,1,$L(XQABOPT))'=XQABOPT!(X=XQABOPT) W $C(7)," ??",!,"Enter the namespace to exclude as",!?15,"'",XQABOPT,"' followed by one or more letters or digits." G XCLUD1
S ^(0)=^TMP($J,"XQAB",XCNP,0)_X_";" W " OK"
G XCLUD1
XQABGEN ;ISC-SF/JLI - GENERATE ALPHA/BETA TEST INITIALIZATION ROUTINE ;1/21/93 11:50 ;
+1 ;;7.1;KERNEL;;May 11, 1993
+2 ;;
ENTRY IF '$DATA(DKP)
SET DIC=9.4
SET DIC(0)="MAEQ"
DO ^DIC
IF Y'>0
QUIT
SET DKP=+Y
+1 SET DKP(0)=^DIC(9.4,+DKP,0)
SET XQABPKG=$PIECE(DKP(0),U)
SET XQABNMSP=$PIECE(DKP(0),U,2)
SET XQABROU=XQABNMSP_$SELECT($LENGTH(XQABNMSP)<4:"INITY",1:"INIY")
+2 KILL ^TMP($JOB,"XQAB")
SET X="XQABMAKE"
SET XCNP=0
SET DIF="^TMP($J,""XQAB"","
XECUTE ^%ZOSF("LOAD")
+3 SET ^(0)=XQABROU_" "_$PIECE(^TMP($JOB,"XQAB",1,0)," ",2,200)
+4 SET ^TMP($JOB,"XQAB",XCNP,0)="PKGNAM ;;"_XQABPKG_";"
SET XCNP=XCNP+1
ABTEST WRITE !!,"Is this version of the ",XQABPKG,!?5,"an Alpha or Beta test version (Y/N) ? "
READ X:DTIME
IF '$TEST!(X[U)
GOTO KILL
SET X=$EXTRACT(X_".")
IF "NnYy"'[X
WRITE $CHAR(7)," ??",!!,"ANSWER EITHER YES OR NO OR '^' TO EXIT"
GOTO ABTEST
+1 SET XQABTEST=$SELECT("Nn"[X:0,1:1)
SET ^TMP($JOB,"XQAB",XCNP,0)="ABTEST ;;"_$SELECT(XQABTEST:"YES;",1:"NO;")
SET XCNP=XCNP+1
ADRESS WRITE !!,"Enter as an adressee for installation messages a mailgroup in NETWORK MAIL",!,"format, e.g., G.GROUPNAME@DOMAIN.NAME"
IF XQABTEST
WRITE " This same address will",!,"be used for reports on Alpha/Beta Option Usage"
+1 READ !?10,"Addressee: ",X:DTIME
IF '$TEST!(X[U)
GOTO KILL
DO UCASE
IF X'?1"G."1U.E1"@"1U.E
WRITE $CHAR(7)," ??"
GOTO ADRESS
+2 SET XQABADRS=X
SET X=$PIECE(X,"@",2)
SET DIC=4.2
SET DIC(0)=$SELECT(X="":"A",1:"")_"EQM"
DO ^DIC
IF Y'>0
GOTO ADRESS
SET XQABADRS=$PIECE(XQABADRS,"@",1)_"@"_$PIECE(Y,U,2)
SET ^TMP($JOB,"XQAB",XCNP,0)="ADRESS ;;"_XQABADRS_";"
SET XCNP=XCNP+1
MESG READ !!,"Do you want a message returned upon installation (Y/N) ? ",X:DTIME
IF '$TEST!(X[U)
GOTO KILL
SET X=$EXTRACT(X,1)
IF "YyNn"'[X
WRITE $CHAR(7)," ??",!,"ENTER Y (YES) OR N (NO) OR '^' TO EXIT"
GOTO MESG
+1 SET ^TMP($JOB,"XQAB",XCNP,0)="SENMSG ;;"_$SELECT("Yy"[X:"YES",1:"NO")_";"
SET XCNP=XCNP+1
+2 IF 'XQABTEST
GOTO FINISH
VERS READ !,"ENTER Version Number: ",X:DTIME
IF X'?.E1"V"1N.N&(X'?.E1"T"1N.N)
WRITE !,"Enter the version number as nVm or nTm where n and m are numbers,",!,"and n may have one decimal place.",!!
GOTO VERS
+1 SET ^TMP($JOB,"XQAB",XCNP,0)="VERS ;;"_X_";"
SET XCNP=XCNP+1
+2 SET XQABOPT=XQABNMSP
SET XQABOPTN=1
SET ^TMP($JOB,"XQAB",XCNP,0)="OPT"_XQABOPTN_" ;;"_XQABOPT_";"
XCLUD WRITE !!,"For the namespace '",XQABOPT,"' are there any namespaces (other than '",XQABOPT,"Z'",!?20,"that should be EXCLUDED (Y/N) ? N// "
READ X:DTIME
IF '$TEST!(X[U)
GOTO KILL
IF X=""
SET X="N"
SET X=$EXTRACT(X_".",1)
+1 IF "YyNn"'[X
WRITE !!,"ENTER 'Y' OR 'YES' IF SOME OPTIONS BEGINNING WITH '",XQABOPT,"' SHOULD BE",!,"EXCLUDED FROM THE ANALYSIS, E.G., '",XQABOPT,"A'"
GOTO XCLUD
+2 IF "Yy"[X
DO XCLUD1
NMSPAC READ !!,"Enter ANOTHER namespace used by options in this package: ",X:DTIME
IF '$TEST!(X[U)
GOTO KILL
+1 IF X["?"
WRITE !,"If this package supports options with names which begin with ANOTHER namespace",!,"than ",$SELECT(XQABOPTN=1:"that",1:"those")," already entered, then enter THAT namespace now."
GOTO NMSPAC
+2 DO UCASE
IF $LENGTH(X)<5
IF X?1U.UN!(X?1"%"1U.UN)
SET XQABOPTN=XQABOPTN+1
SET XQABOPT=X
SET XCNP=XCNP+1
SET ^TMP($JOB,"XQAB",XCNP,0)="OPT"_XQABOPTN_" ;;"_XQABOPT_";"
GOTO XCLUD
+3 IF X'=""
WRITE !,"The namespace or prefix must be four or fewer characters long, beginning",!,"with a letter and followed by letters and/or digits. Enter a RETURN if there",!,"are no additional namespaces to include."
GOTO NMSPAC
FINISH SET DIE="^TMP($J,""XQAB"","
SET XCN=0
SET X=XQABROU
XECUTE ^%ZOSF("SAVE")
KILL KILL DIC,DIE,DIF,I,X,XCN,XCNP,XQABADRS,XQABTEST,XQABOPT,XQABNMSP,XQABOPTN,XQABPKG,XQABROU,Y
+1 KILL ^TMP($JOB,"XQAB")
+2 QUIT
UCASE FOR I=1:1
IF X'?.E1L.E
QUIT
IF $EXTRACT(X,I)?1L
SET X=$EXTRACT(X,1,I-1)_$CHAR($ASCII($EXTRACT(X,I))-32)_$EXTRACT(X,I+1,$LENGTH(X))
+1 QUIT
+2 ;
XCLUD1 READ !!?10,"Enter the FULL namespace or prefix to be excluded: ",X:DTIME
IF '$TEST!(X[U)!(X="")
QUIT
DO UCASE
+1 IF $EXTRACT(X,1,$LENGTH(XQABOPT))'=XQABOPT!(X=XQABOPT)
WRITE $CHAR(7)," ??",!,"Enter the namespace to exclude as",!?15,"'",XQABOPT,"' followed by one or more letters or digits."
GOTO XCLUD1
+2 SET ^(0)=^TMP($JOB,"XQAB",XCNP,0)_X_";"
WRITE " OK"
+3 GOTO XCLUD1
