source: FOIAVistA/trunk/r/EEO_COMPLAINT_TRACKING-EEO/EEOEOSE.m@ 899

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