XMDIR1B ;(WASH ISC)/CAP-Load VACO Directories (NOAVA) ;04/17/2002 08:47
;;8.0;MailMan;;Jun 28, 2002
; Entry points used by MailMan options (not covered by DBIA):
; REMOTES XMEDIT-REMOTE-USER
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
S X="EOF^XMDIR1B",@^%ZOSF("TRAP"),XMB0=^%ZOSF("UPPERCASE")
GO G P:'$D(ZTQUEUED)
R1 U IO R Y:DTIME I '$D(ZTQUEUED) U IO(0)
S XMA=XMA+1 I '$D(ZTQUEUED),XMA#10=0 W "."
P S X=Y X XMB0 F %=0:0 Q:$E(Y)'?1P S Y=$E(Y,2,99)
F %=$L(Y):-1:0 Q:$E(Y,%)?1A S Y=$E(Y,1,%-1)
K X S X=$$STRIP($P(Y,":"))
G R1:X[" ",R1:X["@",R1:X["::",R1:X["..",R1:X="",R1:X?1.N,R1:X?.E3N.E,R1:X["/",R1:X?.E1C.E
S XMY=Y
;
;Name
S X("LN")=X
S X=$$STRIP($P(XMY,":",2)),X("FN")=X,X("RN")=""
;
;Mail code
S X=$$STRIP($P(XMY,":",6)),X("MC")=$P(X," "),X("EMC")=X G R1:X("MC")?.E1C.E
;
;Phone number / Extension
S X("PHONE")=$$STRIP($P(XMY,":",5)),X("PHONE/E")=$$STRIP($P(XMY,":",7))
;
;Location
S X("L")=$$STRIP($P(XMY,":",4))
;
;Network address
S X=$$STRIP($P(XMY,":",9)),X=$P(X,"@")
G R1:'$L(X),R1:X?.E1C.E S X("NET")=X_"@DOMAIN.NAME"
I $D(^XMD(4.2997,"B",X("LN"))) S %="" F S %=$O(^XMD(4.2997,"B",X("LN"),%)) Q:%="" I $D(^XMD(4.2997,%,0)) S %6=^XMD(4.2997,%,0) I X("NET")=$P(%6,U,7) S XME="Already on file - not filed " D ER^XMDIR1 G R1
;
D FILE^XMDIR1A(.X)
G R1
EOF D ^%ZISC,END^XMDIR1A("NOAVA",90) Q
;
;Strip leading and trailing spaces
STRIP(X) F Q:$E(X)'=" " S X=$E(X,2,999)
F Q:$E(X,$L(X))'=" " S X=$E(X,1,$L(X)-1)
Q X
NOWANG D @^%ZOSF("ERRTN")
I '$D(ZTQUEUED) W !!,"The error: "_$ZE_" occured !!!",!!
G Q^XMDIR1
REMOTES ;Edit/Add Remote members
N DA,DIE,DR,DIC,DLAYGO,X,Y,DUOUT,DTOUT
S DIC=4.2997,DLAYGO=4.2997,DIC(0)="AELQMZ" D ^DIC
Q:$S($D(DTOUT):1,$D(DUOUT):1,Y<1:1,1:0)
S DA=+Y,DIE=4.2997,DR=".01:99999" D ^DIE
Q
XMDIR1B ;(WASH ISC)/CAP-Load VACO Directories (NOAVA) ;04/17/2002 08:47
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Entry points used by MailMan options (not covered by DBIA):
+3 ; REMOTES XMEDIT-REMOTE-USER
+4 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP=""
+5 SET X="EOF^XMDIR1B"
SET @^%ZOSF("TRAP")
SET XMB0=^%ZOSF("UPPERCASE")
GO IF '$DATA(ZTQUEUED)
GOTO P
R1 USE IO
READ Y:DTIME
IF '$DATA(ZTQUEUED)
USE IO(0)
+1 SET XMA=XMA+1
IF '$DATA(ZTQUEUED)
IF XMA#10=0
WRITE "."
P SET X=Y
XECUTE XMB0
FOR %=0:0
IF $EXTRACT(Y)'?1P
QUIT
SET Y=$EXTRACT(Y,2,99)
+1 FOR %=$LENGTH(Y):-1:0
IF $EXTRACT(Y,%)?1A
QUIT
SET Y=$EXTRACT(Y,1,%-1)
+2 KILL X
SET X=$$STRIP($PIECE(Y,":"))
+3 IF X[" "
GOTO R1
IF X["@"
GOTO R1
IF X["::"
GOTO R1
IF X[".."
GOTO R1
IF X=""
GOTO R1
IF X?1.N
GOTO R1
IF X?.E3N.E
GOTO R1
IF X["/"
GOTO R1
IF X?.E1C.E
GOTO R1
+4 SET XMY=Y
+5 ;
+6 ;Name
+7 SET X("LN")=X
+8 SET X=$$STRIP($PIECE(XMY,":",2))
SET X("FN")=X
SET X("RN")=""
+9 ;
+10 ;Mail code
+11 SET X=$$STRIP($PIECE(XMY,":",6))
SET X("MC")=$PIECE(X," ")
SET X("EMC")=X
IF X("MC")?.E1C.E
GOTO R1
+12 ;
+13 ;Phone number / Extension
+14 SET X("PHONE")=$$STRIP($PIECE(XMY,":",5))
SET X("PHONE/E")=$$STRIP($PIECE(XMY,":",7))
+15 ;
+16 ;Location
+17 SET X("L")=$$STRIP($PIECE(XMY,":",4))
+18 ;
+19 ;Network address
+20 SET X=$$STRIP($PIECE(XMY,":",9))
SET X=$PIECE(X,"@")
+21 IF '$LENGTH(X)
GOTO R1
IF X?.E1C.E
GOTO R1
SET X("NET")=X_"@DOMAIN.NAME"
+22 IF $DATA(^XMD(4.2997,"B",X("LN")))
SET %=""
FOR
SET %=$ORDER(^XMD(4.2997,"B",X("LN"),%))
IF %=""
QUIT
IF $DATA(^XMD(4.2997,%,0))
SET %6=^XMD(4.2997,%,0)
IF X("NET")=$PIECE(%6,U,7)
SET XME="Already on file - not filed "
DO ER^XMDIR1
GOTO R1
+23 ;
+24 DO FILE^XMDIR1A(.X)
+25 GOTO R1
EOF DO ^%ZISC
DO END^XMDIR1A("NOAVA",90)
QUIT
+1 ;
+2 ;Strip leading and trailing spaces
STRIP(X) FOR
IF $EXTRACT(X)'=" "
QUIT
SET X=$EXTRACT(X,2,999)
+1 FOR
IF $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+2 QUIT X
NOWANG DO @^%ZOSF("ERRTN")
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"The error: "_$ZE_" occured !!!",!!
+2 GOTO Q^XMDIR1
REMOTES ;Edit/Add Remote members
+1 NEW DA,DIE,DR,DIC,DLAYGO,X,Y,DUOUT,DTOUT
+2 SET DIC=4.2997
SET DLAYGO=4.2997
SET DIC(0)="AELQMZ"
DO ^DIC
+3 IF $SELECT($DATA(DTOUT)
QUIT
+4 SET DA=+Y
SET DIE=4.2997
SET DR=".01:99999"
DO ^DIE
+5 QUIT
