| 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
 | 
|---|