RORRP018 ;HCIOFO/SG - RPC: LIST OF LAB TESTS ; 10/19/05 8:23am
;;1.5;CLINICAL CASE REGISTRIES;**17**;Feb 17, 2006;Build 33
;
; This routine uses the following IAs:
;
; #91 Access to the LABORATORY TEST file
; #2051 FIND^DIC (supported)
; #2056 $$GET1^DIQ(supported)
; #10104 $$UP^XLFSTR (supported)
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*17 DEC 2011 C RAY Replaced call to LIST^DIC with FIND^DIC
; Param FROM is not supported by FIND^DIC
; Flag "B" is not supported by FIND^DIC
;******************************************************************************
;******************************************************************************
Q
;
;***** RETURNS THE LIST OF LAB TESTS
; RPC: [ROR LIST LABORATORY TESTS]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; [SUBSCR] List of the test subscripts (separated by commas)
; to include. By default ($G(SUBSCR)=""), all tests
; are retrieved.
;
; [PART] The partial match restriction.
;
; [FLAGS] Flags that control the execution (can be combined):
; B Backwards. Traverses the index in the opposite
; direction of normal traversal
; P Include panels (by default, the panels are
; excluded from the list)
;
; [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
; ^01: FromName
; ^02: FromIEN
;
; For example, a FROM value of "AD" would list entries
; following AD. You can use the 2-nd and 3-rd "^"-
; pieces of the @RESULTS@(0) node to continue the
; listing in the subsequent procedure calls.
;
; NOTE: The FROM value itself is not included in
; the resulting list.
;
; 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 lab tests 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 tests.
;
; @RESULTS@(0) Result Descriptor
; ^01: Number of tests
; ^02: FromName
; ^03: FromIEN
;
; @RESULTS@(i) Lab Test
; ^01: IEN
; ^02: Test Name
; ^03: Subscript (internal)
; ^04: Panel {""|1}
;
;
LABTLIST(RESULTS,SUBSCR,PART,FLAGS,NUMBER,FROM) ;
N BUF,I,RC,RORERRDL,RORMSG,RORSUBS,SCR,TMP
D CLEAR^RORERR("LABTLIST^RORRP018",1)
K RESULTS S RESULTS=$$ALLOC^RORTMP()
;--- Check the parameters
S SUBSCR=$$UP^XLFSTR($TR($G(SUBSCR)," "))
F I=1:1 S TMP=$P(SUBSCR,",",I) Q:TMP="" S RORSUBS(TMP)=""
S PART=$G(PART),FLAGS=$G(FLAGS)
S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
;--- Setup the start point FROM is passed in and formatted but not used
I $G(FROM)'="" D S FROM=$P(FROM,U)
. S:$P(FROM,U,2)>0 FROM("IEN")=+$P(FROM,U,2)
;--- Compile the screen logic (be careful with naked references)
S SCR=""
D:$D(RORSUBS)>0
. S SCR=SCR_"S D=$P($G(^(0)),U,4) I D'="""",$D(RORSUBS(D)) "
S:FLAGS'["P" SCR=SCR_"I $O(^(2,0))'>0 " ; Exclude panels
;--- Get the list of tests
S BUF="@;.01;IX",TMP="PM" ;"B" flag not supported
D FIND^DIC(60,,BUF,TMP,PART,NUMBER,"B^D",SCR,,RESULTS,"RORMSG")
I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$DBS^RORERR("RORMSG",-9,,,60)
. D FREE^RORTMP(RESULTS)
S RESULTS=$NA(@RESULTS@("DILIST"))
;--- Post processing
D:FLAGS["P"
. ;--- Mark the Lab panels
. S I=0
. F S I=$O(@RESULTS@(I)) Q:I'>0 D
. . S IEN=+$P(@RESULTS@(I,0),U)
. . S TMP=$$GET1^DIQ(60,IEN_",","COUNT(#200)",,,"RORMSG")
. . S:TMP>0 $P(@RESULTS@(I,0),U,4)=1
;--- Success
S TMP=$G(@RESULTS@(0)),BUF=+$P(TMP,U)
K @RESULTS@(0)
S:$P(TMP,U,3) $P(BUF,U,2,3)=$G(FROM)_U_$G(FROM("IEN"))
S @RESULTS@(0)=BUF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP018 4876 printed Dec 13, 2024@01:43:01 Page 2
RORRP018 ;HCIOFO/SG - RPC: LIST OF LAB TESTS ; 10/19/05 8:23am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**17**;Feb 17, 2006;Build 33
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #91 Access to the LABORATORY TEST file
+6 ; #2051 FIND^DIC (supported)
+7 ; #2056 $$GET1^DIQ(supported)
+8 ; #10104 $$UP^XLFSTR (supported)
+9 ;******************************************************************************
+10 ;******************************************************************************
+11 ; --- ROUTINE MODIFICATION LOG ---
+12 ;
+13 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+14 ;----------- ---------- ----------- ----------------------------------------
+15 ;ROR*1.5*17 DEC 2011 C RAY Replaced call to LIST^DIC with FIND^DIC
+16 ; Param FROM is not supported by FIND^DIC
+17 ; Flag "B" is not supported by FIND^DIC
+18 ;******************************************************************************
+19 ;******************************************************************************
+20 QUIT
+21 ;
+22 ;***** RETURNS THE LIST OF LAB TESTS
+23 ; RPC: [ROR LIST LABORATORY TESTS]
+24 ;
+25 ; .RESULTS Reference to a local variable where the results
+26 ; are returned to.
+27 ;
+28 ; [SUBSCR] List of the test subscripts (separated by commas)
+29 ; to include. By default ($G(SUBSCR)=""), all tests
+30 ; are retrieved.
+31 ;
+32 ; [PART] The partial match restriction.
+33 ;
+34 ; [FLAGS] Flags that control the execution (can be combined):
+35 ; B Backwards. Traverses the index in the opposite
+36 ; direction of normal traversal
+37 ; P Include panels (by default, the panels are
+38 ; excluded from the list)
+39 ;
+40 ; [NUMBER] Maximum number of entries to return. A value of "*"
+41 ; or no value in this parameter designates all entries.
+42 ;
+43 ; [FROM] The index entry(s) from which to begin the list
+44 ; ^01: FromName
+45 ; ^02: FromIEN
+46 ;
+47 ; For example, a FROM value of "AD" would list entries
+48 ; following AD. You can use the 2-nd and 3-rd "^"-
+49 ; pieces of the @RESULTS@(0) node to continue the
+50 ; listing in the subsequent procedure calls.
+51 ;
+52 ; NOTE: The FROM value itself is not included in
+53 ; the resulting list.
+54 ;
+55 ; See description of the LIST^DIC for more details about the
+56 ; PART, NUMBER and FROM parameters.
+57 ;
+58 ; Return Values:
+59 ;
+60 ; A negative value of the first "^"-piece of the RESULTS(0)
+61 ; indicates an error (see the RPCSTK^RORERR procedure for more
+62 ; details).
+63 ;
+64 ; Otherwise, number of lab tests and the value of the FROM
+65 ; parameter for the next procedure call are returned in the
+66 ; @RESULTS@(0) and the subsequent nodes of the global array
+67 ; contain the tests.
+68 ;
+69 ; @RESULTS@(0) Result Descriptor
+70 ; ^01: Number of tests
+71 ; ^02: FromName
+72 ; ^03: FromIEN
+73 ;
+74 ; @RESULTS@(i) Lab Test
+75 ; ^01: IEN
+76 ; ^02: Test Name
+77 ; ^03: Subscript (internal)
+78 ; ^04: Panel {""|1}
+79 ;
+80 ;
LABTLIST(RESULTS,SUBSCR,PART,FLAGS,NUMBER,FROM) ;
+1 NEW BUF,I,RC,RORERRDL,RORMSG,RORSUBS,SCR,TMP
+2 DO CLEAR^RORERR("LABTLIST^RORRP018",1)
+3 KILL RESULTS
SET RESULTS=$$ALLOC^RORTMP()
+4 ;--- Check the parameters
+5 SET SUBSCR=$$UP^XLFSTR($TRANSLATE($GET(SUBSCR)," "))
+6 FOR I=1:1
SET TMP=$PIECE(SUBSCR,",",I)
if TMP=""
QUIT
SET RORSUBS(TMP)=""
+7 SET PART=$GET(PART)
SET FLAGS=$GET(FLAGS)
+8 SET NUMBER=$SELECT($GET(NUMBER)>0:+NUMBER,1:"*")
+9 ;--- Setup the start point FROM is passed in and formatted but not used
+10 IF $GET(FROM)'=""
Begin DoDot:1
+11 if $PIECE(FROM,U,2)>0
SET FROM("IEN")=+$PIECE(FROM,U,2)
End DoDot:1
SET FROM=$PIECE(FROM,U)
+12 ;--- Compile the screen logic (be careful with naked references)
+13 SET SCR=""
+14 if $DATA(RORSUBS)>0
Begin DoDot:1
+15 SET SCR=SCR_"S D=$P($G(^(0)),U,4) I D'="""",$D(RORSUBS(D)) "
End DoDot:1
+16 ; Exclude panels
if FLAGS'["P"
SET SCR=SCR_"I $O(^(2,0))'>0 "
+17 ;--- Get the list of tests
+18 ;"B" flag not supported
SET BUF="@;.01;IX"
SET TMP="PM"
+19 DO FIND^DIC(60,,BUF,TMP,PART,NUMBER,"B^D",SCR,,RESULTS,"RORMSG")
+20 IF $GET(DIERR)
Begin DoDot:1
+21 SET RC=$$DBS^RORERR("RORMSG",-9,,,60)
+22 DO FREE^RORTMP(RESULTS)
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+23 SET RESULTS=$NAME(@RESULTS@("DILIST"))
+24 ;--- Post processing
+25 if FLAGS["P"
Begin DoDot:1
+26 ;--- Mark the Lab panels
+27 SET I=0
+28 FOR
SET I=$ORDER(@RESULTS@(I))
if I'>0
QUIT
Begin DoDot:2
+29 SET IEN=+$PIECE(@RESULTS@(I,0),U)
+30 SET TMP=$$GET1^DIQ(60,IEN_",","COUNT(#200)",,,"RORMSG")
+31 if TMP>0
SET $PIECE(@RESULTS@(I,0),U,4)=1
End DoDot:2
End DoDot:1
+32 ;--- Success
+33 SET TMP=$GET(@RESULTS@(0))
SET BUF=+$PIECE(TMP,U)
+34 KILL @RESULTS@(0)
+35 if $PIECE(TMP,U,3)
SET $PIECE(BUF,U,2,3)=$GET(FROM)_U_$GET(FROM("IEN"))
+36 SET @RESULTS@(0)=BUF
+37 QUIT
