Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMP3

XMP3.m

Go to the documentation of this file. 
  1. XMP3 ;(WASH ISC)/AML/CAP-PackMan Build Backup Msg ;04/17/2002  11:07
  1.  ;;8.0;MailMan;;Jun 28, 2002
  1. ENTER ; This routine backs up what's on disk into a packman message.
  1.  S X=""
  1.  Q:$D(XMPKIDS)
  1.  N XMABORT,XMANSER
  1.  S XMABORT=0
  1.  D QBACKUP(.XMANSER,.XMABORT) I XMABORT S X=U Q
  1.  I 'XMANSER W !,"No backup message built.",! Q
  1.  D BACKUP(XMDUZ,XMZ,.XMP2,.XMABORT) I XMABORT S X=U
  1.  Q
  1. QBACKUP(Y,XMABORT) ;
  1.  N DIR,DIRUT,X
  1.  W !!,"Routines are the only parts that are backed up.  NO other parts"
  1.  W !,"are backed up, not even globals.  You may use the 'Summarize Message'"
  1.  W !,"option of PackMan to see what parts the message contains."
  1.  W !,"Those parts that are not routines should be backed up separately"
  1.  W !,"if they need to be preserved.",!!
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Shall I preserve the routines on disk in a separate back-up message"
  1.  S DIR("B")="YES"
  1.  S DIR("?",1)="If YES I will build a MailMan message containing the routines that will"
  1.  S DIR("?",2)="be replaced by the Install."
  1.  S DIR("?")="If NO then you will have no automatic backup of routines."
  1.  D ^DIR I $D(DIRUT) S XMABORT=1
  1.  Q
  1. BACKUP(XMDUZ,XMZ,XMSELECT,XMABORT) ;
  1.  ;Initialize message, reset & quit if abort
  1.  N XMINSTR,XMPXMZ
  1.  D BINIT(XMDUZ,.XMPXMZ,.XMINSTR,.XMABORT) Q:XMABORT
  1.  D BTEXT(XMZ,.XMSELECT,XMPXMZ)
  1.  D MOVEPART^XMXSEND(XMDUZ,XMPXMZ,.XMINSTR)
  1.  D SEND^XMKP(XMDUZ,XMPXMZ,.XMINSTR)
  1.  D CHECK^XMKPL
  1.  D CLEANUP^XMXADDR
  1.  W !,"PackMan backup message [",XMPXMZ,"] sent."
  1.  Q
  1. BTEXT(XMZ,XMSELECT,XMPXMZ) ;
  1.  N XCNP,XMCN,XMREC,XMTYPE
  1.  S XCNP=1,XMCN=0
  1.  F  S XMCN=$O(^XMB(3.9,XMZ,2,XMCN)) Q:XMCN'>0  S XMREC=^(XMCN,0)  D
  1.  . Q:$E(XMREC)'="$"
  1.  . Q:"^$TXT^$END^"[(U_$E(XMREC,1,4)_U)
  1.  . S XMTYPE=$E(XMREC,2,4)
  1.  . D @($S(":ROU:GLB:GLO:DDD:DAT:OPT:HEL:BUL:KEY:FUN:PKG:RTN:DIE:DIB:DIP:"[(":"_XMTYPE_":"):XMTYPE,1:"NO"))
  1.  Q
  1. ROU ;save routine
  1.  N X,XMROU
  1.  S X=$P(XMREC," ",2) S:X[U X=$P(X,U,2)
  1.  X ^%ZOSF("TEST") E  W !,"Routine ",X," is not on the disk." Q
  1.  I $O(XMSELECT(""))="" D BROU Q
  1.  S XMROU=""
  1.  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)
  1.  D:XMROU'="" BROU
  1.  Q
  1. BROU ;
  1.  N DIF
  1.  S DIF="^XMB(3.9,XMPXMZ,2,"
  1.  S XCNP=XCNP+1
  1.  S ^XMB(3.9,XMPXMZ,2,XCNP,0)="$ROU "_X_" (PACKMAN-BACKUP)"
  1.  X ^%ZOSF("LOAD")
  1.  S ^XMB(3.9,XMPXMZ,2,XCNP,0)="$END ROU "_X_" (PACKMAN-BACKUP)"
  1.  S ^XMB(3.9,XMPXMZ,2,0)="^3.92A^"_XCNP_U_XCNP_U_DT
  1.  Q
  1. GLO ;New global section
  1. GLB ;global...save the part to be updated
  1.  W !,"GLOBAL..................NO BACKUP" Q
  1. DDD ;data dictionary...
  1.  W !,"DATA DICTIONARY.........NO BACKUP" Q
  1. DAT ;fileman data...what to do
  1.  W !,"FILEMAN DATA............NO BACKUP" Q
  1. OPT ;Options
  1.  W !,"OPTIONS.................NO BACKUP" Q
  1. HEL ;Help Frames
  1.  W !,"HELP FRAMES.............NO BACKUP" Q
  1. BUL ;Bulletins
  1.  W !,"BULLETINS...............NO BACKUP" Q
  1. KEY ;Security Keys
  1.  W !,"SECURITY KEYS...........NO BACKUP" Q
  1. FUN ;Functions
  1.  W !,"FUNCTIONS...............NO BACKUP" Q
  1. PKG ;Package File
  1.  W !,"PACKAGE FILE............NO BACKUP" Q
  1. RTN ;Routine Documentation
  1.  W !,"ROUTINE DOCUMENTATION...NO BACKUP" Q
  1. DIE ;Input Templates
  1.  W !,"INPUT TEMPLATES.........NO BACKUP" Q
  1. DIP ;Print Templates
  1.  W !,"PRINT TEMPLATES.........NO BACKUP" Q
  1. DIB ;Sort Templates
  1.  W !,"SORT TEMPLATES..........NO BACKUP" Q
  1. NO ;no way
  1.  W !,"UNDEFINED FUNCTION" Q
  1. BINIT(XMDUZ,XMPXMZ,XMINSTR,XMABORT) ; setup for first routine
  1.  N XMSUBJ,XMREC,XMDT
  1.  D SUBJ^XMJMS(.XMSUBJ,.XMABORT) Q:XMABORT
  1.  D CRE8XMZ^XMXSEND(XMSUBJ,.XMPXMZ,1) I XMPXMZ<1 S XMABORT=1 Q
  1.  D INIT^XMXADDR
  1.  D TOWHOM^XMJMT(XMDUZ,"Send",.XMINSTR,"",.XMABORT)
  1.  I XMABORT D KILLMSG^XMXUTIL(XMPXMZ) Q
  1.  W !,"Building PackMan backup message with subject ",XMSUBJ,!!
  1.  S XMDT=$E($$NOW^XLFDT_"0000",1,12)
  1.  S XMREC="PACKMAN BACKUP Created on "_$$DOW^XLFDT(XMDT)_", "_$$FMTE^XLFDT($P(XMDT,".",1),"2Z")_" at "_$E(XMDT,9,10)_":"_$E(XMDT,11,12)_" "
  1.  I $D(DUZ),$D(^VA(200,DUZ,0)) S XMREC=XMREC_"by "_$$NAME^XMXUTIL(DUZ)_" "
  1.  S:$D(^XMB("NETNAME")) XMREC=XMREC_"at "_$P(^("NETNAME"),U)_" "
  1.  S ^XMB(3.9,XMPXMZ,2,0)=""
  1.  S ^XMB(3.9,XMPXMZ,2,1,0)="$TXT "_XMREC
  1.  Q