source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP018.m@ 1208

Last change on this file since 1208 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.7 KB
Line 
1RORRP018 ;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 ;
68LABTLIST(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
Note: See TracBrowser for help on using the repository browser.