RORRP029 ;HCIOFO/SG - RPC: ADDRESS UTILITIES ; 4/16/03 9:35am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; This routine uses the following IAs:
;
; #10056 Read access to the STATE file (#5)
;
Q
;
;***** RETURNS THE LIST OF STATES
; RPC: [ROR LIST STATES]
;
; .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):
; A Enable abbreviation search (if PART contains 2
; character abbreviation, the corresponding state
; is returned. Otherwise, the regular search is
; performed).
; B Backwards. Traverses the index in the opposite
; direction of normal traversal.
;
; [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 states 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 states.
;
; @RESULTS@(0) Result Descriptor
; ^01: Number of states
; ^02: Values that comprise the FROM
; ^nn: parameter for the subsequent call
;
; @RESULTS@(i) State
; ^01: IEN
; ^02: Name
; ^03: Abbreviation
; ^04: VA State Code
;
STATELST(RESULTS,PART,FLAGS,NUMBER,FROM) ;
N BUF,FIELDS,I,RC,RORERRDL,TMP
D CLEAR^RORERR("STATELST^RORRP029",1)
K RESULTS S RESULTS=$NA(^TMP("DILIST",$J)) K @RESULTS
S FIELDS="@;.01;1;2"
;--- 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))
;--- Check for the abbreviation
S RC=0
I FLAGS["A",$L(PART)=2 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
. D LIST^DIC(5,,FIELDS,"P",2,,PART,"C",,,,"RORMSG")
. I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,5) Q
. S:+$G(^TMP("DILIST",$J,0))=1 RC=1
;--- Query the file
I 'RC D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
. S TMP="P"_$S(FLAGS["B":"B",1:"")
. D LIST^DIC(5,,FIELDS,TMP,NUMBER,.FROM,PART,"B",,,,"RORMSG")
. I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,5) Q
;--- 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[HRORRP029 3645 printed Nov 22, 2024@16:53:23 Page 2
RORRP029 ;HCIOFO/SG - RPC: ADDRESS UTILITIES ; 4/16/03 9:35am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10056 Read access to the STATE file (#5)
+6 ;
+7 QUIT
+8 ;
+9 ;***** RETURNS THE LIST OF STATES
+10 ; RPC: [ROR LIST STATES]
+11 ;
+12 ; .RESULTS Reference to a local variable where the results
+13 ; are returned to.
+14 ;
+15 ; PART The search pattern (partial match restriction)
+16 ;
+17 ; [FLAGS] Flags that control the execution (can be combined):
+18 ; A Enable abbreviation search (if PART contains 2
+19 ; character abbreviation, the corresponding state
+20 ; is returned. Otherwise, the regular search is
+21 ; performed).
+22 ; B Backwards. Traverses the index in the opposite
+23 ; direction of normal traversal.
+24 ;
+25 ; [NUMBER] Maximum number of entries to return. A value of "*"
+26 ; or no value in this parameter designates all entries.
+27 ;
+28 ; [FROM] The index entry(s) from which to begin the list.
+29 ; You should use the pieces of the @RESULTS@(0) node
+30 ; (starting from the second one) to continue the
+31 ; listing in the subsequent procedure calls.
+32 ;
+33 ; NOTE: The FROM value itself is not included in
+34 ; the resulting list.
+35 ;
+36 ; The ^TMP("DILIST",$J) global node is used by the procedure.
+37 ;
+38 ; See description of the LIST^DIC for more details about the
+39 ; PART, NUMBER and FROM parameters.
+40 ;
+41 ; Return Values:
+42 ;
+43 ; A negative value of the first "^"-piece of the @RESULTS@(0)
+44 ; indicates an error (see the RPCSTK^RORERR procedure for more
+45 ; details).
+46 ;
+47 ; Otherwise, number of states and the value of the FROM
+48 ; parameter for the next procedure call are returned in the
+49 ; @RESULTS@(0) and the subsequent nodes of the global array
+50 ; contain the states.
+51 ;
+52 ; @RESULTS@(0) Result Descriptor
+53 ; ^01: Number of states
+54 ; ^02: Values that comprise the FROM
+55 ; ^nn: parameter for the subsequent call
+56 ;
+57 ; @RESULTS@(i) State
+58 ; ^01: IEN
+59 ; ^02: Name
+60 ; ^03: Abbreviation
+61 ; ^04: VA State Code
+62 ;
STATELST(RESULTS,PART,FLAGS,NUMBER,FROM) ;
+1 NEW BUF,FIELDS,I,RC,RORERRDL,TMP
+2 DO CLEAR^RORERR("STATELST^RORRP029",1)
+3 KILL RESULTS
SET RESULTS=$NAME(^TMP("DILIST",$JOB))
KILL @RESULTS
+4 SET FIELDS="@;.01;1;2"
+5 ;--- Check the parameters
+6 SET RC=0
Begin DoDot:1
+7 ;--- Flags
+8 SET FLAGS=$$UP^XLFSTR($GET(FLAGS))
+9 ;--- Others
+10 SET PART=$GET(PART)
SET FROM=$GET(FROM)
+11 SET NUMBER=$SELECT($GET(NUMBER)>0:+NUMBER,1:"*")
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+12 ;--- Setup the start point
+13 FOR I=1:1
SET TMP=$PIECE(FROM,U,I)
if TMP=""
QUIT
SET FROM(I)=TMP
+14 SET FROM=$GET(FROM(1))
+15 ;--- Check for the abbreviation
+16 SET RC=0
+17 IF FLAGS["A"
IF $LENGTH(PART)=2
Begin DoDot:1
+18 DO LIST^DIC(5,,FIELDS,"P",2,,PART,"C",,,,"RORMSG")
+19 IF $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,5)
QUIT
+20 if +$GET(^TMP("DILIST",$JOB,0))=1
SET RC=1
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+21 ;--- Query the file
+22 IF 'RC
Begin DoDot:1
+23 SET TMP="P"_$SELECT(FLAGS["B":"B",1:"")
+24 DO LIST^DIC(5,,FIELDS,TMP,NUMBER,.FROM,PART,"B",,,,"RORMSG")
+25 IF $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,5)
QUIT
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+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
