source: FOIAVistA/trunk/r/MAILMAN-XM/XMP3.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1XMP3 ;(WASH ISC)/AML/CAP-PackMan Build Backup Msg ;04/17/2002 11:07
2 ;;8.0;MailMan;;Jun 28, 2002
3ENTER ; 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
12QBACKUP(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
27BACKUP(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
38BTEXT(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
47ROU ;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
56BROU ;
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
65GLO ;New global section
66GLB ;global...save the part to be updated
67 W !,"GLOBAL..................NO BACKUP" Q
68DDD ;data dictionary...
69 W !,"DATA DICTIONARY.........NO BACKUP" Q
70DAT ;fileman data...what to do
71 W !,"FILEMAN DATA............NO BACKUP" Q
72OPT ;Options
73 W !,"OPTIONS.................NO BACKUP" Q
74HEL ;Help Frames
75 W !,"HELP FRAMES.............NO BACKUP" Q
76BUL ;Bulletins
77 W !,"BULLETINS...............NO BACKUP" Q
78KEY ;Security Keys
79 W !,"SECURITY KEYS...........NO BACKUP" Q
80FUN ;Functions
81 W !,"FUNCTIONS...............NO BACKUP" Q
82PKG ;Package File
83 W !,"PACKAGE FILE............NO BACKUP" Q
84RTN ;Routine Documentation
85 W !,"ROUTINE DOCUMENTATION...NO BACKUP" Q
86DIE ;Input Templates
87 W !,"INPUT TEMPLATES.........NO BACKUP" Q
88DIP ;Print Templates
89 W !,"PRINT TEMPLATES.........NO BACKUP" Q
90DIB ;Sort Templates
91 W !,"SORT TEMPLATES..........NO BACKUP" Q
92NO ;no way
93 W !,"UNDEFINED FUNCTION" Q
94BINIT(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
Note: See TracBrowser for help on using the repository browser.