source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX013C.m@ 1389

Last change on this file since 1389 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1RORX013C ;HCIOFO/SG - DIAGNOSIS CODES (STORE) ; 10/27/05 11:11am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #3990 $$ICDDX^ICDCODE (supported)
7 ;
8 Q
9 ;
10 ;***** STORES THE ICD-9 CODE TABLE
11 ;
12 ; PTAG IEN of the parent element
13 ;
14 ; NODE Closed root of the node of the temporary global
15 ;
16 ; Return Values:
17 ; <0 Error code
18 ; 0 Ok
19 ; >0 Number of non-fatal errors
20 ;
21CODES(PTAG,NODE) ;
22 N ICDIEN,ITEM,TABLE,TMP
23 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"ICD9LST",,PTAG)
24 Q:TABLE<0 TABLE
25 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","ICD9LST")
26 S ICDIEN=0
27 F S ICDIEN=$O(@NODE@("ICD",ICDIEN)) Q:ICDIEN'>0 D
28 . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ICD9",,TABLE)
29 . S TMP=@NODE@("ICD",ICDIEN)
30 . D ADDVAL^RORTSK11(RORTSK,"CODE",$P(TMP,U,1),ITEM,2)
31 . D ADDVAL^RORTSK11(RORTSK,"DIAG",$P(TMP,U,2),ITEM,2)
32 . S TMP=$G(@NODE@("ICD",ICDIEN,"P"))
33 . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
34 . S TMP=$G(@NODE@("ICD",ICDIEN,"C"))
35 . D ADDVAL^RORTSK11(RORTSK,"NC",TMP,ITEM,3)
36 Q 0
37 ;
38 ;***** STORES THE PATIENT TABLE
39 ;
40 ; PTAG IEN of the parent element
41 ;
42 ; NODE Closed root of the node of the temporary global
43 ;
44 ; Return Values:
45 ; <0 Error code
46 ; 0 Ok
47 ; >0 Number of non-fatal errors
48 ;
49PATIENTS(PTAG,NODE) ;
50 N DATE,ICD9,ICDIEN,ITEM,PATIEN,PTICDL,SOURCE,TABLE,TMP
51 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PTAG)
52 Q:TABLE<0 TABLE
53 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
54 S PATIEN=0
55 F S PATIEN=$O(@NODE@("PAT",PATIEN)) Q:PATIEN'>0 D
56 . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
57 . S TMP=@NODE@("PAT",PATIEN)
58 . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(TMP,U,2),ITEM,2)
59 . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(TMP,U,1),ITEM,2)
60 . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(TMP,U,3),ITEM,1)
61 . S PTICDL=$$ADDVAL^RORTSK11(RORTSK,"PTICDL",,ITEM)
62 . S ICDIEN=0
63 . F S ICDIEN=$O(@NODE@("PAT",PATIEN,ICDIEN)) Q:ICDIEN'>0 D
64 . . S ICD9=$$ADDVAL^RORTSK11(RORTSK,"ICD9",,PTICDL)
65 . . S TMP=$G(@NODE@("PAT",PATIEN,ICDIEN))
66 . . S DATE=$P(TMP,U),SOURCE=$P(TMP,U,2)
67 . . S TMP=$$ICDDX^ICDCODE(ICDIEN,DATE)
68 . . S:TMP<0 TMP=""
69 . . D ADDVAL^RORTSK11(RORTSK,"CODE",$P(TMP,U,2),ICD9,2)
70 . . D ADDVAL^RORTSK11(RORTSK,"DIAG",$P(TMP,U,4),ICD9,2)
71 . . D ADDVAL^RORTSK11(RORTSK,"DATE",DATE\1,ICD9,1)
72 . . D ADDVAL^RORTSK11(RORTSK,"SOURCE",SOURCE,ICD9,2)
73 Q 0
74 ;
75 ;***** STORES THE REPORT DATA
76 ;
77 ; REPORT IEN of the REPORT element
78 ;
79 ; Return Values:
80 ; <0 Error code
81 ; 0 Ok
82 ; >0 Number of non-fatal errors
83 ;
84STORE(REPORT) ;
85 N ECNT,ICDIEN,PATIEN,RC,SECTION,TMP
86 S (ECNT,RC)=0
87 ;--- Diagnosis codes
88 S RC=$$CODES(REPORT,RORTMP)
89 I RC Q:RC<0 RC S ECNT=ECNT+RC
90 S RC=$$LOOP^RORTSK01(.4) Q:RC<0 RC
91 ;--- Patients
92 S TMP=$$PARAM^RORTSK01("OPTIONS","COMPLETE")
93 I TMP D I RC Q:RC<0 RC S ECNT=ECNT+RC
94 . S RC=$$PATIENTS(REPORT,RORTMP)
95 S RC=$$LOOP^RORTSK01(.99) Q:RC<0 RC
96 ;--- Totals
97 S SECTION=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
98 Q:SECTION<0 SECTION
99 S TMP=$G(@RORTMP@("ICD"))
100 D ADDVAL^RORTSK11(RORTSK,"NC",+$P(TMP,U,1),SECTION)
101 D ADDVAL^RORTSK11(RORTSK,"NDC",+$P(TMP,U,2),SECTION)
102 S TMP=$G(@RORTMP@("PAT"))
103 D ADDVAL^RORTSK11(RORTSK,"NP",+TMP,SECTION)
104 ;---
105 Q ECNT
Note: See TracBrowser for help on using the repository browser.