- 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 Apr 23, 2025@17:57:28 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