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

RORRP018.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #91 Access to the LABORATORY TEST file
  1. ; #2051 FIND^DIC (supported)
  1. ; #2056 $$GET1^DIQ(supported)
  1. ; #10104 $$UP^XLFSTR (supported)
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*17 DEC 2011 C RAY Replaced call to LIST^DIC with FIND^DIC
  1. ; Param FROM is not supported by FIND^DIC
  1. ; Flag "B" is not supported by FIND^DIC
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. Q
  1. ;
  1. ;***** RETURNS THE LIST OF LAB TESTS
  1. ; RPC: [ROR LIST LABORATORY TESTS]
  1. ;
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; [SUBSCR] List of the test subscripts (separated by commas)
  1. ; to include. By default ($G(SUBSCR)=""), all tests
  1. ; are retrieved.
  1. ;
  1. ; [PART] The 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. ; P Include panels (by default, the panels are
  1. ; excluded from the list)
  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. ; ^01: FromName
  1. ; ^02: FromIEN
  1. ;
  1. ; For example, a FROM value of "AD" would list entries
  1. ; following AD. You can use the 2-nd and 3-rd "^"-
  1. ; pieces of the @RESULTS@(0) node 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. ; 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 lab tests 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 tests.
  1. ;
  1. ; @RESULTS@(0) Result Descriptor
  1. ; ^01: Number of tests
  1. ; ^02: FromName
  1. ; ^03: FromIEN
  1. ;
  1. ; @RESULTS@(i) Lab Test
  1. ; ^01: IEN
  1. ; ^02: Test Name
  1. ; ^03: Subscript (internal)
  1. ; ^04: Panel {""|1}
  1. ;
  1. ;
  1. LABTLIST(RESULTS,SUBSCR,PART,FLAGS,NUMBER,FROM) ;
  1. N BUF,I,RC,RORERRDL,RORMSG,RORSUBS,SCR,TMP
  1. D CLEAR^RORERR("LABTLIST^RORRP018",1)
  1. K RESULTS S RESULTS=$$ALLOC^RORTMP()
  1. ;--- Check the parameters
  1. S SUBSCR=$$UP^XLFSTR($TR($G(SUBSCR)," "))
  1. F I=1:1 S TMP=$P(SUBSCR,",",I) Q:TMP="" S RORSUBS(TMP)=""
  1. S PART=$G(PART),FLAGS=$G(FLAGS)
  1. S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
  1. ;--- Setup the start point FROM is passed in and formatted but not used
  1. I $G(FROM)'="" D S FROM=$P(FROM,U)
  1. . S:$P(FROM,U,2)>0 FROM("IEN")=+$P(FROM,U,2)
  1. ;--- Compile the screen logic (be careful with naked references)
  1. S SCR=""
  1. D:$D(RORSUBS)>0
  1. . S SCR=SCR_"S D=$P($G(^(0)),U,4) I D'="""",$D(RORSUBS(D)) "
  1. S:FLAGS'["P" SCR=SCR_"I $O(^(2,0))'>0 " ; Exclude panels
  1. ;--- Get the list of tests
  1. S BUF="@;.01;IX",TMP="PM" ;"B" flag not supported
  1. D FIND^DIC(60,,BUF,TMP,PART,NUMBER,"B^D",SCR,,RESULTS,"RORMSG")
  1. I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
  1. . S RC=$$DBS^RORERR("RORMSG",-9,,,60)
  1. . D FREE^RORTMP(RESULTS)
  1. S RESULTS=$NA(@RESULTS@("DILIST"))
  1. ;--- Post processing
  1. D:FLAGS["P"
  1. . ;--- Mark the Lab panels
  1. . S I=0
  1. . F S I=$O(@RESULTS@(I)) Q:I'>0 D
  1. . . S IEN=+$P(@RESULTS@(I,0),U)
  1. . . S TMP=$$GET1^DIQ(60,IEN_",","COUNT(#200)",,,"RORMSG")
  1. . . S:TMP>0 $P(@RESULTS@(I,0),U,4)=1
  1. ;--- Success
  1. S TMP=$G(@RESULTS@(0)),BUF=+$P(TMP,U)
  1. K @RESULTS@(0)
  1. S:$P(TMP,U,3) $P(BUF,U,2,3)=$G(FROM)_U_$G(FROM("IEN"))
  1. S @RESULTS@(0)=BUF
  1. Q