- 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