source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX016A.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1RORX016A ;HCIOFO/BH,SG - OUTPATIENT UTILIZATION (QUERY) ; 1/23/06 2:11pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #557 Read access to the file #40.7 (controlled)
7 ; #2548 ACRP Interface Toolkit (supported)
8 ;
9 Q
10 ;
11 ;***** LOADS AND PROCESSES THE OUTPATIENT DATA
12 ;
13 ; RORDFN Patient IEN (in file #2)
14 ;
15 ; Return Values:
16 ; <0 Error code
17 ; 0 Ok
18 ; >0 Number of non-fatal errors
19 ;
20OPDATA(RORDFN) ;
21 N QUERY,RORDST,RORECNT
22 S RORDST=$NA(^TMP("RORX016",$J))
23 D OPEN^SDQ(.QUERY)
24 D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
25 D PAT^SDQ(.QUERY,RORDFN,"SET")
26 D DATE^SDQ(.QUERY,RORSDT,ROREDT1,"SET")
27 D SCANCB^SDQ(.QUERY,"D SCAN^RORX016A(Y,Y0)","SET")
28 D ACTIVE^SDQ(.QUERY,"TRUE","SET")
29 D SCAN^SDQ(.QUERY,"FORWARD")
30 D CLOSE^SDQ(.QUERY)
31 Q +$G(RORECNT)
32 ;
33 ;***** QUERIES THE REGISTRY
34 ;
35 ; FLAGS Flags for the $$SKIP^RORXU005
36 ;
37 ; Return Values:
38 ; <0 Error code
39 ; 0 Ok
40 ; >0 Number of non-fatal errors
41 ;
42QUERY(FLAGS) ;
43 N ROREDT1 ; Day after the end date
44 N RORLAST4 ; Last 4 digits of the current patient's SSN
45 N RORPNAME ; Name of the current patient
46 N RORPTN ; Number of patients in the registry
47 ;
48 N CNT,ECNT,IEN,IENS,PATIEN,RC,TMP,VA,VADM,XREFNODE
49 S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
50 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
51 S ROREDT1=$$FMADD^XLFDT(ROREDT,1)
52 S (CNT,ECNT,RC)=0
53 ;--- Browse through the registry records
54 S IEN=0
55 F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
56 . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
57 . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
58 . S IENS=IEN_",",CNT=CNT+1
59 . ;--- Check if the patient should be skipped
60 . Q:$$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
61 . ;
62 . ;--- Get the patient IEN (DFN)
63 . S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
64 . ;
65 . ;--- Get the patient's data
66 . D VADEM^RORUTL05(PATIEN,1)
67 . S RORPNAME=VADM(1),RORLAST4=VA("BID")
68 . ;
69 . ;--- Get the outpatient data
70 . S RC=$$OPDATA(PATIEN)
71 . I RC S ECNT=ECNT+1 Q:RC<0
72 . ;
73 . ;--- Calculate intermediate totals
74 . S RC=$$TOTALS^RORX016B(PATIEN)
75 . I RC S ECNT=ECNT+1 Q:RC<0
76 ;---
77 Q $S(RC<0:RC,1:ECNT)
78 ;
79 ;***** CALLBACK ENTRY POINT FOR ACRP API
80SCAN(Y,Y0) ;
81 N DTX,STOP,TMP
82 ;--- Check the division
83 S TMP=$$PARAM^RORTSK01("DIVISIONS","ALL")
84 I 'TMP Q:'$D(RORTSK("PARAMS","DIVISIONS","C",+$P(Y0,U,11)))
85 ;--- Data comes from the OUTPATIENT ENCOUNTER file (409.68)
86 S STOP=$P($G(^DIC(40.7,+$P(Y0,U,3),0)),U,2),DTX=Y0\1
87 S:STOP="" STOP="NSC"
88 S @RORDST@("OP",RORDFN,DTX)=$G(@RORDST@("OP",RORDFN,DTX))+1
89 S @RORDST@("OP",RORDFN,DTX,STOP)=$G(@RORDST@("OP",RORDFN,DTX,STOP))+1
90 Q
Note: See TracBrowser for help on using the repository browser.