| 1 | XMDIR1 ;(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
|
|---|
| 6 | ENT ;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
|
|---|
| 42 | Q L -^XMD("XMDIR1") K ^TMP("XMDIR1",$J)
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | ;Menu option to schedule task
|
|---|
| 46 | OPTION 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
|
|---|
| 71 | ER ;Display error
|
|---|
| 72 | S XMDIR1("CNT")=XMDIR1("CNT")+1,^TMP("XMDIR1",$J,XMDIR1("CNT"))=XME_":"_XMY Q
|
|---|
| 73 | ZTSK ;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
|
|---|
| 77 | JOB S ZTQUEUED=1,U="^",(IO,IO(0))="" D DT^DICRW G XMDIR1
|
|---|
| 78 | ;Reschedule job to run later
|
|---|
| 79 | RES S ZTREQ=$$HADD^XLFDT($H,,,5)_"^^MailLink Conversion Restart @ "_$H_"^XMZWANG" Q
|
|---|
| 80 | HFSFILE 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
|
|---|
| 84 | INT ;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
|
|---|
