source: WorldVistAEHR/trunk/r/EEO_COMPLAINT_TRACKING-EEO/EEOEXE1.m@ 1036

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1EEOEXE1 ;HISC/JWR - EEO SERVER ROUTINE (VERSION 2.0 SITES);2/25/93 13:03
2 ;;2.0;EEO Complaint Tracking;**2**;Apr 27, 1995
3 S:$D(X) EEODX=X S XQSTXT="XQSTXT("
4 I '$D(^XMB(3.9,XMZ,2,1,0)) S XQSTXT(10)="<ERROR> Could not find the first line of the message" G EXIT
5 S STANO=^XMB(3.9,XMZ,2,1,0),TYPE=$P(STANO,"^",2),EEOKEY=$P($G(STANO),"^",3),STANO=+STANO,X=$O(^DIC(4,"D",STANO,""))
6 G:EEOKEY'>19 ^EEOEEXE
7 I TYPE'="DATA"&(TYPE'="FILE")&(TYPE'="INV") S XQSTXT(10)="<ERROR> Message missent to the EEO_DATA Server" G EXIT
8 S X="NOW",%DT="DTXO" D ^%DT S NOWP=Y K %DT
9 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
10 I '$D(DOMFROM) S DOMFROM=$P(^XMB(1,1,0),"^"),DOMFROM=$P(^DIC(4.2,DOMFROM,0),"^")
11 F X=2:1 Q:'$D(^XMB(3.9,XMZ,2,X)) Q:^(X,0)="&&&&&"
12 F EEO("LINE")=2:1 Q:'$D(^XMB(3.9,XMZ,2,EEO("LINE"),0)) Q:(^(0))="&&&&&"
13 S EEO("LINE")=EEO("LINE")+1
14 F EEO("LINE")=EEO("LINE"):2 Q:'$D(^XMB(3.9,XMZ,2,EEO("LINE"),0)) D
15 .D:TYPE="DATA" DEC D:TYPE="FILE"!(TYPE="INV") STAN S EEO("LABEL")=$P(EEO("NODE"),U),EEO("DA")=$P(EEO("NODE"),U,3),(DIDEL,EEO("FILE"))=$P(EEO("NODE"),U,2),GEE=$P(EEO("NODE"),U,5),EEO("NODE")=$P(EEO("NODE"),U,4)
16ELOCK .;Breaks doun data strings for decryption
17 .S:EEO("FILE")=789 EEO("FILE")=785 L +^EEO(EEO("FILE"),EEO("DA")):0 I $T=0 H 10 G ELOCK
18 .I EEO("LABEL")'="ANODE" S DA=EEO("DA"),DATA=$P(EEO("STRING"),U),DIE=EEO("FILE") K DR D @EEO("LABEL") K DR L -^EEO(EEO("FILE"),EEO("DA")) Q
19 .F EEO=1:1 S EEO("DATA")=$P(EEO("STRING"),"^",EEO) Q:$P(EEO("STRING"),"^",EEO,999)="" I EEO("DATA")]"" D
20 ..S EEO("FIELD")=$O(^DD(EEO("FILE"),"GL",EEO("NODE"),EEO,""))
21 ..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
22 ..Q:EEO("FIELD")=""
23 ..K DR S DIE=EEO("FILE"),DA=EEO("DA")
24 ..I $P(^DD(EEO("FILE"),EEO("FIELD"),0),U,2)["D" S DR=EEO("FIELD")_"////"_EEO("DATA") D ^DIE Q
25 ..;S DIDEL=785
26 ..S DR=EEO("FIELD")_"///"_EEO("DATA") D ^DIE
27 .I EEO("FILE")=785 S DA=EEO("DA") D CASENO^EEOEOSE
28 .L -^EEO(EEO("FILE"),EEO("DA"))
29EXITOK ;
30 I $G(EEO("FILE"))>780 L -^EEO(EEO("FILE"),0)
31 S X="XMA1C" X ^%ZOSF("TEST") I $T S XMSER="S.EEO UPLINK SERVER",XMZ=XQMSG D REMSBMSG^XMA1C
32EXIT ;
33 S XMDUZ="EEO SERVER FOR "_^DD("SITE") K EEOD,EEODX,EEOE,EEO,DR,STANO,EEOKEY,DIDEL,CN1,CN2,CN3,DATA,TYPE,EEON1,EEONOD,EEOL Q
34DEC ;Decryption on data strings
35 K EEO("STRING") S X=^XMB(3.9,XMZ,2,EEO("LINE"),0),X1=$$SITE^EEOEEXMT,X2=EEO("LINE")
36 D DE^XUSHSHP S EEO("NODE")=X,X2=X2+1
37 S EEON1=^XMB(3.9,XMZ,2,EEO("LINE")+1,0),EEOL=$L(EEON1)
38 I EEOL<50 S X=EEON1 D DE^XUSHSHP S EEO("STRING")=X Q
39 I EEOL'<50 F EEOC=0:50:250 S X=$E(EEON1,EEOC+1,EEOC+50) D DE^XUSHSHP D
40 .I $D(EEO("STRING")) S EEO("STRING")=EEO("STRING")_X Q
41 .I '$D(EEO("STRING")) S EEO("STRING")=X
42 K EEOL,EEON1,EEOC Q
43 Q
44BASIS ;Basis data served
45 S DR="18.5///"_DATA,DR(2,785.01)=".01///"_DATA D ^DIE
46 Q
47ISSUE ;Issue code served
48 S DR="17.5///"_DATA,DR(2,785.02)=".01///"_DATA_";1///"_$P(EEO("STRING"),U,2) D ^DIE
49 Q
50CORR ;Corrective action served
51 S DR="61///"_DATA,DR(2,785.061)=".01///"_DATA D ^DIE
52 Q
53INVEST ;Investigator data served
54 S EEO("ROOT")=""
55 I $D(^EEO(785,DA,11,"B",DATA)) S EEOETE=$O(^(DATA,0)) Q:EEOETE'>0 D
56 .F S EEOETE=$O(^EEO(785,DA,11,"B",DATA,EEOETE)) Q:EEOETE'>0 D
57 ..K ^EEO(785,DA,11,"B",DATA,EEOETE),^EEO(785,DA,11,EEOETE)
58 .S (EEOFF,EEOETE)=0 F S EEOETE=$O(^EEO(785,DA,11,EEOETE)) Q:EEOETE'>0 S EEOFF=EEOFF+1,EEOFIV=EEOETE
59 .S:EEOFF>0 ^EEO(785,DA,11,0)="^785.03P^"_EEOFIV_"^"_EEOFF
60 .K EEOFF,EEOETE,EEOFIV
61 Q:GEE=0!('$D(^EEO(787.5,DATA))) S DATA(1)=$P($G(^EEO(787.5,DATA,0)),U)
62 S DR="27.5///"_DATA(1),DR(2,785.03)=".01///"_DATA(1)
63 F CN1=2:1:10 S DATA1=$P(EEO("STRING"),U,CN1) I DATA1'="" D
64 .S CN3=$O(^DD(785.03,"GL",0,CN1,""))
65 .S DR(2,785.03)=DR(2,785.03)_";"_CN3_"///"_DATA1
66 D ^DIE
67WP Q
68STAN S EEO("NODE")=^XMB(3.9,XMZ,2,EEO("LINE"),0)
69 S EEO("STRING")=^XMB(3.9,XMZ,2,EEO("LINE")+1,0)
70 Q
71ADINV ;Update an investigator in file 787.5
72 S EEO("ROOT")="",DIE=787.5 S:EEO("NODE")=0 EEOINV=$P(EEO("STRING"),U)
73 F EEOPL=1:1:6 S EEOI(EEOPL)=$P(EEO("STRING"),U,EEOPL)
74 S DA=EEO("DA")
75 I EEO("NODE")=0 S DR=".01///"_EEOINV_";2///"_EEOI(3)_";3///"_EEOI(4)_";4///"_EEOI(5)_";5///"_EEOI(6)
76 I EEO("NODE")>0 S DR="27.5///"_EEOINV_";1///"_EEOI(1),DR(2,787.51)=".01///"_EEOI(1)_";1///"_EEOI(2)_";2///"_EEOI(3)
77 D ^DIE K EEOI,DR Q
78INFILE ;Adds an investigator to file 787.5
79 N DIC S DINUM=DA,X=EEOINV,DIC="^EEO(787.5,",DIC(0)="L" D FILE^DICN
80 Q
81IN ;Test for incomplete investigator info
82 S:EEO("DA")=0 DR="1///"_DATA,DR(2,787.51)=".01///"_DATA_";1///"_$P(EEO("STRING"),U,2)_";2///"_$P(EEO("STRING"),U,3) D ^DIE Q
83ADDINV F CNT5=1:1:3 S ADDINV(CNT5)=$P(EEO("STRING"),U,CNT5)
84 S DR(2,787.51)=".01///"_ADDINV(1)_";1///"_ADDINV(2)_";2///"_ADDINV(3)
85 S DR="1///"_ADDINV(1),DA=EEO("DA"),DIE=787.5 D ^DIE
86 K CNT5,ADDINV,DR,DIE,DA Q
Note: See TracBrowser for help on using the repository browser.