| 1 | XPDIB ;SFISC/RSD - Backup installed Package ;12:29 PM 16 Oct 2000
|
|---|
| 2 | ;;8.0;KERNEL;**10,58,108,178**;Jul 10, 1995
|
|---|
| 3 | EN ;
|
|---|
| 4 | N XCNP,DIF,DIR,DIRUT,XMSUB,XMDUZ,XMDISPI,XMZ,XPD,XPDA,XPDNM,XPDQUIT,XPDST,XPDT,X,Y,%
|
|---|
| 5 | S %="I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))",XPDST=$$LOOK^XPDI1(%)
|
|---|
| 6 | Q:'XPDST!$D(XPDQUIT)
|
|---|
| 7 | S DIR(0)="F^3:65"
|
|---|
| 8 | S DIR("A")="Subject"
|
|---|
| 9 | S DIR("?")="characters and must not contain embedded uparrow."
|
|---|
| 10 | S DIR("?",1)="Enter the subject for this Packman Backup Message"
|
|---|
| 11 | S DIR("?",2)="This response must have at least 3 characters and no more than 63"
|
|---|
| 12 | S DIR("B")=$E(("Backup of "_$P(XPDT(1),U,2)_" install on "_$$FMTE^XLFDT(DT)),1,63)
|
|---|
| 13 | D ^DIR I $D(DIRUT) D QUIT^XPDI1(XPDST) Q
|
|---|
| 14 | S XMSUB=Y,XMDUZ=+DUZ
|
|---|
| 15 | D XMZ^XMA2 I XMZ<1 D QUIT^XPDI1(XPDST) Q
|
|---|
| 16 | S Y=$$NOW^XLFDT,%=$$DOW^XLFDT(Y),Y=$$FMTE^XLFDT(Y,2)
|
|---|
| 17 | S X="PACKMAN BACKUP Created on "_%_", "_$P(Y,"@")_" at "_$P(Y,"@",2)
|
|---|
| 18 | I $D(^VA(200,DUZ,0)) S X=X_" by "_$P(^(0),U)_" "
|
|---|
| 19 | S:$D(^XMB("NAME")) X=X_"at "_$P(^("NAME"),U)_" "
|
|---|
| 20 | S ^XMB(3.9,XMZ,2,0)="^3.92A^^^"_DT,^(1,0)="$TXT "_X,XCNP=1
|
|---|
| 21 | S XPDT=0
|
|---|
| 22 | F S XPDT=$O(XPDT(XPDT)) Q:'XPDT D
|
|---|
| 23 | .S XPDA=+XPDT(XPDT),XPDNM=$P(XPDT(XPDT),U,2),XPD=""
|
|---|
| 24 | .I '$D(^XTMP("XPDI",XPDA,"RTN")) W !,"No routines for ",XPDNM,! Q
|
|---|
| 25 | .W !,"Loading Routines for ",XPDNM
|
|---|
| 26 | .F S XPD=$O(^XTMP("XPDI",XPDA,"RTN",XPD)) Q:XPD="" D ROU(XPD) W "."
|
|---|
| 27 | D EN3^XMD,QUIT^XPDI1(XPDST)
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | ROU(X) N %N,DIF
|
|---|
| 31 | X ^%ZOSF("TEST") E W !,"Routine ",X," is not on the disk." Q
|
|---|
| 32 | S XCNP=XCNP+1,^XMB(3.9,XMZ,2,XCNP,0)="$ROU "_X_" (PACKMAN_BACKUP)",DIF="^XMB(3.9,XMZ,2,"
|
|---|
| 33 | X ^%ZOSF("LOAD")
|
|---|
| 34 | S $P(^XMB(3.9,XMZ,2,0),U,3,4)=XCNP_U_XCNP,^(XCNP,0)="$END ROU "_X_" (PACKMAN-BACKUP)"
|
|---|
| 35 | Q
|
|---|
