source: WorldVistAEHR/trunk/r/EEO_COMPLAINT_TRACKING-EEO/EEOEOSE.m@ 1582

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1EEOEOSE ;HISC/JWR - Security check ;11/11/92 13:35
2 ;;2.0;EEO Complaint Tracking;**1,8**;Apr 27, 1995
3 S U="^" K FAIL
4 I '$D(DUZ) D ERROR S FAIL=1 Q
5 D EEOYSTN I '$D(EEOYSTN) D ERROR S FAIL=1 Q
6 I EEOYSTN="" D ERROR S FAIL=1 Q
7 S (EEOYSCR,DIC("S"),FAIL)=""
8 S EEOSTNAM=$P(^DIC(4,EEOYSPTR,0),U,1) Q
9ERROR ;Comes here for error message
10 W !!,?3,$C(7),"Contact Information Resource Management for access privileges."
11 Q
12KILL ;kills local variables
13 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
14 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
15 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
16 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)
17 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
18 Q
19EEOYSTN ;Determines station number
20 K EEOYSTN I $$SITE^EEOEEXMT'=$$SERVNO^EEOEEXMT S EEOYSTN=$$SITE^EEOEEXMT D PTR Q
21 K DIC,DIC(0)
22 S EEOYSTN=$P(^EEO(789.5,1,0),"^")
23 Q:'$D(EEOYSTN)
24PTR ;Determines Institution file IEN for station
25 S EEOYSPTR=$O(^DIC(4,"D",EEOYSTN,""))
26 Q
27SCREEN(Y) ;Provides a general security check for access to complaints
28 N DIC S DIC=$S($D(DIE):DIE,$D(DIC):DIC,1:$G(DCC)) N DIE S DIE=DIC
29 I $G(EEOCOUNS)>0 D SECED^EEOUTIL G:EEOSEC=1 NAY K EEOSEC
30 I $G(EEOCOUNS)'>0 I $P($G(^EEO(785,Y,1)),U,3)'>0&(+$G(^EEO(785,Y,"SEC"))'>0) G Q
31 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
32 I XQY0["Informal" D SECED^EEOUTIL I $G(EEOSEC)=1 K EEOSEC G NAY
33DELL ;Checks for delete status
34 I +Y>0 I $P($G(^EEO(785,+Y,12)),U,2)="D" G NAY
35 I $G(EEOCOUNS)'>0,$P($G(^EEO(785,+Y,1)),U,3)="",+$G(^EEO(785,+Y,"SEC"))="" G Q
36 I $G(EEOCOUNS)>0,+$G(^EEO(785,+Y,"SEC"))=DUZ G Q
37 I $G(EEOCOUNS)'>0 I $P($G(^EEO(785,+Y,1)),U,3)>0!(+$G(^EEO(785,+Y,"SEC"))=DUZ) G Q
38NAY K EEOSEC I 0
39Q Q $T
40CASENO ;Calculates the case number
41 Q:$G(DA)'>0&($G(XMZ)>0)
42 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))
43 S EEOZ=EEOZ_"-"_(DA\100000)_"-"_(100000-(DA-((DA\100000)*100000)))
44 N DR S DR="1.3///"_EEOZ D ^DIE K DR
45 Q
46INPUT ;Entry point to determine most computed date fields
47 ;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
48 S EP1=$P(EN1,";",2),EN1=$P(EN1,";"),EP2=$P(EN2,";",2),EN2=$P(EN2,";")
49 S ET2=$P($G(^EEO(785,D0,EN2)),U,EP2)
50 S ET1=$P($G(^EEO(785,D0,EN1)),U,EP1)
51 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:"")
52 S X2=$S(ET2'="":ET2,1:"")
53 S (EN4,X1)=$S(ET1'="":ET1,ET2="":X2,ETC'="":ETC,1:DT)
54 I X2>ETC&(ETC=X1) S X=" " D KINP Q
55 D ^%DTC S:ETC=""&(EN4=DT) X=X_"*"
56KINP K EP1,EN1,EN2,EP1,EP2,EG,EH,EN4,ETC,ET1,ET2
57 Q
58DEL() ;Security check for deletions to EEO files
59 I '($D(STANO)!($D(EEOYSTN))) W !!,"NO DELETEIONS EXCEPT THROUGH EEO PACKAGE",!! G Q
60 G NAY
61NOSEC ;No security message
62 K EEOYSTN,EEOYSPTR W !!,"NO SECURITY FOR EEO DATA ACCESS FOR THIS STATION",!! Q
63NODE ;Assignments of file 785 IENs are made here
64 I 'STANO W !!,"MUST ENTER THROUGH ASSOCIATED PACKAGE",!! K X Q
65 Q:$G(DIC(0))'["L"
66 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
67 S DINUM=Z-1 I $D(EEO("DA")),$D(^EEO(785,EEO("DA"))) K DINUM L -^EEO(785,0) Q
68NODE1 I $D(^EEO(785,"ANODE",DINUM)) S DINUM=DINUM-1 G NODE1
69 L -^EEO(785,0) Q
70TEST ;Part of input transform for .01 field of file 785
71 S Y(0)=Y S:'$D(XQY0) XQY0="" S D0=$S($D(D0):D0,+Y>0:+Y,$D(DS):+DS,1:"")
72 I D0'>0 Q
73 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
Note: See TracBrowser for help on using the repository browser.