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

RORRP042.m

Go to the documentation of this file. 
  1. RORRP042 ;HCIOFO/SG - RPC: CPT CODES ; 11/10/05 9:21am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #1995          $$CPT^ICPTCOD (supported)
  1.  ; #2815          Access to the file #81 (supported)
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** RETURNS THE LIST OF CPT CODES
  1.  ; RPC: [ROR LIST CPT]
  1.  ;
  1.  ; .RORESULT     Reference to a local variable where the results
  1.  ;               are returned to.
  1.  ;
  1.  ; [DATE]        Date for the code set versioning.
  1.  ;
  1.  ; [PART]        The partial match restriction.
  1.  ;
  1.  ; [FLAGS]       Flags that control the execution (can be combined):
  1.  ;                 A  Exclude active codes
  1.  ;                 B  Backwards. Traverses the index in the opposite
  1.  ;                    direction of normal traversal
  1.  ;                 D  Full search by short name
  1.  ;                 I  Exclude inactive codes
  1.  ;                 K  Search in description keywords
  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 "51" would list entries
  1.  ;               following 51. You can use the 2-nd and 3-rd "^"-
  1.  ;               pieces of the @RORESULT@(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.  ; The ^TMP("RORRP042",$J) global node is used by this procedure.
  1.  ;
  1.  ; Return Values:
  1.  ;
  1.  ; A negative value of the first "^"-piece of the @RORESULT@(0)
  1.  ; indicates an error (see the RPCSTK^RORERR procedure for more
  1.  ; details).
  1.  ;
  1.  ; Otherwise, number of CPT codes and the value of the FROM
  1.  ; parameter for the next procedure call are returned in the
  1.  ; @RORESULT@(0) and the subsequent nodes of the global array
  1.  ; contain the codes.
  1.  ; 
  1.  ; @RORESULT@(0)         Result Descriptor
  1.  ;                         ^01: Number of codes
  1.  ;                         ^02: FromName
  1.  ;                         ^03: FromIEN
  1.  ;
  1.  ; @RORESULT@(i)         CPT
  1.  ;                         ^01: IEN
  1.  ;                         ^02: Short Name
  1.  ;                         ^03: Code
  1.  ;                         ^04: reserved
  1.  ;                         ^05: Inactive {0|1}
  1.  ;                         ^06: Inactivation Date (FileMan)
  1.  ;
  1. CPTLIST(RORESULT,DATE,PART,FLAGS,NUMBER,FROM) ;
  1.  N BUF,RC,RORERRDL,TMP
  1.  D CLEAR^RORERR("CPTLIST^RORRP042",1)
  1.  K RORESULT  S RORESULT=$NA(^TMP("RORRP042",$J))  K @RORESULT
  1.  ;--- Check the parameters
  1.  S PART=$G(PART),FLAGS=$G(FLAGS)
  1.  S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
  1.  ;--- Setup the start point
  1.  I $G(FROM)'=""  D  S FROM=$P(FROM,U)
  1.  . S:$P(FROM,U,2)>0 FROM("IEN")=+$P(FROM,U,2)
  1.  ;--- Get the list of CPT codes
  1.  S RC=$$QUERY(PART,FLAGS,NUMBER,.FROM)
  1.  I RC<0  D RPCSTK^RORERR(.RORESULT,RC)  Q
  1.  S RORESULT=$NA(@RORESULT@("DILIST"))
  1.  ;--- Load remaining data and refine the list
  1.  D REFINE($G(DATE),FLAGS)
  1.  ;--- Success
  1.  S TMP=$G(@RORESULT@(0)),BUF=+$P(TMP,U)
  1.  S:$P(TMP,U,3) $P(BUF,U,2,3)=$G(FROM)_U_$G(FROM("IEN"))
  1.  K @RORESULT@(0)  S @RORESULT@(0)=BUF
  1.  Q
  1.  ;
  1.  ;***** QUERIES THE CPT FILE (#81)
  1. QUERY(PART,FLAGS,NR,FROM) ;
  1.  N FLDS,RORMSG,SCR,TMP,XREF
  1.  ;--- Compile the screen logic (be careful with naked references)
  1.  S SCR=""
  1.  I FLAGS["D"  S:PART'="" SCR=SCR_"I $P(D,U,2)["""_PART_""" ",PART=""
  1.  S:SCR'="" SCR="S D=$G(^(0)) "_SCR
  1.  ;--- Get the list of codes and some data
  1.  S FLDS="@;.01;.01",TMP="P"_$S(FLAGS["B":"B",1:"")
  1.  S XREF=$S(FLAGS["D":"#",FLAGS["K":"C",1:"B")
  1.  D LIST^DIC(81,,FLDS,TMP,NR,.FROM,PART,XREF,SCR,,RORESULT,"RORMSG")
  1.  I $G(DIERR)  K @RORESULT  Q $$DBS^RORERR("RORMSG",-9,,,80)
  1.  ;--- Success
  1.  Q 0
  1.  ;
  1.  ;***** REFINES THE LIST OF CPT CODES
  1. REFINE(DATE,FLAGS) ;
  1.  N BUF,CNT,CPTINFO,RORDESC,SUBS,TMP
  1.  S (CNT,SUBS)=0
  1.  F  S SUBS=$O(@RORESULT@(SUBS)) Q:SUBS'>0  D
  1.  . S BUF=@RORESULT@(SUBS,0)
  1.  . S CPTINFO=$$CPT^ICPTCOD(+$P(BUF,U),DATE)
  1.  . I CPTINFO<0  K @RORESULT@(SUBS)  Q
  1.  . ;--- Screen active/inactive records
  1.  . S TMP=+$P(CPTINFO,U,7)                      ; Status
  1.  . I $S(TMP:FLAGS["A",1:FLAGS["I")  K @RORESULT@(SUBS)  Q
  1.  . S $P(BUF,U,5)=TMP
  1.  . S $P(BUF,U,6)=$S(TMP:$P(CPTINFO,U,8),1:"")  ; Inactivation Date
  1.  . ;--- Versioned short name
  1.  . S TMP=$P(CPTINFO,U,3)  S:TMP'="" $P(BUF,U,2)=TMP
  1.  . ;--- Store the data
  1.  . S CNT=CNT+1,@RORESULT@(SUBS,0)=BUF
  1.  ;---
  1.  S $P(@RORESULT@(0),U)=CNT
  1.  Q