XMDIR1 ;(WASH ISC)/CAP-Load VACO Directories ;04/17/2002 08:47
;;8.0;MailMan;;Jun 28, 2002
; Entry points used by MailMan options (not covered by DBIA):
; OPTION XMMGR-DIRECTORY-VACO
Q
ENT ;Batch Entry point (TaskMan)
K ZTREQ,^TMP("XMDIR1",$J) S XMA=0
;
;LOCK to indicate to XMA5 that MailLink in being updated
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
;
U IO(0) S XMDIR1A("CODE")=$S($G(XMDIR1A)=1:"1A",1:"1B")
I '$D(ZTQUEUED) W !!,"Killing off old AUTOMATIC entries for this code ("_XMDIR1A("CODE")_").",!!
N DIK
S DA=0,DIK="^XMD(4.2997,"
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 "."
;
;Kill off very old manual entries that haven't been used
S DA=0,XMDIR1=$E(DT,1,5)-200,XMDIR1("CNT")=0
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 "."
;
I '$D(ZTQUEUED) W !!,"Starting load",!!
U IO
;Load WANG directory
I $G(XMDIR1A("CODE"))="1A" D ^XMDIR1A
;
;Load NOAVA directory
I $G(XMDIR1A("CODE"))="1B" D ^XMDIR1B
;
K XMDIR1A,XMDIR1B
I '$D(ZTQUEUED) W !!!,"Task Completed"
;
S ^TMP("XMDIR1",$J,.0001)="Remote Directories summary:"
S ^TMP("XMDIR1",$J,.0002)=""
I $D(XMDIR1("W")) S ^TMP("XMDIR1",$J,.0003)=XMDIR1("W")_" Wang system records processed."
I $D(XMDIR1("N")) S ^TMP("XMDIR1",$J,.0003)=XMDIR1("N")_" NOAVA system records processed."
S XMSUB="REMOTE DIRECTORY AUTOMATIC UPDATE",XMTEXT="^TMP(""XMDIR1"",$J,"
N XMDUZ S XMDUZ="|XMDIR1_REMOTE_DIRECTORY_UPDATE|",XMY("G.POSTMASTER@"_^XMB("NETNAME"))=""
I $D(DUZ) S XMY(DUZ)=""
I $O(XMY(0))="" S XMY(.5)=""
D ^XMD K A
Q L -^XMD("XMDIR1") K ^TMP("XMDIR1",$J)
Q
;
;Menu option to schedule task
OPTION G ENT:$D(ZTQUEUED)
N %,%0,%1,%6,D,DA,I,J,X,Y,XMA0,XMB0,XMC0,XMDUZ,XMDIR1,XMSUB,XMY,XMTEXT
W !!,"You are about to load a file containing a list of names and"
W !,"addresses into you Remote User Directory (file 4.2997). This"
W !,"file originated either from a NOAVA system or a WANG system."
W !,"Choose the correct file. We will check it some for format.",!!
S %ZIS("S")="I $P($G(^(""TYPE"")),U)[""HFS"""
S %ZIS("A")="Enter either HFS-WANG-DIR or HFS-NOAVA-DIR: "
S %ZIS("B")="HFS-NOAVA-DIR"
S %ZIS="Q" D ^%ZIS Q:POP
S XMF=IO,XMDIR1A=$S(ION="HFS-NOAVA-DIR":2,1:1)
R !!,"Do you want your job queued? (Answer YES or NO) NO// ",X:DTIME
K D S:X="" X="NO" S X=$TR(X,"noyes","NOYES") I $E("YES",1,$L(X))=X S D=1
W !!,"Before the update occurs entries older than 90 days in the directory"
W !,"are deleted if they were automatically filed by this procedure."
W !,"Manually entered entries are deleted if they haven't been used"
W !,"for at least 2 years."
W !!,"Users are informed that an update is occuring if they are using"
W !,"MailLink help options. But are allowed to continue.",!!
R !!,"Are you sure you want to do this (Answer 'YES/NO'): NO//",X:DTIME
S:X="" X="NO" S X=$TR(X,"noyes","NOYES") I $E("YES",1,$L(X))'=X W !!,"Nothing done.",$C(7),!! Q
I '$G(D) G INT
D ZTSK W !!,$C(7),"Task #"_ZTSK_" scheduled.",!!
D ^%ZISC K ZTSK,ZTRTN,ZTDTH,XMDUZ,ZTDESC,IO("Q"),XMDIR1A,XMDIR1B
Q
ER ;Display error
S XMDIR1("CNT")=XMDIR1("CNT")+1,^TMP("XMDIR1",$J,XMDIR1("CNT"))=XME_":"_XMY Q
ZTSK ;Schedule to run in the evening
S XMDUZ="[XMDIR1_DIRECTORY_CONVERSION]",ZTRTN="ENT^XMDIR1",ZTDTH=+$H_",64800",ZTSAVE("*")="",ZTDESC="Convert MailLink list"
S ZTDTH="" D ^%ZTLOAD Q
;Job out this process from here
JOB S ZTQUEUED=1,U="^",(IO,IO(0))="" D DT^DICRW G XMDIR1
;Reschedule job to run later
RES S ZTREQ=$$HADD^XLFDT($H,,,5)_"^^MailLink Conversion Restart @ "_$H_"^XMZWANG" Q
HFSFILE S DIC="^%ZIS(1,",DIC(0)="AZQME",DIC("S")="I $P($G(^%ZIS(1,Y,""TYPE"")),U)[""HFS"""
D ^DIC Q:Y<0
S IOP=X D ^%ZIS Q:POP
S XMF=$P(^%ZIS(1,IOS,0),U,2) Q
INT ;Interactive processing begins here
S XMF=$P(^%ZIS(1,IOS,0),U,2)
W !!,"Answer 'YES' if you mean 'YES'. All other response mean 'NO'."
W !,"The first file to be processed is for the "_XMF_"."
W !,"Enter '^' to skip this portion of the process.",!!
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
S X="NOWANG^XMDIR1B",@^%ZOSF("TRAP")
U IO R Y:1 U IO(0)
W !!,"The following string was read from the first line of "_XMF_"."
W !!,Y,!!,"Is this correct ? NO// " R %:DTIME
S:%="" %="NO" S %=$TR(%,"noyes","NOYES")
I $E("YES",1,$L(%))'=% D ^%ZISC Q
W ! G ENT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMDIR1 4548 printed Oct 16, 2024@18:12:15 Page 2
XMDIR1 ;(WASH ISC)/CAP-Load VACO Directories ;04/17/2002 08:47
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Entry points used by MailMan options (not covered by DBIA):
+3 ; OPTION XMMGR-DIRECTORY-VACO
+4 QUIT
ENT ;Batch Entry point (TaskMan)
+1 KILL ZTREQ,^TMP("XMDIR1",$JOB)
SET XMA=0
+2 ;
+3 ;LOCK to indicate to XMA5 that MailLink in being updated
+4 LOCK +^XMD("XMDIR1"):1
IF '$TEST
if $DATA(ZTQUEUED)
GOTO RES
WRITE !!,$CHAR(7),"<<< This task seems to be running already !",!,"(It cannot be run multiple times concurrently.) >>>"
GOTO Q
+5 ;
+6 USE IO(0)
SET XMDIR1A("CODE")=$SELECT($GET(XMDIR1A)=1:"1A",1:"1B")
+7 IF '$DATA(ZTQUEUED)
WRITE !!,"Killing off old AUTOMATIC entries for this code ("_XMDIR1A("CODE")_").",!!
+8 NEW DIK
+9 SET DA=0
SET DIK="^XMD(4.2997,"
+10 FOR XMA0=1:1
SET DA=$ORDER(^XMD(4.2997,"E",XMDIR1A("CODE"),DA))
if +DA'=DA
QUIT
DO ^DIK
IF '$DATA(ZTQUEUED)
IF XMA0#10=0
WRITE "."
+11 ;
+12 ;Kill off very old manual entries that haven't been used
+13 SET DA=0
SET XMDIR1=$EXTRACT(DT,1,5)-200
SET XMDIR1("CNT")=0
+14 FOR XMA0=XMA0:1
SET DA=$ORDER(^XMD(4.2997,"AC",DA))
if $SELECT(DA>XMDIR1
QUIT
DO ^DIK
IF '$DATA(ZTQUEUED)
IF XMA0#10=0
WRITE "."
+15 ;
+16 IF '$DATA(ZTQUEUED)
WRITE !!,"Starting load",!!
+17 USE IO
+18 ;Load WANG directory
+19 IF $GET(XMDIR1A("CODE"))="1A"
DO ^XMDIR1A
+20 ;
+21 ;Load NOAVA directory
+22 IF $GET(XMDIR1A("CODE"))="1B"
DO ^XMDIR1B
+23 ;
+24 KILL XMDIR1A,XMDIR1B
+25 IF '$DATA(ZTQUEUED)
WRITE !!!,"Task Completed"
+26 ;
+27 SET ^TMP("XMDIR1",$JOB,.0001)="Remote Directories summary:"
+28 SET ^TMP("XMDIR1",$JOB,.0002)=""
+29 IF $DATA(XMDIR1("W"))
SET ^TMP("XMDIR1",$JOB,.0003)=XMDIR1("W")_" Wang system records processed."
+30 IF $DATA(XMDIR1("N"))
SET ^TMP("XMDIR1",$JOB,.0003)=XMDIR1("N")_" NOAVA system records processed."
+31 SET XMSUB="REMOTE DIRECTORY AUTOMATIC UPDATE"
SET XMTEXT="^TMP(""XMDIR1"",$J,"
+32 NEW XMDUZ
SET XMDUZ="|XMDIR1_REMOTE_DIRECTORY_UPDATE|"
SET XMY("G.POSTMASTER@"_^XMB("NETNAME"))=""
+33 IF $DATA(DUZ)
SET XMY(DUZ)=""
+34 IF $ORDER(XMY(0))=""
SET XMY(.5)=""
+35 DO ^XMD
KILL A
Q LOCK -^XMD("XMDIR1")
KILL ^TMP("XMDIR1",$JOB)
+1 QUIT
+2 ;
+3 ;Menu option to schedule task
OPTION if $DATA(ZTQUEUED)
GOTO ENT
+1 NEW %,%0,%1,%6,D,DA,I,J,X,Y,XMA0,XMB0,XMC0,XMDUZ,XMDIR1,XMSUB,XMY,XMTEXT
+2 WRITE !!,"You are about to load a file containing a list of names and"
+3 WRITE !,"addresses into you Remote User Directory (file 4.2997). This"
+4 WRITE !,"file originated either from a NOAVA system or a WANG system."
+5 WRITE !,"Choose the correct file. We will check it some for format.",!!
+6 SET %ZIS("S")="I $P($G(^(""TYPE"")),U)[""HFS"""
+7 SET %ZIS("A")="Enter either HFS-WANG-DIR or HFS-NOAVA-DIR: "
+8 SET %ZIS("B")="HFS-NOAVA-DIR"
+9 SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+10 SET XMF=IO
SET XMDIR1A=$SELECT(ION="HFS-NOAVA-DIR":2,1:1)
+11 READ !!,"Do you want your job queued? (Answer YES or NO) NO// ",X:DTIME
+12 KILL D
if X=""
SET X="NO"
SET X=$TRANSLATE(X,"noyes","NOYES")
IF $EXTRACT("YES",1,$LENGTH(X))=X
SET D=1
+13 WRITE !!,"Before the update occurs entries older than 90 days in the directory"
+14 WRITE !,"are deleted if they were automatically filed by this procedure."
+15 WRITE !,"Manually entered entries are deleted if they haven't been used"
+16 WRITE !,"for at least 2 years."
+17 WRITE !!,"Users are informed that an update is occuring if they are using"
+18 WRITE !,"MailLink help options. But are allowed to continue.",!!
+19 READ !!,"Are you sure you want to do this (Answer 'YES/NO'): NO//",X:DTIME
+20 if X=""
SET X="NO"
SET X=$TRANSLATE(X,"noyes","NOYES")
IF $EXTRACT("YES",1,$LENGTH(X))'=X
WRITE !!,"Nothing done.",$CHAR(7),!!
QUIT
+21 IF '$GET(D)
GOTO INT
+22 DO ZTSK
WRITE !!,$CHAR(7),"Task #"_ZTSK_" scheduled.",!!
+23 DO ^%ZISC
KILL ZTSK,ZTRTN,ZTDTH,XMDUZ,ZTDESC,IO("Q"),XMDIR1A,XMDIR1B
+24 QUIT
ER ;Display error
+1 SET XMDIR1("CNT")=XMDIR1("CNT")+1
SET ^TMP("XMDIR1",$JOB,XMDIR1("CNT"))=XME_":"_XMY
QUIT
ZTSK ;Schedule to run in the evening
+1 SET XMDUZ="[XMDIR1_DIRECTORY_CONVERSION]"
SET ZTRTN="ENT^XMDIR1"
SET ZTDTH=+$HOROLOG_",64800"
SET ZTSAVE("*")=""
SET ZTDESC="Convert MailLink list"
+2 SET ZTDTH=""
DO ^%ZTLOAD
QUIT
+3 ;Job out this process from here
JOB SET ZTQUEUED=1
SET U="^"
SET (IO,IO(0))=""
DO DT^DICRW
GOTO XMDIR1
+1 ;Reschedule job to run later
RES SET ZTREQ=$$HADD^XLFDT($HOROLOG,,,5)_"^^MailLink Conversion Restart @ "_$HOROLOG_"^XMZWANG"
QUIT
HFSFILE SET DIC="^%ZIS(1,"
SET DIC(0)="AZQME"
SET DIC("S")="I $P($G(^%ZIS(1,Y,""TYPE"")),U)[""HFS"""
+1 DO ^DIC
if Y<0
QUIT
+2 SET IOP=X
DO ^%ZIS
if POP
QUIT
+3 SET XMF=$PIECE(^%ZIS(1,IOS,0),U,2)
QUIT
INT ;Interactive processing begins here
+1 SET XMF=$PIECE(^%ZIS(1,IOS,0),U,2)
+2 WRITE !!,"Answer 'YES' if you mean 'YES'. All other response mean 'NO'."
+3 WRITE !,"The first file to be processed is for the "_XMF_"."
+4 WRITE !,"Enter '^' to skip this portion of the process.",!!
+5 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP=""
+6 SET X="NOWANG^XMDIR1B"
SET @^%ZOSF("TRAP")
+7 USE IO
READ Y:1
USE IO(0)
+8 WRITE !!,"The following string was read from the first line of "_XMF_"."
+9 WRITE !!,Y,!!,"Is this correct ? NO// "
READ %:DTIME
+10 if %=""
SET %="NO"
SET %=$TRANSLATE(%,"noyes","NOYES")
+11 IF $EXTRACT("YES",1,$LENGTH(%))'=%
DO ^%ZISC
QUIT
+12 WRITE !
GOTO ENT
