RORRP013 ;HCIOFO/SG - RPC: ACCESS & SECURITY ; 11/9/05 8:56am
;;1.5;CLINICAL CASE REGISTRIES;**18**;Feb 17, 2006;Build 25
;; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*18 APR 2012 C RAY Dynamically rebuilds ACL index
; Returns value of AUTO-CONFIRM
;
;***********************************************************************
; This routine uses the following IAs:
;
; #10103 $$FMADD^XLFDT (supported)
; #10076 Direct read of XUSEC global
; BLD^DIALOG
; $$ROOT^DILFD
; $$GET1^DIQ
; GETS^DIQ
;
Q
;
;***** RETURNS A LIST OF REGISTRIES ACCESSIBLE TO THE GUI USER
; RPC: [ROR GUI ACCESS]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; [USER] User IEN in the NEW PERSON file. By default
; (if $G(USER)'>0), the DUZ is used).
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0) indicates
; an error (see the RPCSTK^RORERR procedure for more details).
;
; RESULTS(0) Number of accessible registries
;
; RESULTS(i) Registry descriptor
; ^01: Registry IEN
; ^02: Registry name
; ^03: Administrator? (0 or 1)
; ^04: Short description
; ^05: Auto Confirm (0 or 1)
;
ACREGLST(RESULTS,USER) ;
N ADMIN,CNT,IENS,KEY,RC,REGIEN,RORBUF,RORERRDL,RORMSG,TMP
N REGNAME,DA
K RESULTS S RESULTS(0)=0
D CLEAR^RORERR("ACREGLST^RORRP013",1)
;--- Check the version of the GUI
I $G(XWBAPVER)<1.5 D D RPCSTK^RORERR(.RESULTS,RC) Q
. N DIERR,DIHELP,DIMSG
. S TMP("CV")=$S($G(XWBAPVER)>0:XWBAPVER,1:"1.0")
. S TMP("RV")="1.5"
. D BLD^DIALOG(7980000.006,.TMP,,"RORBUF")
. S RC=$$ERROR^RORERR(-107,,.RORBUF)
. K RORBUF,TMP
;--- User must be defined
I $G(USER)'>0 S USER=+$G(DUZ) Q:USER'>0
;
;-- Rebuild user ACL index of registry keys
S REGIEN=0
K ^ROR(798.1,"ACL",DUZ)
F S REGIEN=$O(^ROR(798.1,REGIEN)) Q:REGIEN="" D
. S KEY="",REGNAME=$$REGNAME^RORUTL01(REGIEN) Q:REGNAME=""!'+($P($G(^ROR(798.1,REGIEN,21)),U,4))
. F S KEY=$O(^ROR(798.1,REGIEN,18,"B",KEY)) Q:KEY="" D:$D(^XUSEC(KEY,DUZ))
. . S DA=$O(^ROR(798.1,REGIEN,18,"B",KEY,""))
. . S ^ROR(798.1,"ACL",DUZ,REGIEN,KEY,DA)=""
. . S ^ROR(798.1,"ACL",DUZ,$P(REGNAME,U),KEY,DA)=""
;--- end of re-build
;--- Returns registry descriptors
S (CNT,RC,REGIEN)=0
F S REGIEN=$O(^ROR(798.1,"ACL",USER,REGIEN)) Q:REGIEN="" D Q:RC<0
. Q:REGIEN'>0 S IENS=REGIEN_"," K RORBUF
. D GETS^DIQ(798.1,IENS,".01;4;31",,"RORBUF","RORMSG")
. I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,IENS) Q
. ;--- Add the registry descriptor to the list
. S CNT=CNT+1,RESULTS(CNT)=REGIEN_"^"_$G(RORBUF(798.1,IENS,.01))
. S TMP=$G(RORBUF(798.1,IENS,31))
. S $P(RESULTS(CNT),"^",5)=$S(TMP="YES":1,1:0) ;Auto confirm?
. S $P(RESULTS(CNT),"^",4)=$G(RORBUF(798.1,IENS,4))
. ;--- Check if the user has the administrator security key
. S KEY="",ADMIN=0
. F S KEY=$O(^ROR(798.1,"ACL",USER,REGIEN,KEY)) Q:KEY="" D Q:RC<0
. . I KEY?1"ROR"1.E S:KEY["ADMIN" ADMIN=1
. S $P(RESULTS(CNT),"^",3)=ADMIN
;
I RC'<0 D:CNT'>0 S RESULTS(0)=CNT
. D ACVIOLTN^RORLOG(-91) ; Record the access violation
E D RPCSTK^RORERR(.RESULTS,RC)
Q
;
;***** RETURNS THE LIST OF ACCESS VIOLATIONS
; RPC: [ROR LOG GET ACCESS VIOLATIONS]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; [STDT] Start date (by default, from the earliest violation)
; [ENDT] End date (by default, to the latest violation)
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0) indicates
; an error (see the RPCSTK^RORERR procedure for more details).
;
; Otherwise, number of logs is returned in the RESULTS(0) and the
; subsequent nodes of the RESULTS array contain the violations.
;
; @RESULTS@(0) Number of access violations
;
; @RESULTS@(i) Access violation descriptor
; ^01: Date/Time (int)
; ^02: User Name
; ^03: User IEN
; ^04: Message
;
AVLIST(RESULTS,STDT,ENDT) ;
N BUF,CNT,DATE,IEN,IENS,RC,ROOT,RORBUF,RORERRDL,RORMSG
D CLEAR^RORERR("AVLIST^RORRP013",1)
;--- Check the parameters
S STDT=$G(STDT)\1,ENDT=$G(ENDT)\1
S ENDT=$S(ENDT>0:$$FMADD^XLFDT(ENDT,1),1:9999999)
;--- Initialize the variables
S ROOT=$$ROOT^DILFD(798.7,,1),CNT=0
K RESULTS S RESULTS=$$ALLOC^RORTMP()
;--- Browse through the logs
S DATE=STDT
F S DATE=$O(@ROOT@("B",DATE)) Q:DATE="" Q:DATE'<ENDT D
. S IEN=0
. F S IEN=$O(@ROOT@("B",DATE,IEN)) Q:IEN'>0 D
. . S IENS=IEN_"," K RORBUF
. . D GETS^DIQ(798.7,IENS,".01;1;7","EI","RORBUF","RORMSG")
. . Q:$G(DIERR)
. . ;--- Check for the 'Access Violation' Activity
. . Q:$G(RORBUF(798.7,IENS,1,"I"))'=6
. . ;--- Date/Time of the event
. . S BUF=$G(RORBUF(798.7,IENS,.01,"I"))
. . ;--- User Name (ext)
. . S $P(BUF,"^",2)=$G(RORBUF(798.7,IENS,7,"E"))
. . ;--- User IEN (int)
. . S $P(BUF,"^",3)=$G(RORBUF(798.7,IENS,7,"I"))
. . ;--- Message
. . S $P(BUF,"^",4)=$$GET1^DIQ(798.74,"1,"_IENS,2,,,"RORMSG")
. . ;--- Add the record to the output
. . S CNT=CNT+1,@RESULTS@(CNT)=BUF
;--- Number of violations
S @RESULTS@(0)=CNT
Q
;
;***** ADDS THE USERS WHO HAVE THE SECURITY KEY TO THE LIST
;
; KEYNAME Name of the security key
; ACCESS Level of the user access to the registry
; (1-User, 2-Administrator, 3-IRM)
;
; Return Values:
;
KLIST(KEYNAME,ACCESS) ;
N IEN S IEN=0
F S IEN=$O(^XUSEC(KEYNAME,IEN)) Q:IEN'>0 D
. S $P(@RORULST@(IEN,0),"^",ACCESS)=1
Q
;
;***** RETURNS THE LIST OF REGISTRY USERS
; RPC: [ROR GET REGISTRY USERS]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0) indicates
; an error (see the RPCSTK^RORERR procedure for more details).
;
; Otherwise, number of users is returned in the RESULTS(0) and the
; subsequent nodes of the RESULTS array contain the users.
;
; @RESULTS@(0) Number of users
;
; @RESULTS@(i) User descriptor
; ^01: User IEN (DUZ)
; ^02: User Name
; ^03: User (0/1)
; ^04: Administrator (0/1)
; ^05: IRM (0/1)
;
USERLIST(RESULTS,REGIEN) ;
N ACCESS,ADMIN,CNT,IEN,NAME,RORERRDL,RORMSG,RORULST
D CLEAR^RORERR("USERLIST^RORRP013",1)
;--- Check the parameters
I $G(REGIEN)'>0 D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
S REGIEN=+REGIEN
;--- Initialize the variables
K RESULTS S RESULTS=$$ALLOC^RORTMP()
S RORULST=$$ALLOC^RORTMP()
;--- Browse the security keys
S NAME=""
F S NAME=$O(^ROR(798.1,REGIEN,18,"B",NAME)) Q:NAME="" D
. S ADMIN=(NAME?1"ROR"1.E)&(NAME["ADMIN")
. D KLIST(NAME,$S(ADMIN:2,1:1))
;--- Add the authorized IRM personnel
D KLIST("ROR VA IRM",3)
;--- Sort the users by their names
S IEN=0
F S IEN=$O(@RORULST@(IEN)) Q:IEN'>0 D
. S NAME=$$GET1^DIQ(200,IEN_",",.01,,,"RORMSG")
. S:NAME'="" @RORULST@("B",NAME,IEN)=""
;--- Generate the output
S NAME="",CNT=0
F S NAME=$O(@RORULST@("B",NAME)) Q:NAME="" D
. S IEN=0
. F S IEN=$O(@RORULST@("B",NAME,IEN)) Q:IEN'>0 D
. . S ACCESS=$G(@RORULST@(IEN,0))
. . S CNT=CNT+1,@RESULTS@(CNT)=IEN_"^"_NAME_"^"_ACCESS
S @RESULTS@(0)=CNT
;--- Cleanup
D FREE^RORTMP(RORULST)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP013 8110 printed Dec 13, 2024@01:42:56 Page 2
RORRP013 ;HCIOFO/SG - RPC: ACCESS & SECURITY ; 11/9/05 8:56am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**18**;Feb 17, 2006;Build 25
+2 ;; --- ROUTINE MODIFICATION LOG ---
+3 ;
+4 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+5 ;----------- ---------- ----------- ----------------------------------------
+6 ;ROR*1.5*18 APR 2012 C RAY Dynamically rebuilds ACL index
+7 ; Returns value of AUTO-CONFIRM
+8 ;
+9 ;***********************************************************************
+10 ; This routine uses the following IAs:
+11 ;
+12 ; #10103 $$FMADD^XLFDT (supported)
+13 ; #10076 Direct read of XUSEC global
+14 ; BLD^DIALOG
+15 ; $$ROOT^DILFD
+16 ; $$GET1^DIQ
+17 ; GETS^DIQ
+18 ;
+19 QUIT
+20 ;
+21 ;***** RETURNS A LIST OF REGISTRIES ACCESSIBLE TO THE GUI USER
+22 ; RPC: [ROR GUI ACCESS]
+23 ;
+24 ; .RESULTS Reference to a local variable where the results
+25 ; are returned to.
+26 ;
+27 ; [USER] User IEN in the NEW PERSON file. By default
+28 ; (if $G(USER)'>0), the DUZ is used).
+29 ;
+30 ; Return Values:
+31 ;
+32 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
+33 ; an error (see the RPCSTK^RORERR procedure for more details).
+34 ;
+35 ; RESULTS(0) Number of accessible registries
+36 ;
+37 ; RESULTS(i) Registry descriptor
+38 ; ^01: Registry IEN
+39 ; ^02: Registry name
+40 ; ^03: Administrator? (0 or 1)
+41 ; ^04: Short description
+42 ; ^05: Auto Confirm (0 or 1)
+43 ;
ACREGLST(RESULTS,USER) ;
+1 NEW ADMIN,CNT,IENS,KEY,RC,REGIEN,RORBUF,RORERRDL,RORMSG,TMP
+2 NEW REGNAME,DA
+3 KILL RESULTS
SET RESULTS(0)=0
+4 DO CLEAR^RORERR("ACREGLST^RORRP013",1)
+5 ;--- Check the version of the GUI
+6 IF $GET(XWBAPVER)<1.5
Begin DoDot:1
+7 NEW DIERR,DIHELP,DIMSG
+8 SET TMP("CV")=$SELECT($GET(XWBAPVER)>0:XWBAPVER,1:"1.0")
+9 SET TMP("RV")="1.5"
+10 DO BLD^DIALOG(7980000.006,.TMP,,"RORBUF")
+11 SET RC=$$ERROR^RORERR(-107,,.RORBUF)
+12 KILL RORBUF,TMP
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+13 ;--- User must be defined
+14 IF $GET(USER)'>0
SET USER=+$GET(DUZ)
if USER'>0
QUIT
+15 ;
+16 ;-- Rebuild user ACL index of registry keys
+17 SET REGIEN=0
+18 KILL ^ROR(798.1,"ACL",DUZ)
+19 FOR
SET REGIEN=$ORDER(^ROR(798.1,REGIEN))
if REGIEN=""
QUIT
Begin DoDot:1
+20 SET KEY=""
SET REGNAME=$$REGNAME^RORUTL01(REGIEN)
if REGNAME=""!'+($PIECE($GET(^ROR(798.1,REGIEN,21)),U,4))
QUIT
+21 FOR
SET KEY=$ORDER(^ROR(798.1,REGIEN,18,"B",KEY))
if KEY=""
QUIT
if $DATA(^XUSEC(KEY,DUZ))
Begin DoDot:2
+22 SET DA=$ORDER(^ROR(798.1,REGIEN,18,"B",KEY,""))
+23 SET ^ROR(798.1,"ACL",DUZ,REGIEN,KEY,DA)=""
+24 SET ^ROR(798.1,"ACL",DUZ,$PIECE(REGNAME,U),KEY,DA)=""
End DoDot:2
End DoDot:1
+25 ;--- end of re-build
+26 ;--- Returns registry descriptors
+27 SET (CNT,RC,REGIEN)=0
+28 FOR
SET REGIEN=$ORDER(^ROR(798.1,"ACL",USER,REGIEN))
if REGIEN=""
QUIT
Begin DoDot:1
+29 if REGIEN'>0
QUIT
SET IENS=REGIEN_","
KILL RORBUF
+30 DO GETS^DIQ(798.1,IENS,".01;4;31",,"RORBUF","RORMSG")
+31 IF $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
QUIT
+32 ;--- Add the registry descriptor to the list
+33 SET CNT=CNT+1
SET RESULTS(CNT)=REGIEN_"^"_$GET(RORBUF(798.1,IENS,.01))
+34 SET TMP=$GET(RORBUF(798.1,IENS,31))
+35 ;Auto confirm?
SET $PIECE(RESULTS(CNT),"^",5)=$SELECT(TMP="YES":1,1:0)
+36 SET $PIECE(RESULTS(CNT),"^",4)=$GET(RORBUF(798.1,IENS,4))
+37 ;--- Check if the user has the administrator security key
+38 SET KEY=""
SET ADMIN=0
+39 FOR
SET KEY=$ORDER(^ROR(798.1,"ACL",USER,REGIEN,KEY))
if KEY=""
QUIT
Begin DoDot:2
+40 IF KEY?1"ROR"1.E
if KEY["ADMIN"
SET ADMIN=1
End DoDot:2
if RC<0
QUIT
+41 SET $PIECE(RESULTS(CNT),"^",3)=ADMIN
End DoDot:1
if RC<0
QUIT
+42 ;
+43 IF RC'<0
if CNT'>0
Begin DoDot:1
+44 ; Record the access violation
DO ACVIOLTN^RORLOG(-91)
End DoDot:1
SET RESULTS(0)=CNT
+45 IF '$TEST
DO RPCSTK^RORERR(.RESULTS,RC)
+46 QUIT
+47 ;
+48 ;***** RETURNS THE LIST OF ACCESS VIOLATIONS
+49 ; RPC: [ROR LOG GET ACCESS VIOLATIONS]
+50 ;
+51 ; .RESULTS Reference to a local variable where the results
+52 ; are returned to.
+53 ;
+54 ; [STDT] Start date (by default, from the earliest violation)
+55 ; [ENDT] End date (by default, to the latest violation)
+56 ;
+57 ; Return Values:
+58 ;
+59 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
+60 ; an error (see the RPCSTK^RORERR procedure for more details).
+61 ;
+62 ; Otherwise, number of logs is returned in the RESULTS(0) and the
+63 ; subsequent nodes of the RESULTS array contain the violations.
+64 ;
+65 ; @RESULTS@(0) Number of access violations
+66 ;
+67 ; @RESULTS@(i) Access violation descriptor
+68 ; ^01: Date/Time (int)
+69 ; ^02: User Name
+70 ; ^03: User IEN
+71 ; ^04: Message
+72 ;
AVLIST(RESULTS,STDT,ENDT) ;
+1 NEW BUF,CNT,DATE,IEN,IENS,RC,ROOT,RORBUF,RORERRDL,RORMSG
+2 DO CLEAR^RORERR("AVLIST^RORRP013",1)
+3 ;--- Check the parameters
+4 SET STDT=$GET(STDT)\1
SET ENDT=$GET(ENDT)\1
+5 SET ENDT=$SELECT(ENDT>0:$$FMADD^XLFDT(ENDT,1),1:9999999)
+6 ;--- Initialize the variables
+7 SET ROOT=$$ROOT^DILFD(798.7,,1)
SET CNT=0
+8 KILL RESULTS
SET RESULTS=$$ALLOC^RORTMP()
+9 ;--- Browse through the logs
+10 SET DATE=STDT
+11 FOR
SET DATE=$ORDER(@ROOT@("B",DATE))
if DATE=""
QUIT
if DATE'<ENDT
QUIT
Begin DoDot:1
+12 SET IEN=0
+13 FOR
SET IEN=$ORDER(@ROOT@("B",DATE,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+14 SET IENS=IEN_","
KILL RORBUF
+15 DO GETS^DIQ(798.7,IENS,".01;1;7","EI","RORBUF","RORMSG")
+16 if $GET(DIERR)
QUIT
+17 ;--- Check for the 'Access Violation' Activity
+18 if $GET(RORBUF(798.7,IENS,1,"I"))'=6
QUIT
+19 ;--- Date/Time of the event
+20 SET BUF=$GET(RORBUF(798.7,IENS,.01,"I"))
+21 ;--- User Name (ext)
+22 SET $PIECE(BUF,"^",2)=$GET(RORBUF(798.7,IENS,7,"E"))
+23 ;--- User IEN (int)
+24 SET $PIECE(BUF,"^",3)=$GET(RORBUF(798.7,IENS,7,"I"))
+25 ;--- Message
+26 SET $PIECE(BUF,"^",4)=$$GET1^DIQ(798.74,"1,"_IENS,2,,,"RORMSG")
+27 ;--- Add the record to the output
+28 SET CNT=CNT+1
SET @RESULTS@(CNT)=BUF
End DoDot:2
End DoDot:1
+29 ;--- Number of violations
+30 SET @RESULTS@(0)=CNT
+31 QUIT
+32 ;
+33 ;***** ADDS THE USERS WHO HAVE THE SECURITY KEY TO THE LIST
+34 ;
+35 ; KEYNAME Name of the security key
+36 ; ACCESS Level of the user access to the registry
+37 ; (1-User, 2-Administrator, 3-IRM)
+38 ;
+39 ; Return Values:
+40 ;
KLIST(KEYNAME,ACCESS) ;
+1 NEW IEN
SET IEN=0
+2 FOR
SET IEN=$ORDER(^XUSEC(KEYNAME,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 SET $PIECE(@RORULST@(IEN,0),"^",ACCESS)=1
End DoDot:1
+4 QUIT
+5 ;
+6 ;***** RETURNS THE LIST OF REGISTRY USERS
+7 ; RPC: [ROR GET REGISTRY USERS]
+8 ;
+9 ; .RESULTS Reference to a local variable where the results
+10 ; are returned to.
+11 ;
+12 ; REGIEN Registry IEN
+13 ;
+14 ; Return Values:
+15 ;
+16 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
+17 ; an error (see the RPCSTK^RORERR procedure for more details).
+18 ;
+19 ; Otherwise, number of users is returned in the RESULTS(0) and the
+20 ; subsequent nodes of the RESULTS array contain the users.
+21 ;
+22 ; @RESULTS@(0) Number of users
+23 ;
+24 ; @RESULTS@(i) User descriptor
+25 ; ^01: User IEN (DUZ)
+26 ; ^02: User Name
+27 ; ^03: User (0/1)
+28 ; ^04: Administrator (0/1)
+29 ; ^05: IRM (0/1)
+30 ;
USERLIST(RESULTS,REGIEN) ;
+1 NEW ACCESS,ADMIN,CNT,IEN,NAME,RORERRDL,RORMSG,RORULST
+2 DO CLEAR^RORERR("USERLIST^RORRP013",1)
+3 ;--- Check the parameters
+4 IF $GET(REGIEN)'>0
Begin DoDot:1
+5 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+6 SET REGIEN=+REGIEN
+7 ;--- Initialize the variables
+8 KILL RESULTS
SET RESULTS=$$ALLOC^RORTMP()
+9 SET RORULST=$$ALLOC^RORTMP()
+10 ;--- Browse the security keys
+11 SET NAME=""
+12 FOR
SET NAME=$ORDER(^ROR(798.1,REGIEN,18,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+13 SET ADMIN=(NAME?1"ROR"1.E)&(NAME["ADMIN")
+14 DO KLIST(NAME,$SELECT(ADMIN:2,1:1))
End DoDot:1
+15 ;--- Add the authorized IRM personnel
+16 DO KLIST("ROR VA IRM",3)
+17 ;--- Sort the users by their names
+18 SET IEN=0
+19 FOR
SET IEN=$ORDER(@RORULST@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+20 SET NAME=$$GET1^DIQ(200,IEN_",",.01,,,"RORMSG")
+21 if NAME'=""
SET @RORULST@("B",NAME,IEN)=""
End DoDot:1
+22 ;--- Generate the output
+23 SET NAME=""
SET CNT=0
+24 FOR
SET NAME=$ORDER(@RORULST@("B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+25 SET IEN=0
+26 FOR
SET IEN=$ORDER(@RORULST@("B",NAME,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+27 SET ACCESS=$GET(@RORULST@(IEN,0))
+28 SET CNT=CNT+1
SET @RESULTS@(CNT)=IEN_"^"_NAME_"^"_ACCESS
End DoDot:2
End DoDot:1
+29 SET @RESULTS@(0)=CNT
+30 ;--- Cleanup
+31 DO FREE^RORTMP(RORULST)
+32 QUIT
