source: FOIAVistA/trunk/r/MAILMAN-XM/XMDIR1A.m@ 1119

Last change on this file since 1119 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1XMDIR1A ;(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
7R1 U IO R Y:DTIME I '$D(ZTQUEUED) U IO(0)
8 S XMA=XMA+1 I '$D(ZTQUEUED),XMA#10=0 W "."
9P 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 ;
151 ;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
33FILE(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
55EOF D ^%ZISC,END("WANG",90) Q
56END(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
Note: See TracBrowser for help on using the repository browser.