source: FOIAVistA/tag/r/MAILMAN-XM/XMDIR1.m@ 1326

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1XMDIR1 ;(WASH ISC)/CAP-Load VACO Directories ;04/17/2002 08:47
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Entry points used by MailMan options (not covered by DBIA):
4 ; OPTION XMMGR-DIRECTORY-VACO
5 Q
6ENT ;Batch Entry point (TaskMan)
7 K ZTREQ,^TMP("XMDIR1",$J) S XMA=0
8 ;
9 ;LOCK to indicate to XMA5 that MailLink in being updated
10 L +^XMD("XMDIR1"):1 E G RES:$D(ZTQUEUED) W !!,$C(7),"<<< This task seems to be running already !",!,"(It cannot be run multiple times concurrently.) >>>" G Q
11 ;
12 U IO(0) S XMDIR1A("CODE")=$S($G(XMDIR1A)=1:"1A",1:"1B")
13 I '$D(ZTQUEUED) W !!,"Killing off old AUTOMATIC entries for this code ("_XMDIR1A("CODE")_").",!!
14 N DIK
15 S DA=0,DIK="^XMD(4.2997,"
16 F XMA0=1:1 S DA=$O(^XMD(4.2997,"E",XMDIR1A("CODE"),DA)) Q:+DA'=DA D ^DIK I '$D(ZTQUEUED),XMA0#10=0 W "."
17 ;
18 ;Kill off very old manual entries that haven't been used
19 S DA=0,XMDIR1=$E(DT,1,5)-200,XMDIR1("CNT")=0
20 F XMA0=XMA0:1 S DA=$O(^XMD(4.2997,"AC",DA)) Q:$S(DA>XMDIR1:1,DA="":1,1:0) D ^DIK I '$D(ZTQUEUED),XMA0#10=0 W "."
21 ;
22 I '$D(ZTQUEUED) W !!,"Starting load",!!
23 U IO
24 ;Load WANG directory
25 I $G(XMDIR1A("CODE"))="1A" D ^XMDIR1A
26 ;
27 ;Load NOAVA directory
28 I $G(XMDIR1A("CODE"))="1B" D ^XMDIR1B
29 ;
30 K XMDIR1A,XMDIR1B
31 I '$D(ZTQUEUED) W !!!,"Task Completed"
32 ;
33 S ^TMP("XMDIR1",$J,.0001)="Remote Directories summary:"
34 S ^TMP("XMDIR1",$J,.0002)=""
35 I $D(XMDIR1("W")) S ^TMP("XMDIR1",$J,.0003)=XMDIR1("W")_" Wang system records processed."
36 I $D(XMDIR1("N")) S ^TMP("XMDIR1",$J,.0003)=XMDIR1("N")_" NOAVA system records processed."
37 S XMSUB="REMOTE DIRECTORY AUTOMATIC UPDATE",XMTEXT="^TMP(""XMDIR1"",$J,"
38 N XMDUZ S XMDUZ="|XMDIR1_REMOTE_DIRECTORY_UPDATE|",XMY("G.POSTMASTER@"_^XMB("NETNAME"))=""
39 I $D(DUZ) S XMY(DUZ)=""
40 I $O(XMY(0))="" S XMY(.5)=""
41 D ^XMD K A
42Q L -^XMD("XMDIR1") K ^TMP("XMDIR1",$J)
43 Q
44 ;
45 ;Menu option to schedule task
46OPTION G ENT:$D(ZTQUEUED)
47 N %,%0,%1,%6,D,DA,I,J,X,Y,XMA0,XMB0,XMC0,XMDUZ,XMDIR1,XMSUB,XMY,XMTEXT
48 W !!,"You are about to load a file containing a list of names and"
49 W !,"addresses into you Remote User Directory (file 4.2997). This"
50 W !,"file originated either from a NOAVA system or a WANG system."
51 W !,"Choose the correct file. We will check it some for format.",!!
52 S %ZIS("S")="I $P($G(^(""TYPE"")),U)[""HFS"""
53 S %ZIS("A")="Enter either HFS-WANG-DIR or HFS-NOAVA-DIR: "
54 S %ZIS("B")="HFS-NOAVA-DIR"
55 S %ZIS="Q" D ^%ZIS Q:POP
56 S XMF=IO,XMDIR1A=$S(ION="HFS-NOAVA-DIR":2,1:1)
57 R !!,"Do you want your job queued? (Answer YES or NO) NO// ",X:DTIME
58 K D S:X="" X="NO" S X=$TR(X,"noyes","NOYES") I $E("YES",1,$L(X))=X S D=1
59 W !!,"Before the update occurs entries older than 90 days in the directory"
60 W !,"are deleted if they were automatically filed by this procedure."
61 W !,"Manually entered entries are deleted if they haven't been used"
62 W !,"for at least 2 years."
63 W !!,"Users are informed that an update is occuring if they are using"
64 W !,"MailLink help options. But are allowed to continue.",!!
65 R !!,"Are you sure you want to do this (Answer 'YES/NO'): NO//",X:DTIME
66 S:X="" X="NO" S X=$TR(X,"noyes","NOYES") I $E("YES",1,$L(X))'=X W !!,"Nothing done.",$C(7),!! Q
67 I '$G(D) G INT
68 D ZTSK W !!,$C(7),"Task #"_ZTSK_" scheduled.",!!
69 D ^%ZISC K ZTSK,ZTRTN,ZTDTH,XMDUZ,ZTDESC,IO("Q"),XMDIR1A,XMDIR1B
70 Q
71ER ;Display error
72 S XMDIR1("CNT")=XMDIR1("CNT")+1,^TMP("XMDIR1",$J,XMDIR1("CNT"))=XME_":"_XMY Q
73ZTSK ;Schedule to run in the evening
74 S XMDUZ="[XMDIR1_DIRECTORY_CONVERSION]",ZTRTN="ENT^XMDIR1",ZTDTH=+$H_",64800",ZTSAVE("*")="",ZTDESC="Convert MailLink list"
75 S ZTDTH="" D ^%ZTLOAD Q
76 ;Job out this process from here
77JOB S ZTQUEUED=1,U="^",(IO,IO(0))="" D DT^DICRW G XMDIR1
78 ;Reschedule job to run later
79RES S ZTREQ=$$HADD^XLFDT($H,,,5)_"^^MailLink Conversion Restart @ "_$H_"^XMZWANG" Q
80HFSFILE S DIC="^%ZIS(1,",DIC(0)="AZQME",DIC("S")="I $P($G(^%ZIS(1,Y,""TYPE"")),U)[""HFS"""
81 D ^DIC Q:Y<0
82 S IOP=X D ^%ZIS Q:POP
83 S XMF=$P(^%ZIS(1,IOS,0),U,2) Q
84INT ;Interactive processing begins here
85 S XMF=$P(^%ZIS(1,IOS,0),U,2)
86 W !!,"Answer 'YES' if you mean 'YES'. All other response mean 'NO'."
87 W !,"The first file to be processed is for the "_XMF_"."
88 W !,"Enter '^' to skip this portion of the process.",!!
89 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
90 S X="NOWANG^XMDIR1B",@^%ZOSF("TRAP")
91 U IO R Y:1 U IO(0)
92 W !!,"The following string was read from the first line of "_XMF_"."
93 W !!,Y,!!,"Is this correct ? NO// " R %:DTIME
94 S:%="" %="NO" S %=$TR(%,"noyes","NOYES")
95 I $E("YES",1,$L(%))'=% D ^%ZISC Q
96 W ! G ENT
Note: See TracBrowser for help on using the repository browser.