- RORRP024 ;HCIOFO/SG - RPC: VISTA USERS ; 12/15/05 4:31pm
- ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
- ;
- ; This routine uses the following IAs:
- ;
- ; #10060 Read access (FileMan) to the NEW PERSON file
- ;
- Q
- ;
- ;***** RETURNS THE DEFAULT DIVISION FOR THE USER
- ;
- ; USER User IEN in file #200 (DUZ)
- ;
- ; Return Values:
- ; ... Default Division
- ; ^01: IEN (in the INSTITUTION file)
- ; ^02: Name
- ;
- DFLTDIV(USER) ;
- N DIV,IENS,IR,RORBUF,RORMSG,TMP
- S IENS=","_(+USER)_",",TMP="@;.01I;.01E;1I"
- D LIST^DIC(200.02,IENS,TMP,"PQ",,,,"#",,,"RORBUF","RORMSG")
- D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,200,IENS)
- S DIV=""
- ;--- Look for default division
- D:$G(RORBUF("DILIST",0))>0
- . S IR=0
- . F S IR=$O(RORBUF("DILIST",IR)) Q:IR'>0 D Q:DIV'=""
- . . S TMP=$G(RORBUF("DILIST",IR,0))
- . . S:$P(TMP,U,4) DIV=$P(TMP,U,2,3)
- . ;--- If name of the default division is not available
- . ; and the only division is associated with the user
- . ;--- then use this division as the default one.
- . I $P(DIV,U,2)="" D:RORBUF("DILIST",0)<2
- . . S DIV=$P($G(RORBUF("DILIST",1,0)),U,2,3)
- ;--- If default division is not available, use the site
- Q $S($P(DIV,U,2)'="":DIV,1:$P($$SITE^VASITE(),U,1,2))
- ;
- ;***** RETURNS INFORMATION ABOUT THE USER
- ; RPC: [ROR GET USER IFNO]
- ;
- ; .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).
- ;
- ; Otherwise, the user info is returned in the RESULTS(0).
- ;
- ; RESULTS(0) User Info
- ; ^01: IEN
- ; ^02: Name
- ; ^03: Office Phone
- ; ^04: Nickname
- ; ^05: Read Timeout
- ; ^06: Default Division IEN
- ; ^07: Default Division Name
- ; ^08: Institution IEN
- ; ^09: Institution Name
- ; ^10: Station Number (with suffix)
- ;
- USERINFO(RESULTS,USER) ;
- N IENS,RORBUF,RORERRDL,RORMSG,TMP
- D CLEAR^RORERR("USERINFO^RORRP024",1)
- K RESULTS S RESULTS(0)=0
- I $G(USER)'>0 S USER=+$G(DUZ) Q:USER'>0
- ;--- Load the data
- S IENS=USER_","
- D GETS^DIQ(200,IENS,".01;.132;13",,"RORBUF","RORMSG")
- I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
- . S RC=$$DBS^RORERR("RORMSG",-9,,,200) K ^TMP("DILIST",$J)
- ;--- Compile the result
- S RESULTS(0)=USER
- S $P(RESULTS(0),U,2)=$G(RORBUF(200,IENS,.01)) ; Name
- S $P(RESULTS(0),U,3)=$G(RORBUF(200,IENS,.132)) ; Office Phone
- S $P(RESULTS(0),U,4)=$G(RORBUF(200,IENS,13)) ; Nick Name
- S $P(RESULTS(0),U,5)=$$DTIME^XUP(USER) ; Read Timeout
- S TMP=$$DFLTDIV(USER)
- S $P(RESULTS(0),U,6,7)=$P(TMP,U,1,2) ; Default Division
- S $P(RESULTS(0),U,8,10)=$$SITE^VASITE()
- Q
- ;
- ;***** RETURNS THE LIST OF VISTA USERS
- ; RPC: [ROR LIST VISTA USERS]
- ;
- ; .RESULTS Reference to a local variable where the results
- ; are returned to.
- ;
- ; PART The search pattern (partial match restriction)
- ;
- ; [FLAGS] Flags that control the execution (can be combined):
- ; B Backwards. Traverses the index in the opposite
- ; direction of normal traversal.
- ; D Get default division for each user
- ; P Select providers only (check for the PROVIDER
- ; security key)
- ;
- ; [NUMBER] Maximum number of entries to return. A value of "*"
- ; or no value in this parameter designates all entries.
- ;
- ; [FROM] The index entry(s) from which to begin the list.
- ; You should use the pieces of the @RESULTS@(0) node
- ; (starting from the second one) to continue the
- ; listing in the subsequent procedure calls.
- ;
- ; NOTE: The FROM value itself is not included in
- ; the resulting list.
- ;
- ; The ^TMP("DILIST",$J) global node is used by the procedure.
- ;
- ; See description of the LIST^DIC for more details about the
- ; PART, NUMBER and FROM parameters.
- ;
- ; 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 VistA users and the value of the FROM
- ; parameter for the next procedure call are returned in the
- ; @RESULTS@(0) and the subsequent nodes of the global array
- ; contain the users.
- ;
- ; @RESULTS@(0) Result Descriptor
- ; ^01: Number of users
- ; ^02: Values that comprise the FROM
- ; ^nn: parameter for the subsequent call
- ;
- ; @RESULTS@(i) User
- ; ^01: IEN
- ; ^02: Name
- ; ^03: Office Phone
- ; ^04: Nickname
- ; ^05: reserved
- ; ^06: Default Division IEN (only if D flag)
- ; ^07: Default Division Name (only if D flag)
- ;
- USERLIST(RESULTS,PART,FLAGS,NUMBER,FROM) ;
- N BUF,FIELDS,I,RC,RORERRDL,SCR,TMP
- D CLEAR^RORERR("USERLIST^RORRP024",1)
- K RESULTS S RESULTS=$NA(^TMP("DILIST",$J)) K @RESULTS
- ;--- Check the parameters
- S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
- . ;--- Flags
- . S FLAGS=$$UP^XLFSTR($G(FLAGS))
- . ;--- Others
- . S PART=$G(PART),FROM=$G(FROM)
- . S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
- ;--- Setup the start point
- F I=1:1 S TMP=$P(FROM,U,I) Q:TMP="" S FROM(I)=TMP
- S FROM=$G(FROM(1))
- ;--- Compile the screen logic (be careful with naked references)
- S SCR=""
- S:FLAGS["P" SCR=SCR_"I $D(^XUSEC(""PROVIDER"",Y))"
- ;--- Query the file
- S FIELDS="@;.01;.132;13",TMP="P"_$S(FLAGS["B":"B",1:"")
- D LIST^DIC(200,,FIELDS,TMP,NUMBER,.FROM,PART,"B",SCR,,,"RORMSG")
- I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
- . S RC=$$DBS^RORERR("RORMSG",-9,,,200) K ^TMP("DILIST",$J)
- ;--- Add default divisions
- I FLAGS["D" S I=0 D
- . F S I=$O(@RESULTS@(I)) Q:I'>0 D
- . . S $P(@RESULTS@(I,0),U,6,7)=$P($$DFLTDIV(+@RESULTS@(I,0)),U,1,2)
- ;--- Success
- S TMP=$G(^TMP("DILIST",$J,0)),BUF=+$P(TMP,U)
- K ^TMP("DILIST",$J,0)
- I $P(TMP,U,3) S I=0 D
- . F S I=$O(FROM(I)) Q:I'>0 S TMP=FROM(I) S:TMP'="" BUF=BUF_U_TMP
- S @RESULTS@(0)=BUF
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP024 6713 printed Jan 18, 2025@02:44:21 Page 2
- RORRP024 ;HCIOFO/SG - RPC: VISTA USERS ; 12/15/05 4:31pm
- +1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
- +2 ;
- +3 ; This routine uses the following IAs:
- +4 ;
- +5 ; #10060 Read access (FileMan) to the NEW PERSON file
- +6 ;
- +7 QUIT
- +8 ;
- +9 ;***** RETURNS THE DEFAULT DIVISION FOR THE USER
- +10 ;
- +11 ; USER User IEN in file #200 (DUZ)
- +12 ;
- +13 ; Return Values:
- +14 ; ... Default Division
- +15 ; ^01: IEN (in the INSTITUTION file)
- +16 ; ^02: Name
- +17 ;
- DFLTDIV(USER) ;
- +1 NEW DIV,IENS,IR,RORBUF,RORMSG,TMP
- +2 SET IENS=","_(+USER)_","
- SET TMP="@;.01I;.01E;1I"
- +3 DO LIST^DIC(200.02,IENS,TMP,"PQ",,,,"#",,,"RORBUF","RORMSG")
- +4 if $GET(DIERR)
- DO DBS^RORERR("RORMSG",-9,,,200,IENS)
- +5 SET DIV=""
- +6 ;--- Look for default division
- +7 if $GET(RORBUF("DILIST",0))>0
- Begin DoDot:1
- +8 SET IR=0
- +9 FOR
- SET IR=$ORDER(RORBUF("DILIST",IR))
- if IR'>0
- QUIT
- Begin DoDot:2
- +10 SET TMP=$GET(RORBUF("DILIST",IR,0))
- +11 if $PIECE(TMP,U,4)
- SET DIV=$PIECE(TMP,U,2,3)
- End DoDot:2
- if DIV'=""
- QUIT
- +12 ;--- If name of the default division is not available
- +13 ; and the only division is associated with the user
- +14 ;--- then use this division as the default one.
- +15 IF $PIECE(DIV,U,2)=""
- if RORBUF("DILIST",0)<2
- Begin DoDot:2
- +16 SET DIV=$PIECE($GET(RORBUF("DILIST",1,0)),U,2,3)
- End DoDot:2
- End DoDot:1
- +17 ;--- If default division is not available, use the site
- +18 QUIT $SELECT($PIECE(DIV,U,2)'="":DIV,1:$PIECE($$SITE^VASITE(),U,1,2))
- +19 ;
- +20 ;***** RETURNS INFORMATION ABOUT THE USER
- +21 ; RPC: [ROR GET USER IFNO]
- +22 ;
- +23 ; .RESULTS Reference to a local variable where the results
- +24 ; are returned to.
- +25 ;
- +26 ; [USER] User IEN in the NEW PERSON file. By default
- +27 ; (if $G(USER)'>0), the DUZ is used).
- +28 ;
- +29 ; Return Values:
- +30 ;
- +31 ; A negative value of the first "^"-piece of the RESULTS(0)
- +32 ; indicates an error (see the RPCSTK^RORERR procedure for more
- +33 ; details).
- +34 ;
- +35 ; Otherwise, the user info is returned in the RESULTS(0).
- +36 ;
- +37 ; RESULTS(0) User Info
- +38 ; ^01: IEN
- +39 ; ^02: Name
- +40 ; ^03: Office Phone
- +41 ; ^04: Nickname
- +42 ; ^05: Read Timeout
- +43 ; ^06: Default Division IEN
- +44 ; ^07: Default Division Name
- +45 ; ^08: Institution IEN
- +46 ; ^09: Institution Name
- +47 ; ^10: Station Number (with suffix)
- +48 ;
- USERINFO(RESULTS,USER) ;
- +1 NEW IENS,RORBUF,RORERRDL,RORMSG,TMP
- +2 DO CLEAR^RORERR("USERINFO^RORRP024",1)
- +3 KILL RESULTS
- SET RESULTS(0)=0
- +4 IF $GET(USER)'>0
- SET USER=+$GET(DUZ)
- if USER'>0
- QUIT
- +5 ;--- Load the data
- +6 SET IENS=USER_","
- +7 DO GETS^DIQ(200,IENS,".01;.132;13",,"RORBUF","RORMSG")
- +8 IF $GET(DIERR)
- Begin DoDot:1
- +9 SET RC=$$DBS^RORERR("RORMSG",-9,,,200)
- KILL ^TMP("DILIST",$JOB)
- End DoDot:1
- DO RPCSTK^RORERR(.RESULTS,RC)
- QUIT
- +10 ;--- Compile the result
- +11 SET RESULTS(0)=USER
- +12 ; Name
- SET $PIECE(RESULTS(0),U,2)=$GET(RORBUF(200,IENS,.01))
- +13 ; Office Phone
- SET $PIECE(RESULTS(0),U,3)=$GET(RORBUF(200,IENS,.132))
- +14 ; Nick Name
- SET $PIECE(RESULTS(0),U,4)=$GET(RORBUF(200,IENS,13))
- +15 ; Read Timeout
- SET $PIECE(RESULTS(0),U,5)=$$DTIME^XUP(USER)
- +16 SET TMP=$$DFLTDIV(USER)
- +17 ; Default Division
- SET $PIECE(RESULTS(0),U,6,7)=$PIECE(TMP,U,1,2)
- +18 SET $PIECE(RESULTS(0),U,8,10)=$$SITE^VASITE()
- +19 QUIT
- +20 ;
- +21 ;***** RETURNS THE LIST OF VISTA USERS
- +22 ; RPC: [ROR LIST VISTA USERS]
- +23 ;
- +24 ; .RESULTS Reference to a local variable where the results
- +25 ; are returned to.
- +26 ;
- +27 ; PART The search pattern (partial match restriction)
- +28 ;
- +29 ; [FLAGS] Flags that control the execution (can be combined):
- +30 ; B Backwards. Traverses the index in the opposite
- +31 ; direction of normal traversal.
- +32 ; D Get default division for each user
- +33 ; P Select providers only (check for the PROVIDER
- +34 ; security key)
- +35 ;
- +36 ; [NUMBER] Maximum number of entries to return. A value of "*"
- +37 ; or no value in this parameter designates all entries.
- +38 ;
- +39 ; [FROM] The index entry(s) from which to begin the list.
- +40 ; You should use the pieces of the @RESULTS@(0) node
- +41 ; (starting from the second one) to continue the
- +42 ; listing in the subsequent procedure calls.
- +43 ;
- +44 ; NOTE: The FROM value itself is not included in
- +45 ; the resulting list.
- +46 ;
- +47 ; The ^TMP("DILIST",$J) global node is used by the procedure.
- +48 ;
- +49 ; See description of the LIST^DIC for more details about the
- +50 ; PART, NUMBER and FROM parameters.
- +51 ;
- +52 ; Return Values:
- +53 ;
- +54 ; A negative value of the first "^"-piece of the RESULTS(0)
- +55 ; indicates an error (see the RPCSTK^RORERR procedure for more
- +56 ; details).
- +57 ;
- +58 ; Otherwise, number of VistA users and the value of the FROM
- +59 ; parameter for the next procedure call are returned in the
- +60 ; @RESULTS@(0) and the subsequent nodes of the global array
- +61 ; contain the users.
- +62 ;
- +63 ; @RESULTS@(0) Result Descriptor
- +64 ; ^01: Number of users
- +65 ; ^02: Values that comprise the FROM
- +66 ; ^nn: parameter for the subsequent call
- +67 ;
- +68 ; @RESULTS@(i) User
- +69 ; ^01: IEN
- +70 ; ^02: Name
- +71 ; ^03: Office Phone
- +72 ; ^04: Nickname
- +73 ; ^05: reserved
- +74 ; ^06: Default Division IEN (only if D flag)
- +75 ; ^07: Default Division Name (only if D flag)
- +76 ;
- USERLIST(RESULTS,PART,FLAGS,NUMBER,FROM) ;
- +1 NEW BUF,FIELDS,I,RC,RORERRDL,SCR,TMP
- +2 DO CLEAR^RORERR("USERLIST^RORRP024",1)
- +3 KILL RESULTS
- SET RESULTS=$NAME(^TMP("DILIST",$JOB))
- KILL @RESULTS
- +4 ;--- Check the parameters
- +5 SET RC=0
- Begin DoDot:1
- +6 ;--- Flags
- +7 SET FLAGS=$$UP^XLFSTR($GET(FLAGS))
- +8 ;--- Others
- +9 SET PART=$GET(PART)
- SET FROM=$GET(FROM)
- +10 SET NUMBER=$SELECT($GET(NUMBER)>0:+NUMBER,1:"*")
- End DoDot:1
- IF RC<0
- DO RPCSTK^RORERR(.RESULTS,RC)
- QUIT
- +11 ;--- Setup the start point
- +12 FOR I=1:1
- SET TMP=$PIECE(FROM,U,I)
- if TMP=""
- QUIT
- SET FROM(I)=TMP
- +13 SET FROM=$GET(FROM(1))
- +14 ;--- Compile the screen logic (be careful with naked references)
- +15 SET SCR=""
- +16 if FLAGS["P"
- SET SCR=SCR_"I $D(^XUSEC(""PROVIDER"",Y))"
- +17 ;--- Query the file
- +18 SET FIELDS="@;.01;.132;13"
- SET TMP="P"_$SELECT(FLAGS["B":"B",1:"")
- +19 DO LIST^DIC(200,,FIELDS,TMP,NUMBER,.FROM,PART,"B",SCR,,,"RORMSG")
- +20 IF $GET(DIERR)
- Begin DoDot:1
- +21 SET RC=$$DBS^RORERR("RORMSG",-9,,,200)
- KILL ^TMP("DILIST",$JOB)
- End DoDot:1
- DO RPCSTK^RORERR(.RESULTS,RC)
- QUIT
- +22 ;--- Add default divisions
- +23 IF FLAGS["D"
- SET I=0
- Begin DoDot:1
- +24 FOR
- SET I=$ORDER(@RESULTS@(I))
- if I'>0
- QUIT
- Begin DoDot:2
- +25 SET $PIECE(@RESULTS@(I,0),U,6,7)=$PIECE($$DFLTDIV(+@RESULTS@(I,0)),U,1,2)
- End DoDot:2
- End DoDot:1
- +26 ;--- Success
- +27 SET TMP=$GET(^TMP("DILIST",$JOB,0))
- SET BUF=+$PIECE(TMP,U)
- +28 KILL ^TMP("DILIST",$JOB,0)
- +29 IF $PIECE(TMP,U,3)
- SET I=0
- Begin DoDot:1
- +30 FOR
- SET I=$ORDER(FROM(I))
- if I'>0
- QUIT
- SET TMP=FROM(I)
- if TMP'=""
- SET BUF=BUF_U_TMP
- End DoDot:1
- +31 SET @RESULTS@(0)=BUF
- +32 QUIT