106 lines
3.2 KiB
Mathematica
106 lines
3.2 KiB
Mathematica
RORX013C ;HCIOFO/SG - DIAGNOSIS CODES (STORE) ; 10/27/05 11:11am
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|
;
|
|
; This routine uses the following IAs:
|
|
;
|
|
; #3990 $$ICDDX^ICDCODE (supported)
|
|
;
|
|
Q
|
|
;
|
|
;***** STORES THE ICD-9 CODE TABLE
|
|
;
|
|
; PTAG IEN of the parent element
|
|
;
|
|
; NODE Closed root of the node of the temporary global
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of non-fatal errors
|
|
;
|
|
CODES(PTAG,NODE) ;
|
|
N ICDIEN,ITEM,TABLE,TMP
|
|
S TABLE=$$ADDVAL^RORTSK11(RORTSK,"ICD9LST",,PTAG)
|
|
Q:TABLE<0 TABLE
|
|
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","ICD9LST")
|
|
S ICDIEN=0
|
|
F S ICDIEN=$O(@NODE@("ICD",ICDIEN)) Q:ICDIEN'>0 D
|
|
. S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ICD9",,TABLE)
|
|
. S TMP=@NODE@("ICD",ICDIEN)
|
|
. D ADDVAL^RORTSK11(RORTSK,"CODE",$P(TMP,U,1),ITEM,2)
|
|
. D ADDVAL^RORTSK11(RORTSK,"DIAG",$P(TMP,U,2),ITEM,2)
|
|
. S TMP=$G(@NODE@("ICD",ICDIEN,"P"))
|
|
. D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
|
|
. S TMP=$G(@NODE@("ICD",ICDIEN,"C"))
|
|
. D ADDVAL^RORTSK11(RORTSK,"NC",TMP,ITEM,3)
|
|
Q 0
|
|
;
|
|
;***** STORES THE PATIENT TABLE
|
|
;
|
|
; PTAG IEN of the parent element
|
|
;
|
|
; NODE Closed root of the node of the temporary global
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of non-fatal errors
|
|
;
|
|
PATIENTS(PTAG,NODE) ;
|
|
N DATE,ICD9,ICDIEN,ITEM,PATIEN,PTICDL,SOURCE,TABLE,TMP
|
|
S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PTAG)
|
|
Q:TABLE<0 TABLE
|
|
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
|
|
S PATIEN=0
|
|
F S PATIEN=$O(@NODE@("PAT",PATIEN)) Q:PATIEN'>0 D
|
|
. S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
|
|
. S TMP=@NODE@("PAT",PATIEN)
|
|
. D ADDVAL^RORTSK11(RORTSK,"NAME",$P(TMP,U,2),ITEM,2)
|
|
. D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(TMP,U,1),ITEM,2)
|
|
. D ADDVAL^RORTSK11(RORTSK,"DOD",$P(TMP,U,3),ITEM,1)
|
|
. S PTICDL=$$ADDVAL^RORTSK11(RORTSK,"PTICDL",,ITEM)
|
|
. S ICDIEN=0
|
|
. F S ICDIEN=$O(@NODE@("PAT",PATIEN,ICDIEN)) Q:ICDIEN'>0 D
|
|
. . S ICD9=$$ADDVAL^RORTSK11(RORTSK,"ICD9",,PTICDL)
|
|
. . S TMP=$G(@NODE@("PAT",PATIEN,ICDIEN))
|
|
. . S DATE=$P(TMP,U),SOURCE=$P(TMP,U,2)
|
|
. . S TMP=$$ICDDX^ICDCODE(ICDIEN,DATE)
|
|
. . S:TMP<0 TMP=""
|
|
. . D ADDVAL^RORTSK11(RORTSK,"CODE",$P(TMP,U,2),ICD9,2)
|
|
. . D ADDVAL^RORTSK11(RORTSK,"DIAG",$P(TMP,U,4),ICD9,2)
|
|
. . D ADDVAL^RORTSK11(RORTSK,"DATE",DATE\1,ICD9,1)
|
|
. . D ADDVAL^RORTSK11(RORTSK,"SOURCE",SOURCE,ICD9,2)
|
|
Q 0
|
|
;
|
|
;***** STORES THE REPORT DATA
|
|
;
|
|
; REPORT IEN of the REPORT element
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of non-fatal errors
|
|
;
|
|
STORE(REPORT) ;
|
|
N ECNT,ICDIEN,PATIEN,RC,SECTION,TMP
|
|
S (ECNT,RC)=0
|
|
;--- Diagnosis codes
|
|
S RC=$$CODES(REPORT,RORTMP)
|
|
I RC Q:RC<0 RC S ECNT=ECNT+RC
|
|
S RC=$$LOOP^RORTSK01(.4) Q:RC<0 RC
|
|
;--- Patients
|
|
S TMP=$$PARAM^RORTSK01("OPTIONS","COMPLETE")
|
|
I TMP D I RC Q:RC<0 RC S ECNT=ECNT+RC
|
|
. S RC=$$PATIENTS(REPORT,RORTMP)
|
|
S RC=$$LOOP^RORTSK01(.99) Q:RC<0 RC
|
|
;--- Totals
|
|
S SECTION=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
|
|
Q:SECTION<0 SECTION
|
|
S TMP=$G(@RORTMP@("ICD"))
|
|
D ADDVAL^RORTSK11(RORTSK,"NC",+$P(TMP,U,1),SECTION)
|
|
D ADDVAL^RORTSK11(RORTSK,"NDC",+$P(TMP,U,2),SECTION)
|
|
S TMP=$G(@RORTMP@("PAT"))
|
|
D ADDVAL^RORTSK11(RORTSK,"NP",+TMP,SECTION)
|
|
;---
|
|
Q ECNT
|