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