| [613] | 1 | XPDZIB ;FGO/JHS;Revised KIDS Backup ; 11-09-98 [9/3/99 6:58am]
|
|---|
| 2 | ;;8.0;KERNEL;**L33**;Jul 10, 1995
|
|---|
| 3 | N XCNP,DIF,DIR,DIRUT,XMSUB,XMDUZ,XMDISPI,XMZ,XPD,XPDA,XPDNM,XPDQUIT,XPDST,XPDT,X,Y,%
|
|---|
| 4 | I $D(AAQPAT) S AAQP=AAQPAT G SET ;Used when called from AAQMENU
|
|---|
| 5 | READ W !,"Enter Patch Name in the format Namespace*Version*Patch,"
|
|---|
| 6 | W !,"or Enter Package Name in the format Package{space}Version: " R AAQP:DTIME I '$T!(AAQP["^") W $C(7),!!,"Patch or Package Name was not entered. No backup message was created." H 2 Q
|
|---|
| 7 | I AAQP="" W !!,"Enter Patch Name or '^' to Exit.",! G READ
|
|---|
| 8 | G:AAQP'["*" PKG
|
|---|
| 9 | G:$P(AAQP,"*",1)["Z" CKLOC
|
|---|
| 10 | I $P(AAQP,"*",1)'?2.4UN W $C(7),!!,"Namespace must be 2-4 Uppercase or Numeric with first character being Alpha." G READ
|
|---|
| 11 | G CKVER
|
|---|
| 12 | CKLOC I $P(AAQP,"*",1)'?2.4UN1"Z" W $C(7),!!,"Namespace for a LOCAL Patch must be 2-4 Uppercase or Numeric",!,"characters with the first being Alpha and last character a 'Z'." G READ
|
|---|
| 13 | CKVER I $P(AAQP,"*",2,3)?1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.6N G SET
|
|---|
| 14 | G VER
|
|---|
| 15 | PKG I $P(AAQP," ",2)?1.2N1"."1.2N.1(1"V",1"T").2N G SET
|
|---|
| 16 | VER W $C(7),!!,"Version number must include at least one whole number and decimal position.",! G READ
|
|---|
| 17 | SET S %="I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))",XPDST=$$LOOK^XPDI1(%)
|
|---|
| 18 | Q:'XPDST!$D(XPDQUIT)
|
|---|
| 19 | D UCI^%ZOSV S AAQUCI=$P(Y,",",1),AAQPAT=$P(XPDT("1"),U,2)
|
|---|
| 20 | S XMSUB="BEFORE "_AAQPAT_" from "_AAQUCI,AAQSUB=XMSUB K AAQUCI,AAQPAT
|
|---|
| 21 | S XMDUZ="SIMPLE PATCH - "_$P(^VA(200,DUZ,0),U,1),XMY(DUZ)="",AAQXMY=$P(^VA(200,DUZ,0),U,1)
|
|---|
| 22 | D XMZ^XMA2 I XMZ<1 D QUIT^XPDI1(XPDST) Q
|
|---|
| 23 | S Y=$$NOW^XLFDT,%=$$DOW^XLFDT(Y),Y=$$FMTE^XLFDT(Y,2)
|
|---|
| 24 | S X="PACKMAN BACKUP Created on "_%_", "_$P(Y,"@")_" at "_$P(Y,"@",2)
|
|---|
| 25 | I $D(^VA(200,DUZ,0)) S X=X_" by "_$P(^(0),U)_" "
|
|---|
| 26 | S:$D(^XMB("NAME")) X=X_"at "_$P(^("NAME"),U)_" "
|
|---|
| 27 | S ^XMB(3.9,XMZ,2,0)="^3.92A^^^"_DT,^(1,0)="$TXT "_X,XCNP=1
|
|---|
| 28 | I $D(^VA(200,"B","PATCHES,ALL D")) S XMY("PATCHES,ALL D")="",AAQXMY=AAQXMY_" and PATCHES,ALL D"
|
|---|
| 29 | S XPDT=0,AAQROU=0
|
|---|
| 30 | F S XPDT=$O(XPDT(XPDT)) Q:'XPDT D
|
|---|
| 31 | .S XPDA=+XPDT(XPDT),XPDNM=$P(XPDT(XPDT),U,2),XPD=""
|
|---|
| 32 | .I '$D(^XTMP("XPDI",XPDA,"RTN")) W !,"No routines for ",XPDNM,! Q
|
|---|
| 33 | .W !,"Loading Routines for ",XPDNM
|
|---|
| 34 | .F S XPD=$O(^XTMP("XPDI",XPDA,"RTN",XPD)) Q:XPD="" D ROU(XPD) W "."
|
|---|
| 35 | G:AAQROU=0 NOXM
|
|---|
| 36 | S AAQBAK=XMZ D EN3^XMD,QUIT^XPDI1(XPDST) K XMY ;AAQBAK killed by XPDZPAT
|
|---|
| 37 | W !,"Backup message #"_XMZ_" created",!,"with Subject '"_AAQSUB_"'",!,"and sent to "_AAQXMY,! K AAQSUB,AAQXMY
|
|---|
| 38 | Q ;AAQBAK and AAQP killed in XPDZPAT or option Exit Action
|
|---|
| 39 | NOXM W $C(7),!!,"There are no routines which need to be saved.",!,"No Backup Message will be created." S AAQBAK=0
|
|---|
| 40 | ;;D KILL^XMA3,QUIT^XPDI1(XPDST) K %H,%I,AAQROU,AAQSUB,AAQXMY,C,XMBASK,XMDISPI,XMDUN,XMDUZ,XMGAPI1,XMLOCK,XMY,XMZ Q
|
|---|
| 41 | D QUIT^XPDI1(XPDST) K %H,%I,AAQROU,AAQSUB,AAQXMY,C,XMBASK,XMDISPI,XMDUN,XMDUZ,XMGAPI1,XMLOCK,XMY,XMZ Q
|
|---|
| 42 | ROU(X) N %N,DIF
|
|---|
| 43 | X ^%ZOSF("TEST") E W !,"Routine ",X," is not on the disk." Q
|
|---|
| 44 | S XCNP=XCNP+1,^XMB(3.9,XMZ,2,XCNP,0)="$ROU "_X_" (PACKMAN_BACKUP)",DIF="^XMB(3.9,XMZ,2,"
|
|---|
| 45 | X ^%ZOSF("LOAD")
|
|---|
| 46 | S $P(^XMB(3.9,XMZ,2,0),U,3,4)=XCNP_U_XCNP,^(XCNP,0)="$END ROU "_X_" (PACKMAN-BACKUP)"
|
|---|
| 47 | S AAQROU=AAQROU+1
|
|---|
| 48 | Q
|
|---|
