| 1 | RORRP042 ;HCIOFO/SG - RPC: CPT CODES ; 11/10/05 9:21am
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine uses the following IAs:
|
|---|
| 5 | ;
|
|---|
| 6 | ; #1995 $$CPT^ICPTCOD (supported)
|
|---|
| 7 | ; #2815 Access to the file #81 (supported)
|
|---|
| 8 | ;
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | ;***** RETURNS THE LIST OF CPT CODES
|
|---|
| 12 | ; RPC: [ROR LIST CPT]
|
|---|
| 13 | ;
|
|---|
| 14 | ; .RORESULT Reference to a local variable where the results
|
|---|
| 15 | ; are returned to.
|
|---|
| 16 | ;
|
|---|
| 17 | ; [DATE] Date for the code set versioning.
|
|---|
| 18 | ;
|
|---|
| 19 | ; [PART] The partial match restriction.
|
|---|
| 20 | ;
|
|---|
| 21 | ; [FLAGS] Flags that control the execution (can be combined):
|
|---|
| 22 | ; A Exclude active codes
|
|---|
| 23 | ; B Backwards. Traverses the index in the opposite
|
|---|
| 24 | ; direction of normal traversal
|
|---|
| 25 | ; D Full search by short name
|
|---|
| 26 | ; I Exclude inactive codes
|
|---|
| 27 | ; K Search in description keywords
|
|---|
| 28 | ;
|
|---|
| 29 | ; [NUMBER] Maximum number of entries to return. A value of "*"
|
|---|
| 30 | ; or no value in this parameter designates all entries.
|
|---|
| 31 | ;
|
|---|
| 32 | ; [FROM] The index entry(s) from which to begin the list
|
|---|
| 33 | ; ^01: FromName
|
|---|
| 34 | ; ^02: FromIEN
|
|---|
| 35 | ;
|
|---|
| 36 | ; For example, a FROM value of "51" would list entries
|
|---|
| 37 | ; following 51. You can use the 2-nd and 3-rd "^"-
|
|---|
| 38 | ; pieces of the @RORESULT@(0) node to continue the
|
|---|
| 39 | ; listing in the subsequent procedure calls.
|
|---|
| 40 | ;
|
|---|
| 41 | ; NOTE: The FROM value itself is not included in
|
|---|
| 42 | ; the resulting list.
|
|---|
| 43 | ;
|
|---|
| 44 | ; See description of the LIST^DIC for more details about the
|
|---|
| 45 | ; PART, NUMBER and FROM parameters.
|
|---|
| 46 | ;
|
|---|
| 47 | ; The ^TMP("RORRP042",$J) global node is used by this procedure.
|
|---|
| 48 | ;
|
|---|
| 49 | ; Return Values:
|
|---|
| 50 | ;
|
|---|
| 51 | ; A negative value of the first "^"-piece of the @RORESULT@(0)
|
|---|
| 52 | ; indicates an error (see the RPCSTK^RORERR procedure for more
|
|---|
| 53 | ; details).
|
|---|
| 54 | ;
|
|---|
| 55 | ; Otherwise, number of CPT codes and the value of the FROM
|
|---|
| 56 | ; parameter for the next procedure call are returned in the
|
|---|
| 57 | ; @RORESULT@(0) and the subsequent nodes of the global array
|
|---|
| 58 | ; contain the codes.
|
|---|
| 59 | ;
|
|---|
| 60 | ; @RORESULT@(0) Result Descriptor
|
|---|
| 61 | ; ^01: Number of codes
|
|---|
| 62 | ; ^02: FromName
|
|---|
| 63 | ; ^03: FromIEN
|
|---|
| 64 | ;
|
|---|
| 65 | ; @RORESULT@(i) CPT
|
|---|
| 66 | ; ^01: IEN
|
|---|
| 67 | ; ^02: Short Name
|
|---|
| 68 | ; ^03: Code
|
|---|
| 69 | ; ^04: reserved
|
|---|
| 70 | ; ^05: Inactive {0|1}
|
|---|
| 71 | ; ^06: Inactivation Date (FileMan)
|
|---|
| 72 | ;
|
|---|
| 73 | CPTLIST(RORESULT,DATE,PART,FLAGS,NUMBER,FROM) ;
|
|---|
| 74 | N BUF,RC,RORERRDL,TMP
|
|---|
| 75 | D CLEAR^RORERR("CPTLIST^RORRP042",1)
|
|---|
| 76 | K RORESULT S RORESULT=$NA(^TMP("RORRP042",$J)) K @RORESULT
|
|---|
| 77 | ;--- Check the parameters
|
|---|
| 78 | S PART=$G(PART),FLAGS=$G(FLAGS)
|
|---|
| 79 | S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
|
|---|
| 80 | ;--- Setup the start point
|
|---|
| 81 | I $G(FROM)'="" D S FROM=$P(FROM,U)
|
|---|
| 82 | . S:$P(FROM,U,2)>0 FROM("IEN")=+$P(FROM,U,2)
|
|---|
| 83 | ;--- Get the list of CPT codes
|
|---|
| 84 | S RC=$$QUERY(PART,FLAGS,NUMBER,.FROM)
|
|---|
| 85 | I RC<0 D RPCSTK^RORERR(.RORESULT,RC) Q
|
|---|
| 86 | S RORESULT=$NA(@RORESULT@("DILIST"))
|
|---|
| 87 | ;--- Load remaining data and refine the list
|
|---|
| 88 | D REFINE($G(DATE),FLAGS)
|
|---|
| 89 | ;--- Success
|
|---|
| 90 | S TMP=$G(@RORESULT@(0)),BUF=+$P(TMP,U)
|
|---|
| 91 | S:$P(TMP,U,3) $P(BUF,U,2,3)=$G(FROM)_U_$G(FROM("IEN"))
|
|---|
| 92 | K @RORESULT@(0) S @RORESULT@(0)=BUF
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | ;***** QUERIES THE CPT FILE (#81)
|
|---|
| 96 | QUERY(PART,FLAGS,NR,FROM) ;
|
|---|
| 97 | N FLDS,RORMSG,SCR,TMP,XREF
|
|---|
| 98 | ;--- Compile the screen logic (be careful with naked references)
|
|---|
| 99 | S SCR=""
|
|---|
| 100 | I FLAGS["D" S:PART'="" SCR=SCR_"I $P(D,U,2)["""_PART_""" ",PART=""
|
|---|
| 101 | S:SCR'="" SCR="S D=$G(^(0)) "_SCR
|
|---|
| 102 | ;--- Get the list of codes and some data
|
|---|
| 103 | S FLDS="@;.01;.01",TMP="P"_$S(FLAGS["B":"B",1:"")
|
|---|
| 104 | S XREF=$S(FLAGS["D":"#",FLAGS["K":"C",1:"B")
|
|---|
| 105 | D LIST^DIC(81,,FLDS,TMP,NR,.FROM,PART,XREF,SCR,,RORESULT,"RORMSG")
|
|---|
| 106 | I $G(DIERR) K @RORESULT Q $$DBS^RORERR("RORMSG",-9,,,80)
|
|---|
| 107 | ;--- Success
|
|---|
| 108 | Q 0
|
|---|
| 109 | ;
|
|---|
| 110 | ;***** REFINES THE LIST OF CPT CODES
|
|---|
| 111 | REFINE(DATE,FLAGS) ;
|
|---|
| 112 | N BUF,CNT,CPTINFO,RORDESC,SUBS,TMP
|
|---|
| 113 | S (CNT,SUBS)=0
|
|---|
| 114 | F S SUBS=$O(@RORESULT@(SUBS)) Q:SUBS'>0 D
|
|---|
| 115 | . S BUF=@RORESULT@(SUBS,0)
|
|---|
| 116 | . S CPTINFO=$$CPT^ICPTCOD(+$P(BUF,U),DATE)
|
|---|
| 117 | . I CPTINFO<0 K @RORESULT@(SUBS) Q
|
|---|
| 118 | . ;--- Screen active/inactive records
|
|---|
| 119 | . S TMP=+$P(CPTINFO,U,7) ; Status
|
|---|
| 120 | . I $S(TMP:FLAGS["A",1:FLAGS["I") K @RORESULT@(SUBS) Q
|
|---|
| 121 | . S $P(BUF,U,5)=TMP
|
|---|
| 122 | . S $P(BUF,U,6)=$S(TMP:$P(CPTINFO,U,8),1:"") ; Inactivation Date
|
|---|
| 123 | . ;--- Versioned short name
|
|---|
| 124 | . S TMP=$P(CPTINFO,U,3) S:TMP'="" $P(BUF,U,2)=TMP
|
|---|
| 125 | . ;--- Store the data
|
|---|
| 126 | . S CNT=CNT+1,@RORESULT@(SUBS,0)=BUF
|
|---|
| 127 | ;---
|
|---|
| 128 | S $P(@RORESULT@(0),U)=CNT
|
|---|
| 129 | Q
|
|---|
