207 lines
7.6 KiB
Mathematica
207 lines
7.6 KiB
Mathematica
RORRP016 ;HCIOFO/SG - RPC: LIST OF ICD-9 CODES ; 6/16/06 2:16pm
|
|
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|
;
|
|
; This routine uses the following IAs:
|
|
;
|
|
; #3990 $$ICDDX^ICDCODE, $$ICDOP^ICDCODE, and
|
|
; $$ICDD^ICDCODE (supported)
|
|
; #10082 Access to the file #80 (supported)
|
|
; #10083 Access to the file #80.1 (supported)
|
|
;
|
|
Q
|
|
;
|
|
;***** RETURNS THE LIST OF ICD-9 CODES (DIAGNOSES OR PROCEDURES)
|
|
; RPC: [ROR LIST ICD-9]
|
|
;
|
|
; .RORESULT Reference to a local variable where the results
|
|
; are returned to.
|
|
;
|
|
; [DATE] Date for the code set versioning.
|
|
;
|
|
; [PART] The partial match restriction.
|
|
;
|
|
; [FLAGS] Flags that control the execution (can be combined):
|
|
; A Exclude active codes
|
|
; B Backwards. Traverses the index in the opposite
|
|
; direction of normal traversal
|
|
; D Full search by description
|
|
; F Exclude codes applicable to females only
|
|
; I Exclude inactive codes
|
|
; K Search in description keywords
|
|
; M Exclude codes applicable to males only
|
|
; O Return operation/procedure codes from file #80.1
|
|
; instead of diagnosis codes from the file #80
|
|
; P Exclude codes that are not acceptable
|
|
; as primary diagnoses
|
|
;
|
|
; [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 "51" would list entries
|
|
; following 51. You can use the 2-nd and 3-rd "^"-
|
|
; pieces of the @RORESULT@(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.
|
|
;
|
|
; The ^TMP("RORRP016",$J) global node is used by this procedure.
|
|
;
|
|
; Return Values:
|
|
;
|
|
; A negative value of the first "^"-piece of the @RORESULT@(0)
|
|
; indicates an error (see the RPCSTK^RORERR procedure for more
|
|
; details).
|
|
;
|
|
; Otherwise, number of ICD-9 codes and the value of the FROM
|
|
; parameter for the next procedure call are returned in the
|
|
; @RORESULT@(0) and the subsequent nodes of the global array
|
|
; contain the codes.
|
|
;
|
|
; @RORESULT@(0) Result Descriptor
|
|
; ^01: Number of codes
|
|
; ^02: FromName
|
|
; ^03: FromIEN
|
|
;
|
|
; @RORESULT@(i) ICD-9
|
|
; ^01: IEN
|
|
; ^02: Diagnosis or operation/procedure
|
|
; ^03: Code
|
|
; ^04: Use only with Sex
|
|
; ^05: Inactive {0|1}
|
|
; ^06: Inactivation Date (FileMan)
|
|
;
|
|
; @RORESULT@(i+1) ICD-9 Description
|
|
;
|
|
ICD9LIST(RORESULT,DATE,PART,FLAGS,NUMBER,FROM) ;
|
|
N BUF,RC,RORERRDL,TMP
|
|
D CLEAR^RORERR("ICD9LIST^RORRP016",1)
|
|
K RORESULT S RORESULT=$NA(^TMP("RORRP016",$J)) K @RORESULT
|
|
;--- Check the parameters
|
|
S PART=$G(PART),FLAGS=$G(FLAGS)
|
|
S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
|
|
;--- Setup the start point
|
|
I $G(FROM)'="" D S FROM=$P(FROM,U)
|
|
. S:$P(FROM,U,2)>0 FROM("IEN")=+$P(FROM,U,2)
|
|
;--- Compile the list
|
|
I FLAGS["O" D
|
|
. ;--- Get the list of operation/procedure codes
|
|
. S RC=$$QUERY1(PART,FLAGS,NUMBER,.FROM) Q:RC<0
|
|
. S RORESULT=$NA(@RORESULT@("DILIST"))
|
|
. ;--- Load remaining data and refine the list
|
|
. D REFINE1(PART,FLAGS,$G(DATE))
|
|
E D
|
|
. ;--- Get the list of diagnosis codes
|
|
. S RC=$$QUERY(PART,FLAGS,NUMBER,.FROM) Q:RC<0
|
|
. S RORESULT=$NA(@RORESULT@("DILIST"))
|
|
. ;--- Load remaining data and refine the list
|
|
. D REFINE(PART,FLAGS,$G(DATE))
|
|
I RC<0 D RPCSTK^RORERR(.RORESULT,RC) Q
|
|
;--- Success
|
|
S TMP=$G(@RORESULT@(0)),BUF=+$P(TMP,U)
|
|
S:$P(TMP,U,3) $P(BUF,U,2,3)=$G(FROM)_U_$G(FROM("IEN"))
|
|
K @RORESULT@(0) S @RORESULT@(0)=BUF
|
|
Q
|
|
;
|
|
;***** QUERIES THE ICD DIAGNOSIS FILE (#80)
|
|
QUERY(PART,FLAGS,NR,FROM) ;
|
|
N FLDS,RORMSG,SCR,TMP,XREF
|
|
;--- Compile the screen logic (be careful with naked references)
|
|
S SCR=""
|
|
I FLAGS["D" S:PART'="" SCR=SCR_"I $P(D,U,3)["""_PART_""" ",PART=""
|
|
S:FLAGS["F" SCR=SCR_"I $P(D,U,10)'=""F"" "
|
|
S:FLAGS["M" SCR=SCR_"I $P(D,U,10)'=""M"" "
|
|
S:FLAGS["P" SCR=SCR_"I '$P(D,U,4) "
|
|
S:SCR'="" SCR="S D=$G(^(0)) "_SCR
|
|
;--- Get the list of codes and some data
|
|
S FLDS="@;3;.01;9.5I;IXI",TMP="P"_$S(FLAGS["B":"B",1:"")
|
|
S XREF=$S(FLAGS["D":"#",FLAGS["K":"D",1:"BA")
|
|
D LIST^DIC(80,,FLDS,TMP,NR,.FROM,PART,XREF,SCR,,RORESULT,"RORMSG")
|
|
I $G(DIERR) K @RORESULT Q $$DBS^RORERR("RORMSG",-9,,,80)
|
|
;--- Success
|
|
Q 0
|
|
;
|
|
;***** QUERIES THE ICD OPERATION/PROCEDURE FILE (#80.1)
|
|
QUERY1(PART,FLAGS,NR,FROM) ;
|
|
N FLDS,RORMSG,SCR,TMP,XREF
|
|
;--- Compile the screen logic (be careful with naked references)
|
|
S SCR=""
|
|
I FLAGS["D" S:PART'="" SCR=SCR_"I $P(D,U,4)["""_PART_""" ",PART=""
|
|
S:FLAGS["F" SCR=SCR_"I $P(D,U,10)'=""F"" "
|
|
S:FLAGS["M" SCR=SCR_"I $P(D,U,10)'=""M"" "
|
|
S:SCR'="" SCR="S D=$G(^(0)) "_SCR
|
|
;--- Get the list of codes and some data
|
|
S FLDS="@;4;.01;9.5I;IXI",TMP="P"_$S(FLAGS["B":"B",1:"")
|
|
S XREF=$S(FLAGS["D":"#",FLAGS["K":"D",1:"BA")
|
|
D LIST^DIC(80.1,,FLDS,TMP,NR,.FROM,PART,XREF,SCR,,RORESULT,"RORMSG")
|
|
I $G(DIERR) K @RORESULT Q $$DBS^RORERR("RORMSG",-9,,,80.1)
|
|
;--- Success
|
|
Q 0
|
|
;
|
|
;***** REFINES THE LIST OF DIAGNOSES
|
|
REFINE(PART,FLAGS,DATE) ;
|
|
N BUF,CNT,ICDINFO,MODE,RORDESC,SUBS,TMP
|
|
S MODE=($TR(FLAGS,"DK")=FLAGS)
|
|
S (CNT,SUBS)=0
|
|
F S SUBS=$O(@RORESULT@(SUBS)) Q:SUBS'>0 D
|
|
. S BUF=@RORESULT@(SUBS,0)
|
|
. ;--- Remove duplicates created by the logic of the "BAA" xref
|
|
. I MODE D I '(TMP?1.E1" ") K @RORESULT@(SUBS) Q
|
|
. . S TMP=$P(BUF,U,5)
|
|
. ;--- Load the additional data
|
|
. S ICDINFO=$$ICDDX^ICDCODE(+$P(BUF,U),DATE)
|
|
. I ICDINFO<0 K @RORESULT@(SUBS) Q
|
|
. ;--- Screen active/inactive records
|
|
. S TMP=+$P(ICDINFO,U,10) ; Status
|
|
. I $S(TMP:FLAGS["A",1:FLAGS["I") K @RORESULT@(SUBS) Q
|
|
. S $P(BUF,U,5)=TMP
|
|
. S $P(BUF,U,6)=$S(TMP:$P(ICDINFO,U,12),1:"") ; Inactivation Date
|
|
. ;--- Versioned diagnosis
|
|
. S TMP=$P(ICDINFO,U,4) S:TMP'="" $P(BUF,U,2)=TMP
|
|
. ;--- Store the data
|
|
. S CNT=CNT+1,@RORESULT@(SUBS,0)=BUF
|
|
. ;--- Versioned description
|
|
. S TMP=$$ICDD^ICDCODE($P(BUF,U,3),"RORDESC")
|
|
. S @RORESULT@(SUBS,1)=$S($G(RORDESC(1))'="":RORDESC(1),1:$P(BUF,U,2))
|
|
. K RORDESC
|
|
;---
|
|
S $P(@RORESULT@(0),U)=CNT
|
|
Q
|
|
;
|
|
;***** REFINES THE LIST OF OPERATION/PROCEDURES
|
|
REFINE1(PART,FLAGS,DATE) ;
|
|
N BUF,CNT,ICDINFO,MODE,RORDESC,SUBS,TMP
|
|
S MODE=($TR(FLAGS,"DK")=FLAGS)
|
|
S (CNT,SUBS)=0
|
|
F S SUBS=$O(@RORESULT@(SUBS)) Q:SUBS'>0 D
|
|
. S BUF=@RORESULT@(SUBS,0)
|
|
. ;--- Remove duplicates created by the logic of the "BAA" xref
|
|
. I MODE D I '(TMP?1.E1" ") K @RORESULT@(SUBS) Q
|
|
. . S TMP=$P(BUF,U,5)
|
|
. ;--- Load the additional data
|
|
. S ICDINFO=$$ICDOP^ICDCODE(+$P(BUF,U),DATE)
|
|
. I ICDINFO<0 K @RORESULT@(SUBS) Q
|
|
. ;--- Screen active/inactive records
|
|
. S TMP=+$P(ICDINFO,U,10) ; Status
|
|
. I $S(TMP:FLAGS["A",1:FLAGS["I") K @RORESULT@(SUBS) Q
|
|
. S $P(BUF,U,5)=TMP
|
|
. S $P(BUF,U,6)=$S(TMP:$P(ICDINFO,U,12),1:"") ; Inactivation Date
|
|
. ;--- Versioned operation/procedure
|
|
. S TMP=$P(ICDINFO,U,5) S:TMP'="" $P(BUF,U,2)=TMP
|
|
. ;--- Store the data
|
|
. S CNT=CNT+1,@RORESULT@(SUBS,0)=BUF
|
|
. ;--- Versioned description
|
|
. S TMP=$$ICDD^ICDCODE($P(BUF,U,3),"RORDESC")
|
|
. S @RORESULT@(SUBS,1)=$S($G(RORDESC(1))'="":RORDESC(1),1:$P(BUF,U,2))
|
|
. K RORDESC
|
|
;---
|
|
S $P(@RORESULT@(0),U)=CNT
|
|
Q
|