XM8P52 ;BP/BDT - set locks for options; Feb 21, 2024@07:35:55
;;8.0;MAILMAN;**52**;Jul 10, 1995;Build 1
;Per VA Directive 6402, this routine should not be modified.
;Post routine for XM*8*52
Q
;
POST ; Post rouitne for XM*8*52
D SETAUDTS
D SETLOCKS("XUPROG")
Q
;
BACKOUT ; backout patch section. This wil be rollback the original data before the patch.
D BACKOUTF
D SETLOCKS("@")
Q
;
SETAUDTS ; set AUDIT for FILES/FIELDS
N XUI S XUI=""
K ^XTMP("XM52 MAILMAN PATCH FILES")
F XUI=1:1:100 S XUFILE=$T(FILES+XUI) Q:$P(XUFILE,";;",2)="$$END" D
. D SETAUDT($P(XUFILE,";;",2),$P(XUFILE,";;",3),"y")
. Q
Q
;
SETAUDT(XUFILE,XUFIELD,KFL) ;set Audit for a field
;XUFILE = file number
;XUIELD = field number
;---------------------
N XUI,XUY,XUF S XUI=""
F XUI=1:1:100 S XUF=$P(XUFIELD,";",XUI) Q:XUF="" D
. S ^XTMP("XM52 MAILMAN PATCH FILES",$J,XUFILE,XUF)=$G(^DD(XUFILE,XUF,"AUDIT"),"n")
. DO TURNON^DIAUTL(XUFILE,XUF,KFL)
. Q
Q
;
BACKOUTF ; backout Audit fields
N XUI S XUI=""
K ^XTMP("XM52 MAILMAN PATCH FILES")
F XUI=1:1:100 S XUFILE=$T(FILES+XUI) Q:$P(XUFILE,";;",2)="$$END" D
. D SETAUDT($P(XUFILE,";;",2),$P(XUFILE,";;",3),"n")
. Q
Q
;
PRINTFLS ;backing up patch data for the listed AUDIT files/fields
N XUI,XUY,XUFILE S XUI=""
F XUI=1:1:100 S XUFILE=$T(FILES+XUI) Q:$P(XUFILE,";;",2)="$$END" D
. D PRINTFL($P(XUFILE,";;",2),$P(XUFILE,";;",3))
Q
;
PRINTFL(XUFILE,XUFIELDS) ;backing up patch data for a AUDIT single file/fields
N XUI,XUY S XUY=""
F XUI=1:1:100 S XUFIELD=$P(XUFIELDS,";",XUI) Q:XUFIELD="" D
. W !,"FILE: ",?8,XUFILE,?15," FIELD :",XUFIELD
. W ?30,"AUDIT SET: ",$G(^DD(XUFILE,XUFIELD,"AUDIT"),"n")
Q
;
FILES ; List files and field to set AUDIT
;;4.3;;.01;1;217
;;$$END;;
;
SETLOCKS(XULOCK) ; set LOCK for OPTIONS
N XUI,XUOPTION S XUI=""
K ^XTMP("XM52 MAILMAN PATCH FILES")
F XUI=1:1:100 S XUOPTION=$T(OPTIONS+XUI) Q:$P(XUOPTION,";;",2)="$$END" D
. S XUOPTION=$P(XUOPTION,"[",2)
. S XUOPTION=$P(XUOPTION,"]",1)
. D SETLOCK(XUOPTION,XULOCK)
. Q
Q
;
SETLOCK(XUOP,XULOCK) ; set LOCK for OPTION
N XUIEN,IENS
S XUIEN="",XUOP=$G(XUOP)
I XUOP="" Q
S XUIEN=$O(^DIC(19,"B",XUOP,0))
I $G(XUIEN)'>0 Q
S IENS=XUIEN_","
S XULOCK=$G(XULOCK,"XUPROG")
K FDA S FDA(19,IENS,3)=XULOCK D FILE^DIE("E","FDA","ERR")
Q
;
LISTLOCKS ;
N XUI,XUOPTION S XUI=""
K ^XTMP("XM52 MAILMAN PATCH FILES")
F XUI=1:1:100 S XUOPTION=$T(OPTIONS+XUI) Q:$P(XUOPTION,";;",2)="$$END" D
. S XUOPTION=$P(XUOPTION,"[",2)
. S XUOPTION=$P(XUOPTION,"]",1)
. D LISTLOCK(XUOPTION)
. Q
Q
;
LISTLOCK(XUOP) ; LOCK for OPTION
N XUIEN,IENS
S XUIEN="",XUOP=$G(XUOP)
I XUOP="" Q
S XUIEN=$O(^DIC(19,"B",XUOP,0))
I $G(XUIEN)'>0 Q
W !,XUOP," ",?32,$P($G(^DIC(19,XUIEN,0)),"^",6)
Q
;
OPTIONS ; lock for options
;;MailMan Site Parameters [XMKSP]
;;Manage Mailman ... [XMMGR]
;;AI x-Ref Purge of Received Network Messages [XMMGR-PURGE-AI-XREF]
;;IN Basket Purge [XMMGR-IN-BASKET-PURGE]
;;Purge a message [XMMGR-PURGE-MESSAGE]
;;Purge Messages by Origination Date [XMPURGE-BY-DATE]
;;Purge Unreferenced Messages [XMPURGE]
;;Terminate many mail users [XMMGR-TERMINATE-MANY]
;;Terminate one mail user [XMMGR-TERMINATE-ONE]
;;START background filer [XMMGR-START-BACKGROUND-FILER]
;;STOP background filer [XMMGR-STOP-BACKGROUND-FILER]"
;;Christen a domain [XMCHRIS]
;;Edit a script [XMSCRIPTEDIT]
;;Receive Messages from Another UCI [XMR-UCI-RCV]
;;Send Messages to Another UCI [XMR-UCI-SEND]
;;Sequential Media Message Reception [XMR-SEQ-RECEIVE]
;;Sequential Media Queue Transmission [XMS-SEQ-TRANSMIT]
;;Subroutine editor [XMSUBEDIT]
;;Toggle a script out of service [XMSCRIPTOUT]
;;Validation Number Edit [XMEDIT-DOMAIN-VALIDATION#]
;;Site Parameters [XMSITE]
;;Enter/Edit Directory Request Flags by Group [XMMGR-DIRECTORY-EDITGRP]
;;Enter/Edit Remote User [XMEDIT-REMOTE-USER]
;;Request Mail Directory From a Single Domain Server [XMMGR-DIRECTORY-SINGLE]
;;Load Remote VACO (Wang/Noava) Directory [XMMGR-DIRECTORY-VACO]
;;Send a TWIX via PCTS [XMNET-TWIX-SEND]
;;Transmit TWIX's [XMNET-TWIX-TRANSMIT]
;;$$END;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXM8P52 4211 printed Dec 13, 2024@02:10:40 Page 2
XM8P52 ;BP/BDT - set locks for options; Feb 21, 2024@07:35:55
+1 ;;8.0;MAILMAN;**52**;Jul 10, 1995;Build 1
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;Post routine for XM*8*52
+4 QUIT
+5 ;
POST ; Post rouitne for XM*8*52
+1 DO SETAUDTS
+2 DO SETLOCKS("XUPROG")
+3 QUIT
+4 ;
BACKOUT ; backout patch section. This wil be rollback the original data before the patch.
+1 DO BACKOUTF
+2 DO SETLOCKS("@")
+3 QUIT
+4 ;
SETAUDTS ; set AUDIT for FILES/FIELDS
+1 NEW XUI
SET XUI=""
+2 KILL ^XTMP("XM52 MAILMAN PATCH FILES")
+3 FOR XUI=1:1:100
SET XUFILE=$TEXT(FILES+XUI)
if $PIECE(XUFILE,";;",2)="$$END"
QUIT
Begin DoDot:1
+4 DO SETAUDT($PIECE(XUFILE,";;",2),$PIECE(XUFILE,";;",3),"y")
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
SETAUDT(XUFILE,XUFIELD,KFL) ;set Audit for a field
+1 ;XUFILE = file number
+2 ;XUIELD = field number
+3 ;---------------------
+4 NEW XUI,XUY,XUF
SET XUI=""
+5 FOR XUI=1:1:100
SET XUF=$PIECE(XUFIELD,";",XUI)
if XUF=""
QUIT
Begin DoDot:1
+6 SET ^XTMP("XM52 MAILMAN PATCH FILES",$JOB,XUFILE,XUF)=$GET(^DD(XUFILE,XUF,"AUDIT"),"n")
+7 DO TURNON^DIAUTL(XUFILE,XUF,KFL)
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
BACKOUTF ; backout Audit fields
+1 NEW XUI
SET XUI=""
+2 KILL ^XTMP("XM52 MAILMAN PATCH FILES")
+3 FOR XUI=1:1:100
SET XUFILE=$TEXT(FILES+XUI)
if $PIECE(XUFILE,";;",2)="$$END"
QUIT
Begin DoDot:1
+4 DO SETAUDT($PIECE(XUFILE,";;",2),$PIECE(XUFILE,";;",3),"n")
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
PRINTFLS ;backing up patch data for the listed AUDIT files/fields
+1 NEW XUI,XUY,XUFILE
SET XUI=""
+2 FOR XUI=1:1:100
SET XUFILE=$TEXT(FILES+XUI)
if $PIECE(XUFILE,";;",2)="$$END"
QUIT
Begin DoDot:1
+3 DO PRINTFL($PIECE(XUFILE,";;",2),$PIECE(XUFILE,";;",3))
End DoDot:1
+4 QUIT
+5 ;
PRINTFL(XUFILE,XUFIELDS) ;backing up patch data for a AUDIT single file/fields
+1 NEW XUI,XUY
SET XUY=""
+2 FOR XUI=1:1:100
SET XUFIELD=$PIECE(XUFIELDS,";",XUI)
if XUFIELD=""
QUIT
Begin DoDot:1
+3 WRITE !,"FILE: ",?8,XUFILE,?15," FIELD :",XUFIELD
+4 WRITE ?30,"AUDIT SET: ",$GET(^DD(XUFILE,XUFIELD,"AUDIT"),"n")
End DoDot:1
+5 QUIT
+6 ;
FILES ; List files and field to set AUDIT
+1 ;;4.3;;.01;1;217
+2 ;;$$END;;
+3 ;
SETLOCKS(XULOCK) ; set LOCK for OPTIONS
+1 NEW XUI,XUOPTION
SET XUI=""
+2 KILL ^XTMP("XM52 MAILMAN PATCH FILES")
+3 FOR XUI=1:1:100
SET XUOPTION=$TEXT(OPTIONS+XUI)
if $PIECE(XUOPTION,";;",2)="$$END"
QUIT
Begin DoDot:1
+4 SET XUOPTION=$PIECE(XUOPTION,"[",2)
+5 SET XUOPTION=$PIECE(XUOPTION,"]",1)
+6 DO SETLOCK(XUOPTION,XULOCK)
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
SETLOCK(XUOP,XULOCK) ; set LOCK for OPTION
+1 NEW XUIEN,IENS
+2 SET XUIEN=""
SET XUOP=$GET(XUOP)
+3 IF XUOP=""
QUIT
+4 SET XUIEN=$ORDER(^DIC(19,"B",XUOP,0))
+5 IF $GET(XUIEN)'>0
QUIT
+6 SET IENS=XUIEN_","
+7 SET XULOCK=$GET(XULOCK,"XUPROG")
+8 KILL FDA
SET FDA(19,IENS,3)=XULOCK
DO FILE^DIE("E","FDA","ERR")
+9 QUIT
+10 ;
LISTLOCKS ;
+1 NEW XUI,XUOPTION
SET XUI=""
+2 KILL ^XTMP("XM52 MAILMAN PATCH FILES")
+3 FOR XUI=1:1:100
SET XUOPTION=$TEXT(OPTIONS+XUI)
if $PIECE(XUOPTION,";;",2)="$$END"
QUIT
Begin DoDot:1
+4 SET XUOPTION=$PIECE(XUOPTION,"[",2)
+5 SET XUOPTION=$PIECE(XUOPTION,"]",1)
+6 DO LISTLOCK(XUOPTION)
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
LISTLOCK(XUOP) ; LOCK for OPTION
+1 NEW XUIEN,IENS
+2 SET XUIEN=""
SET XUOP=$GET(XUOP)
+3 IF XUOP=""
QUIT
+4 SET XUIEN=$ORDER(^DIC(19,"B",XUOP,0))
+5 IF $GET(XUIEN)'>0
QUIT
+6 WRITE !,XUOP," ",?32,$PIECE($GET(^DIC(19,XUIEN,0)),"^",6)
+7 QUIT
+8 ;
OPTIONS ; lock for options
+1 ;;MailMan Site Parameters [XMKSP]
+2 ;;Manage Mailman ... [XMMGR]
+3 ;;AI x-Ref Purge of Received Network Messages [XMMGR-PURGE-AI-XREF]
+4 ;;IN Basket Purge [XMMGR-IN-BASKET-PURGE]
+5 ;;Purge a message [XMMGR-PURGE-MESSAGE]
+6 ;;Purge Messages by Origination Date [XMPURGE-BY-DATE]
+7 ;;Purge Unreferenced Messages [XMPURGE]
+8 ;;Terminate many mail users [XMMGR-TERMINATE-MANY]
+9 ;;Terminate one mail user [XMMGR-TERMINATE-ONE]
+10 ;;START background filer [XMMGR-START-BACKGROUND-FILER]
+11 ;;STOP background filer [XMMGR-STOP-BACKGROUND-FILER]"
+12 ;;Christen a domain [XMCHRIS]
+13 ;;Edit a script [XMSCRIPTEDIT]
+14 ;;Receive Messages from Another UCI [XMR-UCI-RCV]
+15 ;;Send Messages to Another UCI [XMR-UCI-SEND]
+16 ;;Sequential Media Message Reception [XMR-SEQ-RECEIVE]
+17 ;;Sequential Media Queue Transmission [XMS-SEQ-TRANSMIT]
+18 ;;Subroutine editor [XMSUBEDIT]
+19 ;;Toggle a script out of service [XMSCRIPTOUT]
+20 ;;Validation Number Edit [XMEDIT-DOMAIN-VALIDATION#]
+21 ;;Site Parameters [XMSITE]
+22 ;;Enter/Edit Directory Request Flags by Group [XMMGR-DIRECTORY-EDITGRP]
+23 ;;Enter/Edit Remote User [XMEDIT-REMOTE-USER]
+24 ;;Request Mail Directory From a Single Domain Server [XMMGR-DIRECTORY-SINGLE]
+25 ;;Load Remote VACO (Wang/Noava) Directory [XMMGR-DIRECTORY-VACO]
+26 ;;Send a TWIX via PCTS [XMNET-TWIX-SEND]
+27 ;;Transmit TWIX's [XMNET-TWIX-TRANSMIT]
+28 ;;$$END;;
