74 lines
4.3 KiB
Mathematica
74 lines
4.3 KiB
Mathematica
EEOEOSE ;HISC/JWR - Security check ;11/11/92 13:35
|
|
;;2.0;EEO Complaint Tracking;**1,8**;Apr 27, 1995
|
|
S U="^" K FAIL
|
|
I '$D(DUZ) D ERROR S FAIL=1 Q
|
|
D EEOYSTN I '$D(EEOYSTN) D ERROR S FAIL=1 Q
|
|
I EEOYSTN="" D ERROR S FAIL=1 Q
|
|
S (EEOYSCR,DIC("S"),FAIL)=""
|
|
S EEOSTNAM=$P(^DIC(4,EEOYSPTR,0),U,1) Q
|
|
ERROR ;Comes here for error message
|
|
W !!,?3,$C(7),"Contact Information Resource Management for access privileges."
|
|
Q
|
|
KILL ;kills local variables
|
|
K EEOSTPTR,EEOYSTN,EEOYANS,EEOSTNAM,EEOYSPTR,EEOYSCR,EEOYQ,DIC,DIE,DA,DIR,DR,EDA,FAIL,EDIT,SITE,CLIENT,CLIENTNO,SERV,SERVNO,STANO,WHAT,EN2,EN1,EP1,EP2,EF,EG,EH,EI,HE,EEODIC,EEONAME,EEOY
|
|
K A3,A5,ACP,ACR,ADDINV,ADV,AZ,B1,BLANK,BOX,BYCASE,CLO,CN,CN1,CN2,CN3,CNT,CNTR,CNT5,CNZ,CRT,CX,CT,D1,DATA,DATA1,DECR,DEL,DHD,DIDEL,DINUM,DOMFROM,E3,EC1,EDO,EEO,EEO1,EEO1J,EEO1L,EEO2,EEOA,EEOAX,EEOB,EEOC,EEODAD,EEODATE,EEODT
|
|
K EEOEE,EEOI,EEOFILE,EEOINV,EEOKEY,EEOM,EEON0,EEON5,EEOO,EEOOE,EEOP1,EEOPL,EEOQ,EEOR,EEOREV,EEOS,EEOSEQ,EEOT,EEOTMP,EEOTYPE,EEOXX,EEOY1,EEOYI,EEOYZ,EEOZI,EEX,EF,EFLG,EN3,ENP1,ENP2,ENP3,EO1,EOO,EOO1,F1,F2,F3,FAD,FF,FLD,FYI,HEA
|
|
K INP,INV,KN,KN1,KT,KT1,KT7,LABEL,MFILE,NOD,NOW,NOWP,PFILE,PIE,PIECE,SPOT,STN,STRING,SUB,SUB1,TYPE,XMY,XMZ,EEOVA,EEOTITL,CNT1,CON,DTO,EEOG,EEON3,POP,XMSER,XMSUB,XMTEXT,XQMSG,DIS(0)
|
|
K AEE,BEE,CEE,DEE,EEE,FEE,GEE,VEE,NEE,OEE,LEE,KEE,JEE,PEE,EEOII,EEON1,EEON2,EEON3,EEON5,EEON6,EEON12,EEOZ,EEOFF,EEOCTF,EEOMU,EEO3,EEOOF,EEOPT,TMP,C,CNO,CNQ,CNU,CNY,DO,DDH,DI,DQ,EEO3,EEOOF,EEOP,TMP("EEOACK"),D0
|
|
Q
|
|
EEOYSTN ;Determines station number
|
|
K EEOYSTN I $$SITE^EEOEEXMT'=$$SERVNO^EEOEEXMT S EEOYSTN=$$SITE^EEOEEXMT D PTR Q
|
|
K DIC,DIC(0)
|
|
S EEOYSTN=$P(^EEO(789.5,1,0),"^")
|
|
Q:'$D(EEOYSTN)
|
|
PTR ;Determines Institution file IEN for station
|
|
S EEOYSPTR=$O(^DIC(4,"D",EEOYSTN,""))
|
|
Q
|
|
SCREEN(Y) ;Provides a general security check for access to complaints
|
|
N DIC S DIC=$S($D(DIE):DIE,$D(DIC):DIC,1:$G(DCC)) N DIE S DIE=DIC
|
|
I $G(EEOCOUNS)>0 D SECED^EEOUTIL G:EEOSEC=1 NAY K EEOSEC
|
|
I $G(EEOCOUNS)'>0 I $P($G(^EEO(785,Y,1)),U,3)'>0&(+$G(^EEO(785,Y,"SEC"))'>0) G Q
|
|
I $G(XQY0)["Edit" G:$P($G(^EEO(785,Y,1)),U,3)'="" DELL I $P($G(^(1)),U,3)=""&(+$G(^EEO(785,Y,"SEC"))'=DUZ) G NAY
|
|
I XQY0["Informal" D SECED^EEOUTIL I $G(EEOSEC)=1 K EEOSEC G NAY
|
|
DELL ;Checks for delete status
|
|
I +Y>0 I $P($G(^EEO(785,+Y,12)),U,2)="D" G NAY
|
|
I $G(EEOCOUNS)'>0,$P($G(^EEO(785,+Y,1)),U,3)="",+$G(^EEO(785,+Y,"SEC"))="" G Q
|
|
I $G(EEOCOUNS)>0,+$G(^EEO(785,+Y,"SEC"))=DUZ G Q
|
|
I $G(EEOCOUNS)'>0 I $P($G(^EEO(785,+Y,1)),U,3)>0!(+$G(^EEO(785,+Y,"SEC"))=DUZ) G Q
|
|
NAY K EEOSEC I 0
|
|
Q Q $T
|
|
CASENO ;Calculates the case number
|
|
Q:$G(DA)'>0&($G(XMZ)>0)
|
|
S EEOZ=$S('$D(^EEO(785,DA,1)):"P",'$P(^(1),"^",3):"P",$E($P(^(1),"^",3),4,5)>9:$E($P(^(1),"^",3),2,3)+1,1:$E($P(^(1),"^",3),2,3))
|
|
S EEOZ=EEOZ_"-"_(DA\100000)_"-"_(100000-(DA-((DA\100000)*100000)))
|
|
N DR S DR="1.3///"_EEOZ D ^DIE K DR
|
|
Q
|
|
INPUT ;Entry point to determine most computed date fields
|
|
;I EN1="1;2" I $P($G(^EEO(785,D0,1)),U,3)<1&($P($G(^(1)),U,2)<1)&($P($G(^EEO(785,D0,6)),U,3)>0) S X1=$P($G(^(6)),U,3),X2=$P($G(^EEO(785,D0,1)),U,12) D ^%DTC Q
|
|
S EP1=$P(EN1,";",2),EN1=$P(EN1,";"),EP2=$P(EN2,";",2),EN2=$P(EN2,";")
|
|
S ET2=$P($G(^EEO(785,D0,EN2)),U,EP2)
|
|
S ET1=$P($G(^EEO(785,D0,EN1)),U,EP1)
|
|
S ETC=$S($P($G(^EEO(785,D0,4)),U)>0:+$G(^(4)),$P($G(^EEO(785,D0,5)),U,12)>0&(EN1'=4):$P(^(5),U,12),1:"")
|
|
S X2=$S(ET2'="":ET2,1:"")
|
|
S (EN4,X1)=$S(ET1'="":ET1,ET2="":X2,ETC'="":ETC,1:DT)
|
|
I X2>ETC&(ETC=X1) S X=" " D KINP Q
|
|
D ^%DTC S:ETC=""&(EN4=DT) X=X_"*"
|
|
KINP K EP1,EN1,EN2,EP1,EP2,EG,EH,EN4,ETC,ET1,ET2
|
|
Q
|
|
DEL() ;Security check for deletions to EEO files
|
|
I '($D(STANO)!($D(EEOYSTN))) W !!,"NO DELETEIONS EXCEPT THROUGH EEO PACKAGE",!! G Q
|
|
G NAY
|
|
NOSEC ;No security message
|
|
K EEOYSTN,EEOYSPTR W !!,"NO SECURITY FOR EEO DATA ACCESS FOR THIS STATION",!! Q
|
|
NODE ;Assignments of file 785 IENs are made here
|
|
I 'STANO W !!,"MUST ENTER THROUGH ASSOCIATED PACKAGE",!! K X Q
|
|
Q:$G(DIC(0))'["L"
|
|
L +^EEO(785,0):0 S Z=$O(^EEO(785,"ANODE",STANO*100000)) I Z=""!(Z>(STANO+1*100000-1)) S DINUM=STANO+1*100000-1 G NODE1
|
|
S DINUM=Z-1 I $D(EEO("DA")),$D(^EEO(785,EEO("DA"))) K DINUM L -^EEO(785,0) Q
|
|
NODE1 I $D(^EEO(785,"ANODE",DINUM)) S DINUM=DINUM-1 G NODE1
|
|
L -^EEO(785,0) Q
|
|
TEST ;Part of input transform for .01 field of file 785
|
|
S Y(0)=Y S:'$D(XQY0) XQY0="" S D0=$S($D(D0):D0,+Y>0:+Y,$D(DS):+DS,1:"")
|
|
I D0'>0 Q
|
|
S:$P($G(^EEO(785,D0,1)),U,3)=""&($G(^EEO(785,D0,"SEC"))'=DUZ!(XQY0["REPORT")!(XQY0["ADHOC")) Y=$P($G(^EEO(785,D0,5)),U,6) Q
|