source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX015C.m@ 635

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1RORX015C ;HCIOFO/SG - OUTPATIENT PROCEDURES (STORE) ; 6/27/06 10:54am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #1995 $$CPT^ICPTCOD (supported)
7 ; #3990 $$ICDOP^ICDCODE (supported)
8 ;
9 Q
10 ;
11 ;***** STORES THE PROCEDURE CODE TABLE
12 ;
13 ; PTAG IEN of the parent element
14 ;
15 ; NODE Closed root of the node of the temporary global
16 ;
17 ; Return Values:
18 ; <0 Error code
19 ; 0 Ok
20 ; >0 Number of non-fatal errors
21 ;
22CODES(PTAG,NODE) ;
23 N IEN,ITEM,NAME,SRC,TABLE,TMP
24 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PROCLST",,PTAG)
25 Q:TABLE<0 TABLE
26 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PROCLST")
27 S NAME=""
28 F S NAME=$O(@NODE@("PROC","B",NAME)) Q:NAME="" D
29 . S SRC=""
30 . F S SRC=$O(@NODE@("PROC","B",NAME,SRC)) Q:SRC="" D
31 . . S IEN=0
32 . . F S IEN=$O(@NODE@("PROC","B",NAME,SRC,IEN)) Q:IEN'>0 D
33 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURE",,TABLE)
34 . . . S TMP=@NODE@("PROC",SRC,IEN)
35 . . . D ADDVAL^RORTSK11(RORTSK,"PROCODE",$P(TMP,U,1),ITEM,2)
36 . . . D ADDVAL^RORTSK11(RORTSK,"PROCNAME",$P(TMP,U,2),ITEM,2)
37 . . . S TMP=$G(@NODE@("PROC",SRC,IEN,"P"))
38 . . . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
39 . . . S TMP=$G(@NODE@("PROC",SRC,IEN,"C"))
40 . . . D ADDVAL^RORTSK11(RORTSK,"NC",TMP,ITEM,3)
41 . . . D ADDVAL^RORTSK11(RORTSK,"SOURCE",SRC,ITEM,1)
42 Q 0
43 ;
44 ;***** STORES THE PATIENT TABLE
45 ;
46 ; PTAG IEN of the parent element
47 ;
48 ; NODE Closed root of the node of the temporary global
49 ;
50 ; Return Values:
51 ; <0 Error code
52 ; 0 Ok
53 ; >0 Number of non-fatal errors
54 ;
55PATIENTS(PTAG,NODE) ;
56 N DATE,DOD,IEN,ITEM,LAST4,PTIEN,PROCLST,PTCPTL,PTLST,PTNAME,SRC,TMP
57 S (PROCLST,PTLST)=-1
58 ;--- Table for patients with procedures
59 I RORPROC>0 D Q:PROCLST<0 PROCLST
60 . S PROCLST=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURES",,PTAG)
61 . D ADDATTR^RORTSK11(RORTSK,PROCLST,"TABLE","PROCEDURES")
62 . ;--- Force the privacy note
63 . D ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTAG)
64 ;--- Table for patients without procedures
65 I RORPROC<0 D Q:PTLST<0 PTLST
66 . S PTLST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PTAG)
67 . D ADDATTR^RORTSK11(RORTSK,PTLST,"TABLE","PATIENTS")
68 ;---
69 S PTIEN=0
70 F S PTIEN=$O(@NODE@("PAT",PTIEN)) Q:PTIEN'>0 D
71 . S TMP=@NODE@("PAT",PTIEN)
72 . S LAST4=$P(TMP,U),PTNAME=$P(TMP,U,2),DOD=$P(TMP,U,3)
73 . ;--- Patient list
74 . I RORPROC<0 D Q
75 . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLST,,PTIEN)
76 . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,2)
77 . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
78 . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
79 . ;--- Patients and procedures
80 . F SRC="I","O" D
81 . . S IEN=0
82 . . F S IEN=$O(@NODE@("PAT",PTIEN,SRC,IEN)) Q:IEN'>0 D
83 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURE",,PROCLST,,PTIEN)
84 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,2)
85 . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
86 . . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
87 . . . S TMP=$G(@NODE@("PAT",PTIEN,SRC,IEN))
88 . . . S DATE=$P(TMP,U)
89 . . . I SRC="O" D
90 . . . . S TMP=$$CPT^ICPTCOD(IEN,DATE) S:TMP<0 TMP=""
91 . . . . D ADDVAL^RORTSK11(RORTSK,"PROCODE",$P(TMP,U,2),ITEM,2)
92 . . . . D ADDVAL^RORTSK11(RORTSK,"PROCNAME",$P(TMP,U,3),ITEM,2)
93 . . . E D
94 . . . . S TMP=$$ICDOP^ICDCODE(IEN,DATE) S:TMP<0 TMP=""
95 . . . . D ADDVAL^RORTSK11(RORTSK,"PROCODE",$P(TMP,U,2),ITEM,2)
96 . . . . D ADDVAL^RORTSK11(RORTSK,"PROCNAME",$P(TMP,U,5),ITEM,2)
97 . . . D ADDVAL^RORTSK11(RORTSK,"DATE",$$DATE^RORXU002(DATE\1),ITEM,1)
98 . . . D ADDVAL^RORTSK11(RORTSK,"SOURCE",SRC,ITEM,1)
99 Q 0
100 ;
101 ;***** STORES THE REPORT DATA
102 ;
103 ; REPORT IEN of the REPORT element
104 ;
105 ; Return Values:
106 ; <0 Error code
107 ; 0 Ok
108 ; >0 Number of non-fatal errors
109 ;
110STORE(REPORT) ;
111 N ECNT,RC,SECTION,TMP
112 S (ECNT,RC)=0
113 ;--- Procedure codes
114 I RORPROC>0 D Q:RC<0 RC
115 . S RC=$$CODES(REPORT,RORTMP)
116 . I RC Q:RC<0 S ECNT=ECNT+RC
117 . S RC=$$LOOP^RORTSK01(.3)
118 ;--- Patients
119 S TMP=$$PARAM^RORTSK01("OPTIONS","COMPLETE")
120 I TMP D I RC Q:RC<0 RC S ECNT=ECNT+RC
121 . S RC=$$PATIENTS(REPORT,RORTMP)
122 S RC=$$LOOP^RORTSK01(.99) Q:RC<0 RC
123 ;--- Totals
124 S SECTION=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
125 Q:SECTION<0 SECTION
126 S TMP=$G(@RORTMP@("PROC"))
127 D ADDVAL^RORTSK11(RORTSK,"NC",+$P(TMP,U,1),SECTION)
128 D ADDVAL^RORTSK11(RORTSK,"NDC",+$P(TMP,U,2),SECTION)
129 S TMP=$G(@RORTMP@("PAT"))
130 D ADDVAL^RORTSK11(RORTSK,"NP",+TMP,SECTION)
131 ;---
132 Q ECNT
Note: See TracBrowser for help on using the repository browser.