59 lines
3.6 KiB
Mathematica
59 lines
3.6 KiB
Mathematica
EEOEEXE ;HISC/JWR - EEO SERVER ROUTINE (VERSION 1.0 SITES);2/25/93 13:03
|
|
;;2.0;EEO Complaint Tracking;;Apr 27, 1995
|
|
S:$D(X) EEODX=X S XQSTXT="XQSTXT("
|
|
;I '$D(^XMB(3.9,XMZ,2,1,0)) S XQSTXT(10)="<ERROR> Could not find the first line of the message" G EXIT
|
|
S STANO=^XMB(3.9,XMZ,2,1,0),TYPE=$P(STANO,"^",2),EEOKEY=$P($G(STANO),"^",3),STANO=+STANO Q:EEOKEY>19
|
|
;S X=$O(^DIC(4,"D",STANO,"")) ;I X="" S XQSTXT(10)="<ERROR> Could not find the station requested "_STANO_" Call the ISC. XMZ= "_XMZ G EXIT
|
|
;S STAPTR=X
|
|
I '(TYPE="DATA") S XQSTXT(10)="<ERROR> Message missent to the EEO_DATA Server" G EXIT
|
|
;Q:TYPE["STATUS"
|
|
S X="NOW",%DT="DTXO" D ^%DT S NOWP=Y K %DT
|
|
S CNTR=10,EEOKEY=$P(^XMB(3.9,XMZ,2,1,0),U,3)
|
|
F X=.001:.001 Q:'$D(^XMB(3.9,XMZ,2,X,0)) S Y=^(0) I Y["Message-ID:<" S DOMFROM=$P(Y,"@",2),DOMFROM=$P(DOMFROM,">",1) Q
|
|
I '$D(DOMFROM) S DOMFROM=$P(^XMB(1,1,0),"^"),DOMFROM=$P(^DIC(4.2,DOMFROM,0),"^")
|
|
K EEOD("MESS") F X=2:1 Q:'$D(^XMB(3.9,XMZ,2,X)) Q:^(X,0)="&&&&&"
|
|
S EEOD("&&&&&")=X
|
|
F EEO("LINE")=2:1 Q:'$D(^XMB(3.9,XMZ,2,EEO("LINE"),0)) Q:(^(0))="&&&&&" Q:EEO("LINE")'>0
|
|
S EEOM("DA")="",EEO("LINE")=EEO("LINE")+1
|
|
F EEO("LINE")=EEO("LINE"):2 Q:'$D(^XMB(3.9,XMZ,2,EEO("LINE"),0)) D
|
|
.I EEOKEY>10 D DEC S EEO("DA")=$P(EEO("NODE"),U,2),EEO("FILE")=+EEO("NODE"),EEO("NODE")=$P(EEO("NODE"),U,3),EEOQ=-1 D:EEOKEY<20&(EEO("NODE")=1!(EEO("NODE")=3)) F2MUL^EEOUTIL G ELOCK
|
|
NORM .S EEO("NODE")=^XMB(3.9,XMZ,2,EEO("LINE"),0),(DIDEL,EEO("FILE"))=+EEO("NODE"),EEO("DA")=$P(EEO("NODE"),"^",2),EEO("NODE")=$P(EEO("NODE"),"^",3),EEOQ=-1
|
|
.S EEO("STRING")=^XMB(3.9,XMZ,2,EEO("LINE")+1,0)
|
|
ELOCK .L +^EEO(EEO("FILE"),EEO("DA")):0 I '$T H 30 G ELOCK
|
|
.F EEO=1:1 S EEO("DATA")=$P(EEO("STRING"),"^",EEO) Q:$P(EEO("STRING"),"^",EEO,999)="" I EEO("DATA")]"" D
|
|
..I $O(^DD(EEO("FILE"),"GL",EEO("NODE"),""))=0 D MULT Q
|
|
..S EEO("FIELD")=$O(^DD(EEO("FILE"),"GL",EEO("NODE"),EEO,""))
|
|
..S EEO("ROOT")=^DIC(EEO("FILE"),0,"GL")
|
|
..I '$D(^EEO(EEO("FILE"),EEO("DA"))) K DD,DIC,DINUM,DO S DIC="^EEO("_EEO("FILE")_",",DIC(0)="L",DLAYGO=EEO("FILE"),DINUM=EEO("DA"),X=$P(EEO("DATA"),"^",1) D FILE^DICN Q:Y<1 K DINUM,DLAYGO
|
|
..Q:EEO("FIELD")=""
|
|
..K DR S DIE=EEO("FILE"),DA=EEO("DA")
|
|
..I $P(^DD(EEO("FILE"),EEO("FIELD"),0),U,2)["D" S DR=EEO("FIELD")_"////"_EEO("DATA") D ^DIE Q
|
|
..S DIDEL=785
|
|
..S DR=EEO("FIELD")_"///"_EEO("DATA") D ^DIE
|
|
EXITOK S X="XMA1C" X ^%ZOSF("TEST") I $T S XMSER="S.EEO UPLINK SERVER",XMZ=XQMSG D REMSBMSG^XMA1C
|
|
L -^EEO(EEO("FILE"),EEO("DA"))
|
|
EXIT ;Kills local variables
|
|
S XMDUZ="EEO SERVER FOR "_^DD("SITE") K EEOD,EEODX,EEOE,EEO,DR,STANO,EEOKEY,DIDEL,CN1,CN2,CN3,DATA,EENOD,EEOL,EEON,TYPE Q
|
|
ERR G EXIT
|
|
Q
|
|
DEC ;Decrypts messages from version 1.0 sites
|
|
K EEO("STRING") S X=^XMB(3.9,XMZ,2,EEO("LINE"),0),X1=$$SITE^EEOEEXMT,X2=EEO("LINE")
|
|
D DE^XUSHSHP S EEO("NODE")=X,X2=X2+1
|
|
S EEON1=^XMB(3.9,XMZ,2,EEO("LINE")+1,0),EEOL=$L(EEON1)
|
|
I EEOL<50 S X=EEON1 D DE^XUSHSHP S EEO("STRING")=X Q
|
|
I EEOL'<50 F EEOC=0:50:250 S X=$E(EEON1,EEOC+1,EEOC+50) D DE^XUSHSHP D
|
|
.I $D(EEO("STRING")) S EEO("STRING")=EEO("STRING")_X Q
|
|
.I '$D(EEO("STRING")) S EEO("STRING")=X
|
|
K EEOL,EEON1,EEOC Q
|
|
Q
|
|
MULT ;Converts Version 1 non-multiples into version 2 multiple fields
|
|
S DIE=EEO("FILE"),EEO("FIELD")=$O(^DD(EEO("FILE"),"GL",EEO("NODE"),0,"")),SUB=+$P($G(^DD(EEO("FILE"),EEO("FIELD"),0)),U,2)
|
|
S DR=EEO("FIELD")_"///"_$P(EEO("STRING"),U)
|
|
SUBDR ;Makes sub-DR strings for Multiple fields
|
|
F EEO1=1:1 Q:$P(EEO("STRING"),U,EEO1,999)="" S EEO("DATA1")=$P(EEO("STRING"),U,EEO1) D
|
|
.S SUB1=$O(^DD(SUB,"GL",0,EEO1,"")),DR(2,SUB)=SUB1_"///"_EEO("DATA1")
|
|
D ^DIE
|
|
K DR,SUB,SUB1,EEO1 Q
|
|
STAN S EEO("NODE")=^XMB(3.9,XMZ,2,EEO("LINE"),0)
|
|
S EEO("STRING")=^XMB(3.9,XMZ,2,EEO("LINE")+1,0) Q
|