| 1 | XMP3 ;(WASH ISC)/AML/CAP-PackMan Build Backup Msg ;04/17/2002  11:07 | 
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002 | 
|---|
| 3 | ENTER ; This routine backs up what's on disk into a packman message. | 
|---|
| 4 | S X="" | 
|---|
| 5 | Q:$D(XMPKIDS) | 
|---|
| 6 | N XMABORT,XMANSER | 
|---|
| 7 | S XMABORT=0 | 
|---|
| 8 | D QBACKUP(.XMANSER,.XMABORT) I XMABORT S X=U Q | 
|---|
| 9 | I 'XMANSER W !,"No backup message built.",! Q | 
|---|
| 10 | D BACKUP(XMDUZ,XMZ,.XMP2,.XMABORT) I XMABORT S X=U | 
|---|
| 11 | Q | 
|---|
| 12 | QBACKUP(Y,XMABORT) ; | 
|---|
| 13 | N DIR,DIRUT,X | 
|---|
| 14 | W !!,"Routines are the only parts that are backed up.  NO other parts" | 
|---|
| 15 | W !,"are backed up, not even globals.  You may use the 'Summarize Message'" | 
|---|
| 16 | W !,"option of PackMan to see what parts the message contains." | 
|---|
| 17 | W !,"Those parts that are not routines should be backed up separately" | 
|---|
| 18 | W !,"if they need to be preserved.",!! | 
|---|
| 19 | S DIR(0)="Y" | 
|---|
| 20 | S DIR("A")="Shall I preserve the routines on disk in a separate back-up message" | 
|---|
| 21 | S DIR("B")="YES" | 
|---|
| 22 | S DIR("?",1)="If YES I will build a MailMan message containing the routines that will" | 
|---|
| 23 | S DIR("?",2)="be replaced by the Install." | 
|---|
| 24 | S DIR("?")="If NO then you will have no automatic backup of routines." | 
|---|
| 25 | D ^DIR I $D(DIRUT) S XMABORT=1 | 
|---|
| 26 | Q | 
|---|
| 27 | BACKUP(XMDUZ,XMZ,XMSELECT,XMABORT) ; | 
|---|
| 28 | ;Initialize message, reset & quit if abort | 
|---|
| 29 | N XMINSTR,XMPXMZ | 
|---|
| 30 | D BINIT(XMDUZ,.XMPXMZ,.XMINSTR,.XMABORT) Q:XMABORT | 
|---|
| 31 | D BTEXT(XMZ,.XMSELECT,XMPXMZ) | 
|---|
| 32 | D MOVEPART^XMXSEND(XMDUZ,XMPXMZ,.XMINSTR) | 
|---|
| 33 | D SEND^XMKP(XMDUZ,XMPXMZ,.XMINSTR) | 
|---|
| 34 | D CHECK^XMKPL | 
|---|
| 35 | D CLEANUP^XMXADDR | 
|---|
| 36 | W !,"PackMan backup message [",XMPXMZ,"] sent." | 
|---|
| 37 | Q | 
|---|
| 38 | BTEXT(XMZ,XMSELECT,XMPXMZ) ; | 
|---|
| 39 | N XCNP,XMCN,XMREC,XMTYPE | 
|---|
| 40 | S XCNP=1,XMCN=0 | 
|---|
| 41 | F  S XMCN=$O(^XMB(3.9,XMZ,2,XMCN)) Q:XMCN'>0  S XMREC=^(XMCN,0)  D | 
|---|
| 42 | . Q:$E(XMREC)'="$" | 
|---|
| 43 | . Q:"^$TXT^$END^"[(U_$E(XMREC,1,4)_U) | 
|---|
| 44 | . S XMTYPE=$E(XMREC,2,4) | 
|---|
| 45 | . D @($S(":ROU:GLB:GLO:DDD:DAT:OPT:HEL:BUL:KEY:FUN:PKG:RTN:DIE:DIB:DIP:"[(":"_XMTYPE_":"):XMTYPE,1:"NO")) | 
|---|
| 46 | Q | 
|---|
| 47 | ROU ;save routine | 
|---|
| 48 | N X,XMROU | 
|---|
| 49 | S X=$P(XMREC," ",2) S:X[U X=$P(X,U,2) | 
|---|
| 50 | X ^%ZOSF("TEST") E  W !,"Routine ",X," is not on the disk." Q | 
|---|
| 51 | I $O(XMSELECT(""))="" D BROU Q | 
|---|
| 52 | S XMROU="" | 
|---|
| 53 | F  S XMROU=$O(XMSELECT(XMROU)) Q:XMROU=""!(X=XMROU)  I $E(XMROU,$L(XMROU))="*" Q:$E(X,1,$L(XMROU)-1)=$E(XMROU,1,$L(XMROU)-1) | 
|---|
| 54 | D:XMROU'="" BROU | 
|---|
| 55 | Q | 
|---|
| 56 | BROU ; | 
|---|
| 57 | N DIF | 
|---|
| 58 | S DIF="^XMB(3.9,XMPXMZ,2," | 
|---|
| 59 | S XCNP=XCNP+1 | 
|---|
| 60 | S ^XMB(3.9,XMPXMZ,2,XCNP,0)="$ROU "_X_" (PACKMAN-BACKUP)" | 
|---|
| 61 | X ^%ZOSF("LOAD") | 
|---|
| 62 | S ^XMB(3.9,XMPXMZ,2,XCNP,0)="$END ROU "_X_" (PACKMAN-BACKUP)" | 
|---|
| 63 | S ^XMB(3.9,XMPXMZ,2,0)="^3.92A^"_XCNP_U_XCNP_U_DT | 
|---|
| 64 | Q | 
|---|
| 65 | GLO ;New global section | 
|---|
| 66 | GLB ;global...save the part to be updated | 
|---|
| 67 | W !,"GLOBAL..................NO BACKUP" Q | 
|---|
| 68 | DDD ;data dictionary... | 
|---|
| 69 | W !,"DATA DICTIONARY.........NO BACKUP" Q | 
|---|
| 70 | DAT ;fileman data...what to do | 
|---|
| 71 | W !,"FILEMAN DATA............NO BACKUP" Q | 
|---|
| 72 | OPT ;Options | 
|---|
| 73 | W !,"OPTIONS.................NO BACKUP" Q | 
|---|
| 74 | HEL ;Help Frames | 
|---|
| 75 | W !,"HELP FRAMES.............NO BACKUP" Q | 
|---|
| 76 | BUL ;Bulletins | 
|---|
| 77 | W !,"BULLETINS...............NO BACKUP" Q | 
|---|
| 78 | KEY ;Security Keys | 
|---|
| 79 | W !,"SECURITY KEYS...........NO BACKUP" Q | 
|---|
| 80 | FUN ;Functions | 
|---|
| 81 | W !,"FUNCTIONS...............NO BACKUP" Q | 
|---|
| 82 | PKG ;Package File | 
|---|
| 83 | W !,"PACKAGE FILE............NO BACKUP" Q | 
|---|
| 84 | RTN ;Routine Documentation | 
|---|
| 85 | W !,"ROUTINE DOCUMENTATION...NO BACKUP" Q | 
|---|
| 86 | DIE ;Input Templates | 
|---|
| 87 | W !,"INPUT TEMPLATES.........NO BACKUP" Q | 
|---|
| 88 | DIP ;Print Templates | 
|---|
| 89 | W !,"PRINT TEMPLATES.........NO BACKUP" Q | 
|---|
| 90 | DIB ;Sort Templates | 
|---|
| 91 | W !,"SORT TEMPLATES..........NO BACKUP" Q | 
|---|
| 92 | NO ;no way | 
|---|
| 93 | W !,"UNDEFINED FUNCTION" Q | 
|---|
| 94 | BINIT(XMDUZ,XMPXMZ,XMINSTR,XMABORT) ; setup for first routine | 
|---|
| 95 | N XMSUBJ,XMREC,XMDT | 
|---|
| 96 | D SUBJ^XMJMS(.XMSUBJ,.XMABORT) Q:XMABORT | 
|---|
| 97 | D CRE8XMZ^XMXSEND(XMSUBJ,.XMPXMZ,1) I XMPXMZ<1 S XMABORT=1 Q | 
|---|
| 98 | D INIT^XMXADDR | 
|---|
| 99 | D TOWHOM^XMJMT(XMDUZ,"Send",.XMINSTR,"",.XMABORT) | 
|---|
| 100 | I XMABORT D KILLMSG^XMXUTIL(XMPXMZ) Q | 
|---|
| 101 | W !,"Building PackMan backup message with subject ",XMSUBJ,!! | 
|---|
| 102 | S XMDT=$E($$NOW^XLFDT_"0000",1,12) | 
|---|
| 103 | S XMREC="PACKMAN BACKUP Created on "_$$DOW^XLFDT(XMDT)_", "_$$FMTE^XLFDT($P(XMDT,".",1),"2Z")_" at "_$E(XMDT,9,10)_":"_$E(XMDT,11,12)_" " | 
|---|
| 104 | I $D(DUZ),$D(^VA(200,DUZ,0)) S XMREC=XMREC_"by "_$$NAME^XMXUTIL(DUZ)_" " | 
|---|
| 105 | S:$D(^XMB("NETNAME")) XMREC=XMREC_"at "_$P(^("NETNAME"),U)_" " | 
|---|
| 106 | S ^XMB(3.9,XMPXMZ,2,0)="" | 
|---|
| 107 | S ^XMB(3.9,XMPXMZ,2,1,0)="$TXT "_XMREC | 
|---|
| 108 | Q | 
|---|