| [613] | 1 | XMDIR1A ;(WASH ISC)/CAP-Load VACO Directories (WANG) ;04/17/2002 08:47
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
|
|---|
| 4 | S X="EOF^XMDIR1A",@^%ZOSF("TRAP"),XMB0=^%ZOSF("UPPERCASE")
|
|---|
| 5 | G P:'$D(ZTQUEUED)
|
|---|
| 6 | ;Batch processing begins here
|
|---|
| 7 | R1 U IO R Y:DTIME I '$D(ZTQUEUED) U IO(0)
|
|---|
| 8 | S XMA=XMA+1 I '$D(ZTQUEUED),XMA#10=0 W "."
|
|---|
| 9 | P S X=Y X XMB0 F %=0:0 Q:$E(Y)'?1P S Y=$E(Y,2,99)
|
|---|
| 10 | F %=$L(Y):-1:0 Q:$E(Y,%)?1A S Y=$E(Y,1,%-1)
|
|---|
| 11 | K X S X=$P(Y,"*")
|
|---|
| 12 | G R1:X[" ",R1:X["@",R1:X["::",R1:X[".."
|
|---|
| 13 | S XMY=Y
|
|---|
| 14 | ;
|
|---|
| 15 | 1 ;Name
|
|---|
| 16 | S X("LN")=$P(X,".",$L(X,".")),X=$P(X,".",1,$L(X,".")-1)
|
|---|
| 17 | G R1:'$L(X("LN")),R1:X("LN")?1.N,R1:X("LN")?.E3N.E,R1:X("LN")["/"
|
|---|
| 18 | G R1:X("LN")?.E1C.E
|
|---|
| 19 | S X("FN")=$P(X,"."),X=$P(X,".",2,9),X("RN")=X
|
|---|
| 20 | ;
|
|---|
| 21 | ;Mail code
|
|---|
| 22 | S X=$P(Y,"*",2),X("MC")=$P(X," "),X("EMC")=X G R1:X("MC")?.E1C.E
|
|---|
| 23 | ;
|
|---|
| 24 | ;Location
|
|---|
| 25 | S X("L")=$P(Y,"*",3)
|
|---|
| 26 | ;
|
|---|
| 27 | ;Network address
|
|---|
| 28 | S Y=$P(XMY,"*") G R1:'$L(Y),R1:Y?.E1C.E S X("NET")=Y_"@VACOWMAIL.VA.GOV"
|
|---|
| 29 | 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
|
|---|
| 30 | ;
|
|---|
| 31 | D FILE(.X)
|
|---|
| 32 | G R1
|
|---|
| 33 | FILE(X) ;HARD CODE
|
|---|
| 34 | ;
|
|---|
| 35 | ;X("EMC")=Extended Mail Code
|
|---|
| 36 | ;X("FN")=First name
|
|---|
| 37 | ;X("L")=Location
|
|---|
| 38 | ;X("LN")=Last name
|
|---|
| 39 | ;X("MC")=Mail Code
|
|---|
| 40 | ;X("NET")=full NETwork address
|
|---|
| 41 | ;X("PHONE")=Phone number
|
|---|
| 42 | ;X("PHONE/E")=Telephone Extension
|
|---|
| 43 | ;X("RN")=Restofname
|
|---|
| 44 | ;
|
|---|
| 45 | ;Get new entry number
|
|---|
| 46 | N %,N,Y L +^XMD(4.2997,0)
|
|---|
| 47 | S Y=^XMD(4.2997,0) F N=$P(Y,U,4)+1:1 Q:'$D(^(N))
|
|---|
| 48 | L +^XMD(4.2997,N) S $P(Y,U,4)=N,^XMD(4.2997,0)=Y
|
|---|
| 49 | ;File entry
|
|---|
| 50 | S ^XMD(4.2997,N,0)=X("LN")_U_X("FN")_U_X("RN")_U_X("MC")_U_X("EMC")_U_X("L")_U_X("NET")_U_+$H_U_XMDIR1,^("AUTO")=XMDIR1A("CODE")
|
|---|
| 51 | I $D(X("PHONE"))!$D(X("PHONE/X")) S %=$G(X("PHONE")) S:$L($G(X("PHONE/X"))) %=%_U_X("PHONE/X") S ^XMD(4.2997,N,1)=%
|
|---|
| 52 | ;Create cross references for one entry
|
|---|
| 53 | S DIK="^XMD(4.2997,",DA=N D IX^DIK L -^XMD(4.2997,0),-^XMD(4.2997,N)
|
|---|
| 54 | Q
|
|---|
| 55 | EOF D ^%ZISC,END("WANG",90) Q
|
|---|
| 56 | END(X,Y) ;END PROCESSING
|
|---|
| 57 | ;X=NAME OF FILE (WANG or NOAVA)
|
|---|
| 58 | ;Y=Subscript of text array
|
|---|
| 59 | N A S A=X,XMDIR1($E(X))=XMA
|
|---|
| 60 | S ^TMP("XMDIR1",$J,.01)="Normal error reported here",^(.02)="("_$ZE_")",^(.03)="should be end of File."
|
|---|
| 61 | S ^TMP("XMDIR1",$J,.04)="Done processing "_A_" file on "_$$HTE^XLFDT($H,5)
|
|---|
| 62 | S ^TMP("XMDIR1",$J,.05)=""
|
|---|
| 63 | Q
|
|---|
