- 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 Jan 18, 2025@02:44:10 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