| [613] | 1 | RORRP018 ;HCIOFO/SG - RPC: LIST OF LAB TESTS ; 10/19/05 8:23am
 | 
|---|
 | 2 |  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  ; This routine uses the following IAs:
 | 
|---|
 | 5 |  ;
 | 
|---|
 | 6 |  ; #91           Access to the LABORATORY TEST file
 | 
|---|
 | 7 |  ;
 | 
|---|
 | 8 |  Q
 | 
|---|
 | 9 |  ;
 | 
|---|
 | 10 |  ;***** RETURNS THE LIST OF LAB TESTS
 | 
|---|
 | 11 |  ; RPC: [ROR LIST LABORATORY TESTS]
 | 
|---|
 | 12 |  ;
 | 
|---|
 | 13 |  ; .RESULTS      Reference to a local variable where the results
 | 
|---|
 | 14 |  ;               are returned to.
 | 
|---|
 | 15 |  ;
 | 
|---|
 | 16 |  ; [SUBSCR]      List of the test subscripts (separated by commas)
 | 
|---|
 | 17 |  ;               to include. By default ($G(SUBSCR)=""), all tests
 | 
|---|
 | 18 |  ;               are retrieved.
 | 
|---|
 | 19 |  ;
 | 
|---|
 | 20 |  ; [PART]        The partial match restriction.
 | 
|---|
 | 21 |  ;
 | 
|---|
 | 22 |  ; [FLAGS]       Flags that control the execution (can be combined):
 | 
|---|
 | 23 |  ;                 B  Backwards. Traverses the index in the opposite
 | 
|---|
 | 24 |  ;                    direction of normal traversal
 | 
|---|
 | 25 |  ;                 P  Include panels (by default, the panels are
 | 
|---|
 | 26 |  ;                    excluded from the list)
 | 
|---|
 | 27 |  ;
 | 
|---|
 | 28 |  ; [NUMBER]      Maximum number of entries to return. A value of "*"
 | 
|---|
 | 29 |  ;               or no value in this parameter designates all entries.
 | 
|---|
 | 30 |  ;
 | 
|---|
 | 31 |  ; [FROM]        The index entry(s) from which to begin the list
 | 
|---|
 | 32 |  ;                 ^01: FromName
 | 
|---|
 | 33 |  ;                 ^02: FromIEN
 | 
|---|
 | 34 |  ;
 | 
|---|
 | 35 |  ;               For example, a FROM value of "AD" would list entries
 | 
|---|
 | 36 |  ;               following AD. You can use the 2-nd and 3-rd "^"-
 | 
|---|
 | 37 |  ;               pieces of the @RESULTS@(0) node to continue the
 | 
|---|
 | 38 |  ;               listing in the subsequent procedure calls.
 | 
|---|
 | 39 |  ;
 | 
|---|
 | 40 |  ;               NOTE: The FROM value itself is not included in
 | 
|---|
 | 41 |  ;                     the resulting list.
 | 
|---|
 | 42 |  ;
 | 
|---|
 | 43 |  ; See description of the LIST^DIC for more details about the
 | 
|---|
 | 44 |  ; PART, NUMBER and FROM parameters.
 | 
|---|
 | 45 |  ;
 | 
|---|
 | 46 |  ; Return Values:
 | 
|---|
 | 47 |  ;
 | 
|---|
 | 48 |  ; A negative value of the first "^"-piece of the RESULTS(0)
 | 
|---|
 | 49 |  ; indicates an error (see the RPCSTK^RORERR procedure for more
 | 
|---|
 | 50 |  ; details).
 | 
|---|
 | 51 |  ;
 | 
|---|
 | 52 |  ; Otherwise, number of lab tests and the value of the FROM
 | 
|---|
 | 53 |  ; parameter for the next procedure call are returned in the
 | 
|---|
 | 54 |  ; @RESULTS@(0) and the subsequent nodes of the global array
 | 
|---|
 | 55 |  ; contain the tests.
 | 
|---|
 | 56 |  ; 
 | 
|---|
 | 57 |  ; @RESULTS@(0)          Result Descriptor
 | 
|---|
 | 58 |  ;                         ^01: Number of tests
 | 
|---|
 | 59 |  ;                         ^02: FromName
 | 
|---|
 | 60 |  ;                         ^03: FromIEN
 | 
|---|
 | 61 |  ;
 | 
|---|
 | 62 |  ; @RESULTS@(i)          Lab Test
 | 
|---|
 | 63 |  ;                         ^01: IEN
 | 
|---|
 | 64 |  ;                         ^02: Test Name
 | 
|---|
 | 65 |  ;                         ^03: Subscript (internal)
 | 
|---|
 | 66 |  ;                         ^04: Panel {""|1}
 | 
|---|
 | 67 |  ;
 | 
|---|
 | 68 | LABTLIST(RESULTS,SUBSCR,PART,FLAGS,NUMBER,FROM) ;
 | 
|---|
 | 69 |  N BUF,I,RC,RORERRDL,RORMSG,RORSUBS,SCR,TMP
 | 
|---|
 | 70 |  D CLEAR^RORERR("LABTLIST^RORRP018",1)
 | 
|---|
 | 71 |  K RESULTS  S RESULTS=$$ALLOC^RORTMP()
 | 
|---|
 | 72 |  ;--- Check the parameters
 | 
|---|
 | 73 |  S SUBSCR=$$UP^XLFSTR($TR($G(SUBSCR)," "))
 | 
|---|
 | 74 |  F I=1:1  S TMP=$P(SUBSCR,",",I)  Q:TMP=""  S RORSUBS(TMP)=""
 | 
|---|
 | 75 |  S PART=$G(PART),FLAGS=$G(FLAGS)
 | 
|---|
 | 76 |  S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
 | 
|---|
 | 77 |  ;--- Setup the start point
 | 
|---|
 | 78 |  I $G(FROM)'=""  D  S FROM=$P(FROM,U)
 | 
|---|
 | 79 |  . S:$P(FROM,U,2)>0 FROM("IEN")=+$P(FROM,U,2)
 | 
|---|
 | 80 |  ;--- Compile the screen logic (be careful with naked references)
 | 
|---|
 | 81 |  S SCR=""
 | 
|---|
 | 82 |  D:$D(RORSUBS)>0
 | 
|---|
 | 83 |  . S SCR=SCR_"S D=$P($G(^(0)),U,4) I D'="""",$D(RORSUBS(D)) "
 | 
|---|
 | 84 |  S:FLAGS'["P" SCR=SCR_"I $O(^(2,0))'>0 "  ; Exclude panels
 | 
|---|
 | 85 |  ;--- Get the list of tests
 | 
|---|
 | 86 |  S BUF="@;.01;4I",TMP="PM"_$S(FLAGS["B":"B",1:"")
 | 
|---|
 | 87 |  D LIST^DIC(60,,BUF,TMP,NUMBER,.FROM,PART,"B",SCR,,RESULTS,"RORMSG")
 | 
|---|
 | 88 |  I $G(DIERR)  D  D RPCSTK^RORERR(.RESULTS,RC)  Q
 | 
|---|
 | 89 |  . S RC=$$DBS^RORERR("RORMSG",-9,,,60)
 | 
|---|
 | 90 |  . D FREE^RORTMP(RESULTS)
 | 
|---|
 | 91 |  S RESULTS=$NA(@RESULTS@("DILIST"))
 | 
|---|
 | 92 |  ;--- Post processing
 | 
|---|
 | 93 |  D:FLAGS["P"
 | 
|---|
 | 94 |  . ;--- Mark the Lab panels
 | 
|---|
 | 95 |  . S I=0
 | 
|---|
 | 96 |  . F  S I=$O(@RESULTS@(I))  Q:I'>0  D
 | 
|---|
 | 97 |  . . S IEN=+$P(@RESULTS@(I,0),U)
 | 
|---|
 | 98 |  . . S TMP=$$GET1^DIQ(60,IEN_",","COUNT(#200)",,,"RORMSG")
 | 
|---|
 | 99 |  . . S:TMP>0 $P(@RESULTS@(I,0),U,4)=1
 | 
|---|
 | 100 |  ;--- Success
 | 
|---|
 | 101 |  S TMP=$G(@RESULTS@(0)),BUF=+$P(TMP,U)
 | 
|---|
 | 102 |  K @RESULTS@(0)
 | 
|---|
 | 103 |  S:$P(TMP,U,3) $P(BUF,U,2,3)=$G(FROM)_U_$G(FROM("IEN"))
 | 
|---|
 | 104 |  S @RESULTS@(0)=BUF
 | 
|---|
 | 105 |  Q
 | 
|---|