source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX007A.m@ 1068

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1RORX007A ;HCIOFO/BH,SG - RADIOLOGY UTILIZATION (OVERFLOW) ; 11/14/06 8:51am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #2043 EN1^RAO7PC1 (supported)
7 ;
8 Q
9 ;
10 ;***** APPENDS MODIFIERS TO THE CPT CODE
11 ;
12 ; CPT CPT code
13 ;
14 ; NODE Closed root of the exam data node returned
15 ; by the EN1^RAO7PC1
16 ;
17CPTMOD(CPT,NODE) ;
18 N CPM,RORIM
19 S RORIM=""
20 F S RORIM=$O(@NODE@("CMOD",RORIM)) Q:RORIM="" D
21 . S CPM=$P($G(@NODE@("CMOD",RORIM)),U)
22 . S:CPM'="" CPT=CPT_"-"_CPM
23 Q CPT
24 ;
25 ;***** LOADS AND PROCESSES THE RADILOGY DATA
26 ;
27 ; DFN Patient IEN (in file #2)
28 ;
29 ; Return Values:
30 ; <0 Error code
31 ; 0 Ok
32 ;
33GETDATA(DFN) ;
34 N CPT,EXAMID,NODE,PRNAME,RORBUF
35 ;--- Get the data
36 D EN1^RAO7PC1(DFN,RORSDT,ROREDT,999999)
37 Q:'$D(^TMP($J,"RAE1",PATIEN)) 0
38 ;
39 ;--- Process the data
40 S EXAMID=""
41 F S EXAMID=$O(^TMP($J,"RAE1",DFN,EXAMID)) Q:EXAMID="" D
42 . S NODE=$NA(^TMP($J,"RAE1",DFN,EXAMID))
43 . S RORBUF=$G(@NODE),CPT=$$CPTMOD($P(RORBUF,U,10),NODE)
44 . ;--- Get Procedure Name
45 . S PRNAME=$E($P(RORBUF,U),1,30) Q:PRNAME=""
46 . S PRNAME=PRNAME_U_$S(CPT'="":CPT,1:" ")
47 . ;--- Increment the counters
48 . S ^(DFN)=$G(^TMP("RORX007",$J,"PROC",PRNAME,DFN))+1
49 . S ^(PRNAME)=$G(^TMP("RORX007",$J,"PAT",DFN,PRNAME))+1
50 ;
51 ;--- Cleanup
52 K ^TMP($J,"RAE1")
53 Q 0
54 ;
55 ;***** OUTPUTS THE REPORT HEADER
56 ;
57 ; PARTAG Reference (IEN) to the parent tag
58 ;
59 ; Return Values:
60 ; <0 Error code
61 ; 0 Ok
62 ;
63HEADER(PARTAG) ;
64 ;;PATIENTS(#,NAME,LAST4,DOD,TOTAL,UNIQUE)
65 ;;PROCEDURES(#,NAME,CPT,PATIENTS,TOTAL)
66 ;
67 N HEADER,RC
68 S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
69 Q:HEADER<0 HEADER
70 S RC=$$TBLDEF^RORXU002("HEADER^RORX007A",HEADER)
71 Q $S(RC<0:RC,1:HEADER)
72 ;
73 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
74 ;
75 ; PARTAG Reference (IEN) to the parent tag
76 ;
77 ; [.STDT] Start and end dates of the report
78 ; [.ENDT] are returned via these parameters
79 ;
80 ; [.FLAGS] Flags for the $$SKIP^RORXU005 are
81 ; returned via this parameter
82 ;
83 ; Return Values:
84 ; <0 Error code
85 ; >0 IEN of the PARAMETERS element
86 ;
87PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
88 N NAME,PARAMS,TMP
89 S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
90 Q:PARAMS<0 PARAMS
91 ;--- Additional parameters
92 F NAME="MAXUTNUM","MINRPNUM" D
93 . S TMP=$$PARAM^RORTSK01(NAME)
94 . D:TMP'="" ADDVAL^RORTSK11(RORTSK,NAME,TMP,PARAMS)
95 ;---
96 Q PARAMS
97 ;
98 ;***** QUERIES THE REGISTRY
99 ;
100 ; FLAGS Flags for the $$SKIP^RORXU005
101 ;
102 ; Return Values:
103 ; <0 Error code
104 ; 0 Ok
105 ; >0 Number of non-fatal errors
106 ;
107QUERY(FLAGS) ;
108 N CNT,ECNT,IEN,IENS,PATIEN,RC,RORMSG,TMP,XREFNODE
109 S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
110 S (CNT,ECNT,RC)=0
111 ;--- Browse through the registry records
112 S IEN=0
113 F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
114 . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
115 . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
116 . S IENS=IEN_",",CNT=CNT+1
117 . ;--- Check if the patient should be skipped
118 . Q:$$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
119 . ;
120 . ;--- Get the patient IEN (DFN)
121 . S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
122 . ;
123 . ;--- Get the radiology data
124 . S RC=$$GETDATA(PATIEN)
125 . I RC S ECNT=ECNT+1 Q:RC<0
126 ;---
127 Q $S(RC<0:RC,1:ECNT)
128 ;
129 ;***** PLURAL/SINGULAR
130SRPL(QNTY,WORD,SQ) ;
131 Q $S('$G(SQ):QNTY_" ",1:"")_$P(WORD,U,$S(QNTY=1:1,1:2))
Note: See TracBrowser for help on using the repository browser.