- 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
