Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORRP013

RORRP013.m

Go to the documentation of this file.
  1. RORRP013 ;HCIOFO/SG - RPC: ACCESS & SECURITY ; 11/9/05 8:56am
  1. ;;1.5;CLINICAL CASE REGISTRIES;**18**;Feb 17, 2006;Build 25
  1. ;; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*18 APR 2012 C RAY Dynamically rebuilds ACL index
  1. ; Returns value of AUTO-CONFIRM
  1. ;
  1. ;***********************************************************************
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #10103 $$FMADD^XLFDT (supported)
  1. ; #10076 Direct read of XUSEC global
  1. ; BLD^DIALOG
  1. ; $$ROOT^DILFD
  1. ; $$GET1^DIQ
  1. ; GETS^DIQ
  1. ;
  1. Q
  1. ;
  1. ;***** RETURNS A LIST OF REGISTRIES ACCESSIBLE TO THE GUI USER
  1. ; RPC: [ROR GUI ACCESS]
  1. ;
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; [USER] User IEN in the NEW PERSON file. By default
  1. ; (if $G(USER)'>0), the DUZ is used).
  1. ;
  1. ; Return Values:
  1. ;
  1. ; A negative value of the first "^"-piece of the RESULTS(0) indicates
  1. ; an error (see the RPCSTK^RORERR procedure for more details).
  1. ;
  1. ; RESULTS(0) Number of accessible registries
  1. ;
  1. ; RESULTS(i) Registry descriptor
  1. ; ^01: Registry IEN
  1. ; ^02: Registry name
  1. ; ^03: Administrator? (0 or 1)
  1. ; ^04: Short description
  1. ; ^05: Auto Confirm (0 or 1)
  1. ;
  1. ACREGLST(RESULTS,USER) ;
  1. N ADMIN,CNT,IENS,KEY,RC,REGIEN,RORBUF,RORERRDL,RORMSG,TMP
  1. N REGNAME,DA
  1. K RESULTS S RESULTS(0)=0
  1. D CLEAR^RORERR("ACREGLST^RORRP013",1)
  1. ;--- Check the version of the GUI
  1. I $G(XWBAPVER)<1.5 D D RPCSTK^RORERR(.RESULTS,RC) Q
  1. . N DIERR,DIHELP,DIMSG
  1. . S TMP("CV")=$S($G(XWBAPVER)>0:XWBAPVER,1:"1.0")
  1. . S TMP("RV")="1.5"
  1. . D BLD^DIALOG(7980000.006,.TMP,,"RORBUF")
  1. . S RC=$$ERROR^RORERR(-107,,.RORBUF)
  1. . K RORBUF,TMP
  1. ;--- User must be defined
  1. I $G(USER)'>0 S USER=+$G(DUZ) Q:USER'>0
  1. ;
  1. ;-- Rebuild user ACL index of registry keys
  1. S REGIEN=0
  1. K ^ROR(798.1,"ACL",DUZ)
  1. F S REGIEN=$O(^ROR(798.1,REGIEN)) Q:REGIEN="" D
  1. . S KEY="",REGNAME=$$REGNAME^RORUTL01(REGIEN) Q:REGNAME=""!'+($P($G(^ROR(798.1,REGIEN,21)),U,4))
  1. . F S KEY=$O(^ROR(798.1,REGIEN,18,"B",KEY)) Q:KEY="" D:$D(^XUSEC(KEY,DUZ))
  1. . . S DA=$O(^ROR(798.1,REGIEN,18,"B",KEY,""))
  1. . . S ^ROR(798.1,"ACL",DUZ,REGIEN,KEY,DA)=""
  1. . . S ^ROR(798.1,"ACL",DUZ,$P(REGNAME,U),KEY,DA)=""
  1. ;--- end of re-build
  1. ;--- Returns registry descriptors
  1. S (CNT,RC,REGIEN)=0
  1. F S REGIEN=$O(^ROR(798.1,"ACL",USER,REGIEN)) Q:REGIEN="" D Q:RC<0
  1. . Q:REGIEN'>0 S IENS=REGIEN_"," K RORBUF
  1. . D GETS^DIQ(798.1,IENS,".01;4;31",,"RORBUF","RORMSG")
  1. . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,IENS) Q
  1. . ;--- Add the registry descriptor to the list
  1. . S CNT=CNT+1,RESULTS(CNT)=REGIEN_"^"_$G(RORBUF(798.1,IENS,.01))
  1. . S TMP=$G(RORBUF(798.1,IENS,31))
  1. . S $P(RESULTS(CNT),"^",5)=$S(TMP="YES":1,1:0) ;Auto confirm?
  1. . S $P(RESULTS(CNT),"^",4)=$G(RORBUF(798.1,IENS,4))
  1. . ;--- Check if the user has the administrator security key
  1. . S KEY="",ADMIN=0
  1. . F S KEY=$O(^ROR(798.1,"ACL",USER,REGIEN,KEY)) Q:KEY="" D Q:RC<0
  1. . . I KEY?1"ROR"1.E S:KEY["ADMIN" ADMIN=1
  1. . S $P(RESULTS(CNT),"^",3)=ADMIN
  1. ;
  1. I RC'<0 D:CNT'>0 S RESULTS(0)=CNT
  1. . D ACVIOLTN^RORLOG(-91) ; Record the access violation
  1. E D RPCSTK^RORERR(.RESULTS,RC)
  1. Q
  1. ;
  1. ;***** RETURNS THE LIST OF ACCESS VIOLATIONS
  1. ; RPC: [ROR LOG GET ACCESS VIOLATIONS]
  1. ;
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; [STDT] Start date (by default, from the earliest violation)
  1. ; [ENDT] End date (by default, to the latest violation)
  1. ;
  1. ; Return Values:
  1. ;
  1. ; A negative value of the first "^"-piece of the RESULTS(0) indicates
  1. ; an error (see the RPCSTK^RORERR procedure for more details).
  1. ;
  1. ; Otherwise, number of logs is returned in the RESULTS(0) and the
  1. ; subsequent nodes of the RESULTS array contain the violations.
  1. ;
  1. ; @RESULTS@(0) Number of access violations
  1. ;
  1. ; @RESULTS@(i) Access violation descriptor
  1. ; ^01: Date/Time (int)
  1. ; ^02: User Name
  1. ; ^03: User IEN
  1. ; ^04: Message
  1. ;
  1. AVLIST(RESULTS,STDT,ENDT) ;
  1. N BUF,CNT,DATE,IEN,IENS,RC,ROOT,RORBUF,RORERRDL,RORMSG
  1. D CLEAR^RORERR("AVLIST^RORRP013",1)
  1. ;--- Check the parameters
  1. S STDT=$G(STDT)\1,ENDT=$G(ENDT)\1
  1. S ENDT=$S(ENDT>0:$$FMADD^XLFDT(ENDT,1),1:9999999)
  1. ;--- Initialize the variables
  1. S ROOT=$$ROOT^DILFD(798.7,,1),CNT=0
  1. K RESULTS S RESULTS=$$ALLOC^RORTMP()
  1. ;--- Browse through the logs
  1. S DATE=STDT
  1. F S DATE=$O(@ROOT@("B",DATE)) Q:DATE="" Q:DATE'<ENDT D
  1. . S IEN=0
  1. . F S IEN=$O(@ROOT@("B",DATE,IEN)) Q:IEN'>0 D
  1. . . S IENS=IEN_"," K RORBUF
  1. . . D GETS^DIQ(798.7,IENS,".01;1;7","EI","RORBUF","RORMSG")
  1. . . Q:$G(DIERR)
  1. . . ;--- Check for the 'Access Violation' Activity
  1. . . Q:$G(RORBUF(798.7,IENS,1,"I"))'=6
  1. . . ;--- Date/Time of the event
  1. . . S BUF=$G(RORBUF(798.7,IENS,.01,"I"))
  1. . . ;--- User Name (ext)
  1. . . S $P(BUF,"^",2)=$G(RORBUF(798.7,IENS,7,"E"))
  1. . . ;--- User IEN (int)
  1. . . S $P(BUF,"^",3)=$G(RORBUF(798.7,IENS,7,"I"))
  1. . . ;--- Message
  1. . . S $P(BUF,"^",4)=$$GET1^DIQ(798.74,"1,"_IENS,2,,,"RORMSG")
  1. . . ;--- Add the record to the output
  1. . . S CNT=CNT+1,@RESULTS@(CNT)=BUF
  1. ;--- Number of violations
  1. S @RESULTS@(0)=CNT
  1. Q
  1. ;
  1. ;***** ADDS THE USERS WHO HAVE THE SECURITY KEY TO THE LIST
  1. ;
  1. ; KEYNAME Name of the security key
  1. ; ACCESS Level of the user access to the registry
  1. ; (1-User, 2-Administrator, 3-IRM)
  1. ;
  1. ; Return Values:
  1. ;
  1. KLIST(KEYNAME,ACCESS) ;
  1. N IEN S IEN=0
  1. F S IEN=$O(^XUSEC(KEYNAME,IEN)) Q:IEN'>0 D
  1. . S $P(@RORULST@(IEN,0),"^",ACCESS)=1
  1. Q
  1. ;
  1. ;***** RETURNS THE LIST OF REGISTRY USERS
  1. ; RPC: [ROR GET REGISTRY USERS]
  1. ;
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; REGIEN Registry IEN
  1. ;
  1. ; Return Values:
  1. ;
  1. ; A negative value of the first "^"-piece of the RESULTS(0) indicates
  1. ; an error (see the RPCSTK^RORERR procedure for more details).
  1. ;
  1. ; Otherwise, number of users is returned in the RESULTS(0) and the
  1. ; subsequent nodes of the RESULTS array contain the users.
  1. ;
  1. ; @RESULTS@(0) Number of users
  1. ;
  1. ; @RESULTS@(i) User descriptor
  1. ; ^01: User IEN (DUZ)
  1. ; ^02: User Name
  1. ; ^03: User (0/1)
  1. ; ^04: Administrator (0/1)
  1. ; ^05: IRM (0/1)
  1. ;
  1. USERLIST(RESULTS,REGIEN) ;
  1. N ACCESS,ADMIN,CNT,IEN,NAME,RORERRDL,RORMSG,RORULST
  1. D CLEAR^RORERR("USERLIST^RORRP013",1)
  1. ;--- Check the parameters
  1. I $G(REGIEN)'>0 D D RPCSTK^RORERR(.RESULTS,RC) Q
  1. . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
  1. S REGIEN=+REGIEN
  1. ;--- Initialize the variables
  1. K RESULTS S RESULTS=$$ALLOC^RORTMP()
  1. S RORULST=$$ALLOC^RORTMP()
  1. ;--- Browse the security keys
  1. S NAME=""
  1. F S NAME=$O(^ROR(798.1,REGIEN,18,"B",NAME)) Q:NAME="" D
  1. . S ADMIN=(NAME?1"ROR"1.E)&(NAME["ADMIN")
  1. . D KLIST(NAME,$S(ADMIN:2,1:1))
  1. ;--- Add the authorized IRM personnel
  1. D KLIST("ROR VA IRM",3)
  1. ;--- Sort the users by their names
  1. S IEN=0
  1. F S IEN=$O(@RORULST@(IEN)) Q:IEN'>0 D
  1. . S NAME=$$GET1^DIQ(200,IEN_",",.01,,,"RORMSG")
  1. . S:NAME'="" @RORULST@("B",NAME,IEN)=""
  1. ;--- Generate the output
  1. S NAME="",CNT=0
  1. F S NAME=$O(@RORULST@("B",NAME)) Q:NAME="" D
  1. . S IEN=0
  1. . F S IEN=$O(@RORULST@("B",NAME,IEN)) Q:IEN'>0 D
  1. . . S ACCESS=$G(@RORULST@(IEN,0))
  1. . . S CNT=CNT+1,@RESULTS@(CNT)=IEN_"^"_NAME_"^"_ACCESS
  1. S @RESULTS@(0)=CNT
  1. ;--- Cleanup
  1. D FREE^RORTMP(RORULST)
  1. Q