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

RORRP024.m

Go to the documentation of this file.
  1. RORRP024 ;HCIOFO/SG - RPC: VISTA USERS ; 12/15/05 4:31pm
  1. ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #10060 Read access (FileMan) to the NEW PERSON file
  1. ;
  1. Q
  1. ;
  1. ;***** RETURNS THE DEFAULT DIVISION FOR THE USER
  1. ;
  1. ; USER User IEN in file #200 (DUZ)
  1. ;
  1. ; Return Values:
  1. ; ... Default Division
  1. ; ^01: IEN (in the INSTITUTION file)
  1. ; ^02: Name
  1. ;
  1. DFLTDIV(USER) ;
  1. N DIV,IENS,IR,RORBUF,RORMSG,TMP
  1. S IENS=","_(+USER)_",",TMP="@;.01I;.01E;1I"
  1. D LIST^DIC(200.02,IENS,TMP,"PQ",,,,"#",,,"RORBUF","RORMSG")
  1. D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,200,IENS)
  1. S DIV=""
  1. ;--- Look for default division
  1. D:$G(RORBUF("DILIST",0))>0
  1. . S IR=0
  1. . F S IR=$O(RORBUF("DILIST",IR)) Q:IR'>0 D Q:DIV'=""
  1. . . S TMP=$G(RORBUF("DILIST",IR,0))
  1. . . S:$P(TMP,U,4) DIV=$P(TMP,U,2,3)
  1. . ;--- If name of the default division is not available
  1. . ; and the only division is associated with the user
  1. . ;--- then use this division as the default one.
  1. . I $P(DIV,U,2)="" D:RORBUF("DILIST",0)<2
  1. . . S DIV=$P($G(RORBUF("DILIST",1,0)),U,2,3)
  1. ;--- If default division is not available, use the site
  1. Q $S($P(DIV,U,2)'="":DIV,1:$P($$SITE^VASITE(),U,1,2))
  1. ;
  1. ;***** RETURNS INFORMATION ABOUT THE USER
  1. ; RPC: [ROR GET USER IFNO]
  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)
  1. ; indicates an error (see the RPCSTK^RORERR procedure for more
  1. ; details).
  1. ;
  1. ; Otherwise, the user info is returned in the RESULTS(0).
  1. ;
  1. ; RESULTS(0) User Info
  1. ; ^01: IEN
  1. ; ^02: Name
  1. ; ^03: Office Phone
  1. ; ^04: Nickname
  1. ; ^05: Read Timeout
  1. ; ^06: Default Division IEN
  1. ; ^07: Default Division Name
  1. ; ^08: Institution IEN
  1. ; ^09: Institution Name
  1. ; ^10: Station Number (with suffix)
  1. ;
  1. USERINFO(RESULTS,USER) ;
  1. N IENS,RORBUF,RORERRDL,RORMSG,TMP
  1. D CLEAR^RORERR("USERINFO^RORRP024",1)
  1. K RESULTS S RESULTS(0)=0
  1. I $G(USER)'>0 S USER=+$G(DUZ) Q:USER'>0
  1. ;--- Load the data
  1. S IENS=USER_","
  1. D GETS^DIQ(200,IENS,".01;.132;13",,"RORBUF","RORMSG")
  1. I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
  1. . S RC=$$DBS^RORERR("RORMSG",-9,,,200) K ^TMP("DILIST",$J)
  1. ;--- Compile the result
  1. S RESULTS(0)=USER
  1. S $P(RESULTS(0),U,2)=$G(RORBUF(200,IENS,.01)) ; Name
  1. S $P(RESULTS(0),U,3)=$G(RORBUF(200,IENS,.132)) ; Office Phone
  1. S $P(RESULTS(0),U,4)=$G(RORBUF(200,IENS,13)) ; Nick Name
  1. S $P(RESULTS(0),U,5)=$$DTIME^XUP(USER) ; Read Timeout
  1. S TMP=$$DFLTDIV(USER)
  1. S $P(RESULTS(0),U,6,7)=$P(TMP,U,1,2) ; Default Division
  1. S $P(RESULTS(0),U,8,10)=$$SITE^VASITE()
  1. Q
  1. ;
  1. ;***** RETURNS THE LIST OF VISTA USERS
  1. ; RPC: [ROR LIST VISTA USERS]
  1. ;
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; PART The search pattern (partial match restriction)
  1. ;
  1. ; [FLAGS] Flags that control the execution (can be combined):
  1. ; B Backwards. Traverses the index in the opposite
  1. ; direction of normal traversal.
  1. ; D Get default division for each user
  1. ; P Select providers only (check for the PROVIDER
  1. ; security key)
  1. ;
  1. ; [NUMBER] Maximum number of entries to return. A value of "*"
  1. ; or no value in this parameter designates all entries.
  1. ;
  1. ; [FROM] The index entry(s) from which to begin the list.
  1. ; You should use the pieces of the @RESULTS@(0) node
  1. ; (starting from the second one) to continue the
  1. ; listing in the subsequent procedure calls.
  1. ;
  1. ; NOTE: The FROM value itself is not included in
  1. ; the resulting list.
  1. ;
  1. ; The ^TMP("DILIST",$J) global node is used by the procedure.
  1. ;
  1. ; See description of the LIST^DIC for more details about the
  1. ; PART, NUMBER and FROM parameters.
  1. ;
  1. ; Return Values:
  1. ;
  1. ; A negative value of the first "^"-piece of the RESULTS(0)
  1. ; indicates an error (see the RPCSTK^RORERR procedure for more
  1. ; details).
  1. ;
  1. ; Otherwise, number of VistA users and the value of the FROM
  1. ; parameter for the next procedure call are returned in the
  1. ; @RESULTS@(0) and the subsequent nodes of the global array
  1. ; contain the users.
  1. ;
  1. ; @RESULTS@(0) Result Descriptor
  1. ; ^01: Number of users
  1. ; ^02: Values that comprise the FROM
  1. ; ^nn: parameter for the subsequent call
  1. ;
  1. ; @RESULTS@(i) User
  1. ; ^01: IEN
  1. ; ^02: Name
  1. ; ^03: Office Phone
  1. ; ^04: Nickname
  1. ; ^05: reserved
  1. ; ^06: Default Division IEN (only if D flag)
  1. ; ^07: Default Division Name (only if D flag)
  1. ;
  1. USERLIST(RESULTS,PART,FLAGS,NUMBER,FROM) ;
  1. N BUF,FIELDS,I,RC,RORERRDL,SCR,TMP
  1. D CLEAR^RORERR("USERLIST^RORRP024",1)
  1. K RESULTS S RESULTS=$NA(^TMP("DILIST",$J)) K @RESULTS
  1. ;--- Check the parameters
  1. S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
  1. . ;--- Flags
  1. . S FLAGS=$$UP^XLFSTR($G(FLAGS))
  1. . ;--- Others
  1. . S PART=$G(PART),FROM=$G(FROM)
  1. . S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
  1. ;--- Setup the start point
  1. F I=1:1 S TMP=$P(FROM,U,I) Q:TMP="" S FROM(I)=TMP
  1. S FROM=$G(FROM(1))
  1. ;--- Compile the screen logic (be careful with naked references)
  1. S SCR=""
  1. S:FLAGS["P" SCR=SCR_"I $D(^XUSEC(""PROVIDER"",Y))"
  1. ;--- Query the file
  1. S FIELDS="@;.01;.132;13",TMP="P"_$S(FLAGS["B":"B",1:"")
  1. D LIST^DIC(200,,FIELDS,TMP,NUMBER,.FROM,PART,"B",SCR,,,"RORMSG")
  1. I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
  1. . S RC=$$DBS^RORERR("RORMSG",-9,,,200) K ^TMP("DILIST",$J)
  1. ;--- Add default divisions
  1. I FLAGS["D" S I=0 D
  1. . F S I=$O(@RESULTS@(I)) Q:I'>0 D
  1. . . S $P(@RESULTS@(I,0),U,6,7)=$P($$DFLTDIV(+@RESULTS@(I,0)),U,1,2)
  1. ;--- Success
  1. S TMP=$G(^TMP("DILIST",$J,0)),BUF=+$P(TMP,U)
  1. K ^TMP("DILIST",$J,0)
  1. I $P(TMP,U,3) S I=0 D
  1. . F S I=$O(FROM(I)) Q:I'>0 S TMP=FROM(I) S:TMP'="" BUF=BUF_U_TMP
  1. S @RESULTS@(0)=BUF
  1. Q