| 1 | XMDIR1B ;(WASH ISC)/CAP-Load VACO Directories (NOAVA) ;04/17/2002 08:47
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; Entry points used by MailMan options (not covered by DBIA):
|
|---|
| 4 | ; REMOTES XMEDIT-REMOTE-USER
|
|---|
| 5 | I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
|
|---|
| 6 | S X="EOF^XMDIR1B",@^%ZOSF("TRAP"),XMB0=^%ZOSF("UPPERCASE")
|
|---|
| 7 | GO G P:'$D(ZTQUEUED)
|
|---|
| 8 | R1 U IO R Y:DTIME I '$D(ZTQUEUED) U IO(0)
|
|---|
| 9 | S XMA=XMA+1 I '$D(ZTQUEUED),XMA#10=0 W "."
|
|---|
| 10 | P S X=Y X XMB0 F %=0:0 Q:$E(Y)'?1P S Y=$E(Y,2,99)
|
|---|
| 11 | F %=$L(Y):-1:0 Q:$E(Y,%)?1A S Y=$E(Y,1,%-1)
|
|---|
| 12 | K X S X=$$STRIP($P(Y,":"))
|
|---|
| 13 | 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
|
|---|
| 14 | S XMY=Y
|
|---|
| 15 | ;
|
|---|
| 16 | ;Name
|
|---|
| 17 | S X("LN")=X
|
|---|
| 18 | S X=$$STRIP($P(XMY,":",2)),X("FN")=X,X("RN")=""
|
|---|
| 19 | ;
|
|---|
| 20 | ;Mail code
|
|---|
| 21 | S X=$$STRIP($P(XMY,":",6)),X("MC")=$P(X," "),X("EMC")=X G R1:X("MC")?.E1C.E
|
|---|
| 22 | ;
|
|---|
| 23 | ;Phone number / Extension
|
|---|
| 24 | S X("PHONE")=$$STRIP($P(XMY,":",5)),X("PHONE/E")=$$STRIP($P(XMY,":",7))
|
|---|
| 25 | ;
|
|---|
| 26 | ;Location
|
|---|
| 27 | S X("L")=$$STRIP($P(XMY,":",4))
|
|---|
| 28 | ;
|
|---|
| 29 | ;Network address
|
|---|
| 30 | S X=$$STRIP($P(XMY,":",9)),X=$P(X,"@")
|
|---|
| 31 | G R1:'$L(X),R1:X?.E1C.E S X("NET")=X_"@VACO.VA.GOV"
|
|---|
| 32 | 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
|
|---|
| 33 | ;
|
|---|
| 34 | D FILE^XMDIR1A(.X)
|
|---|
| 35 | G R1
|
|---|
| 36 | EOF D ^%ZISC,END^XMDIR1A("NOAVA",90) Q
|
|---|
| 37 | ;
|
|---|
| 38 | ;Strip leading and trailing spaces
|
|---|
| 39 | STRIP(X) F Q:$E(X)'=" " S X=$E(X,2,999)
|
|---|
| 40 | F Q:$E(X,$L(X))'=" " S X=$E(X,1,$L(X)-1)
|
|---|
| 41 | Q X
|
|---|
| 42 | NOWANG D @^%ZOSF("ERRTN")
|
|---|
| 43 | I '$D(ZTQUEUED) W !!,"The error: "_$ZE_" occured !!!",!!
|
|---|
| 44 | G Q^XMDIR1
|
|---|
| 45 | REMOTES ;Edit/Add Remote members
|
|---|
| 46 | N DA,DIE,DR,DIC,DLAYGO,X,Y,DUOUT,DTOUT
|
|---|
| 47 | S DIC=4.2997,DLAYGO=4.2997,DIC(0)="AELQMZ" D ^DIC
|
|---|
| 48 | Q:$S($D(DTOUT):1,$D(DUOUT):1,Y<1:1,1:0)
|
|---|
| 49 | S DA=+Y,DIE=4.2997,DR=".01:99999" D ^DIE
|
|---|
| 50 | Q
|
|---|
