source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRERR.m@ 771

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1IMRERR ;ISC-SF/JLI/WAA-ERROR TO GENERATE AN ALERT ON INVALID ACCESS TRAPPING ;3/3/99 15:39
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**6**;Feb 09, 1998
3 ;
4ACESSERR ;
5 S X="N",%DT="TS" D ^%DT
6 S ^IMR(158.8,Y,0)=Y_U_DUZ_U_IMRLOC,^IMR(158.8,"B",Y,Y)="",^(0)=$P(^IMR(158.8,0),U,1,2)_U_Y_U_($P(^(0),U,4)+1)
7 S X="BADACESS" D @X
8 D H^XUS K %DT,X,Y,IMRLOC,DIC
9 Q
10 ;
11 ; The following entries are referenced by the "SCR" nodes associated
12 ; with the files used in this package.
13 ;
14SETA ;
15SETMGR(ACCESS) ; This change was made on 3/3/99 by WAA
16 ; Input:
17 ; ACCESS=File DD Number
18 ;
19 S IMRLOC="File Access "_$G(ACCESS) D ACESSERR
20 Q
21BADACESS ;
22 W !!!!!," YOU HAVE INSUFFICIENT SECURITY TO ACCESS THIS OPTION"
23 W !," SEE YOUR IMMUNOLOGY COORDINATOR FOR THE PROPER KEYS",!!
24ALERT N XX,XQA
25 S STAT=$O(^IMR(158.9,0)) Q:STAT'>0
26 S XX=0 F S XX=$O(^IMR(158.9,STAT,1,"B",XX)) Q:XX'>0 S XQA(XX)=""
27 Q:'$D(XQA)
28 S XQAID="IMR ACCESS VIOLATION NOTICE"
29 D NOW^%DTC S IMRT=$E(%,4,5)_"/"_$E(%,6,7)_"/"_(1700+$E(%,1,3))_" @"_$E($P(%,".",2),1,1)_":"_$E($P(%,".",2),3,4)
30 I DUZ>0 S NAME=$$GET1^DIQ(200,DUZ,.01),NAME=$G(NAME)
31 S IMRY0=$G(XQY0)
32 S XQAMSG="IMR ACCESS VIOLATION BY "_NAME_" "_IMRT_" "_$P($G(IMRY0),U)
33 S XQADATA=NAME_"^"_IMRT_"^"_$G(IMRLOC)_"^"_$P(IMRY0,U)_"^"_$P(IMRY0,U,2)
34 S XQAFLAG="R"
35 S XQAROU="LOOK^IMRERR"
36 D SETUP^XQALERT
37 H 4
38 Q
39LOOK ;
40 S IMRN=$P(XQADATA,U),IMRT=$P(XQADATA,U,2),IMROI="["_$P(XQADATA,U,4)_"]"
41 S IMROO=$P(XQADATA,U,5),IMRLOC=$P(XQADATA,U,3)
42 W @IOF
43 W !,"IMR - IMMUNOLOGY UNATHORIZED ACCESS ATTEMPT",!
44 W !,"An attempt was made to invoke IMR functionality by a person who does"
45 W !,"not have the neccessary Security Keys. Details of this attempt"
46 W !,"are as follows:"
47 W !!,"Violator's Name: "_IMRN
48 W !,"Time: "_IMRT
49 W !,"VIOLATION: ",$S($G(IMRLOC)'="":IMRLOC,1:"UNKNOWN")
50 W !!,"ACCESS WAS ATTEMPTED BUT NOT GAINED",!!
51 N DIR S DIR(0)="E" D ^DIR
52 Q
Note: See TracBrowser for help on using the repository browser.