source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX008A.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: 4.8 KB
Line 
1RORX008A ;HOIFO/BH,SG - VERA REIMBURSEMENT REPORT ; 10/6/05 1:00pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** QUERIES THE REGISTRY
7 ;
8 ; FLAGS Flags for the $$SKIP^RORXU005
9 ;
10 ; Return Values:
11 ; <0 Error code
12 ; 0 Ok
13 ; >0 Number of non-fatal errors
14 ;
15QUERY(FLAGS) ;
16 N RORPTN ; Number of patients in the registry
17 ;
18 N CLINAIDS,CMPXCARE,CNT,CNTARV,CNTBASIC,CNTCMPX,ECNT,IEN,NAME,PATIEN,RC,RORIEN,RORXDST,TMP,UTLCHK,VA,VADM,VAERR,XREFNODE
19 ;
20 S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
21 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
22 S (CNT,CNTARV,CNTBASIC,CNTCMPX,ECNT,RC)=0
23 S UTLCHK("ALL")=""
24 ;
25 ;--- Prepare parameters for the pharmacy search API
26 S RORXDST("RORCB")="$$RXSCB^RORX008A"
27 S TMP=$$PARAM^RORTSK01("OPTIONS","REGMEDSMRY")
28 S RORXDST("SINGLE")='TMP!'$$PARAM^RORTSK01("PATIENTS","COMPLEX")
29 ;
30 ;--- Browse through the registry records
31 S RORIEN=0
32 F S RORIEN=$O(@XREFNODE@(RORIEN)) Q:RORIEN'>0 D Q:RC<0
33 . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
34 . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
35 . S CNT=CNT+1
36 . ;--- Check if the patient should be skipped
37 . Q:$$SKIP^RORXU005(RORIEN,FLAGS,RORSDT,ROREDT)
38 . ;
39 . ;--- Get the patient IEN (DFN)
40 . S PATIEN=$$PTIEN^RORUTL01(RORIEN) Q:PATIEN'>0
41 . ;
42 . ;--- Skip Clinical AIDS if Complex Care was not requested
43 . S CMPXCARE=0
44 . S CLINAIDS=$S($$CLINAIDS^RORHIVUT(RORIEN,ROREDT):1,1:0)
45 . I CLINAIDS Q:'$$PARAM^RORTSK01("PATIENTS","COMPLEX") S CMPXCARE=1
46 . ;
47 . ;--- Skip a patient without utlilization
48 . Q:'$$UTIL^RORXU003(RORSDT,ROREDT,PATIEN,.UTLCHK)
49 . ;
50 . ;--- Search for pharmacy data
51 . K RORXDST("ARV")
52 . S TMP=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORSDT,ROREDT1)
53 . I TMP<0 S ECNT=ECNT+1 Q
54 . I $D(RORXDST("ARV")) Q:'$$PARAM^RORTSK01("PATIENTS","COMPLEX") D
55 . . S IEN=0
56 . . F S IEN=$O(RORXDST("ARV",IEN)) Q:IEN'>0 D
57 . . . D:'$D(^TMP("RORX008",$J,"DRG",IEN))
58 . . . . S ^TMP("RORX008",$J,"DRG",IEN)=RORXDST("ARV",IEN)
59 . . . S ^(CLINAIDS)=$G(^TMP("RORX008",$J,"DRG",IEN,CLINAIDS))+1
60 . . S CMPXCARE=1,CNTARV=CNTARV+1
61 . ;
62 . ;--- Skip Basic Care if it was not requested
63 . I CMPXCARE S CNTCMPX=CNTCMPX+1
64 . E Q:'$$PARAM^RORTSK01("PATIENTS","BASIC") S CNTBASIC=CNTBASIC+1
65 . ;
66 . D:$$PARAM^RORTSK01("OPTIONS","PTLIST")
67 . . D VADEM^RORUTL05(PATIEN,1)
68 . . S TMP=$$DATE^RORXU002(VADM(6)\1)
69 . . S TMP=TMP_U_($D(RORXDST("ARV"))>0)_U_CMPXCARE_U_CLINAIDS
70 . . S ^TMP("RORX008",$J,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_TMP
71 ;
72 ;--- Totals
73 S ^TMP("RORX008",$J,"PAT")=CNTBASIC_U_CNTCMPX_U_CNTARV
74 ;---
75 Q $S(RC<0:RC,1:ECNT)
76 ;
77 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
78RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
79 N CA,IEN,NAME
80 S IEN=+ROR8DST("RORXGEN"),NAME=$P(ROR8DST("RORXGEN"),U,2)
81 Q:(IEN'>0)!(NAME="") 1
82 ;---
83 S ROR8DST("ARV")="" Q:ROR8DST("SINGLE") 2
84 ;---
85 S ROR8DST("ARV",IEN)=NAME
86 Q 0
87 ;
88 ;***** STORES THE REPORT DATA
89 ;
90 ; REPORT IEN of the REPORT element
91 ;
92 ; Return Values:
93 ; <0 Error code
94 ; 0 Ok
95 ; >0 Number of non-fatal errors
96 ;
97STORE(REPORT) ;
98 N BUF,CNT,ITEM,IEN,NODE,NPAIDS,NPHIV,RC,TABLE,TMP
99 S NODE=$NA(^TMP("RORX008",$J)),RC=0
100 ;
101 ;--- List of ARV drugs
102 S TMP=$$PARAM^RORTSK01("OPTIONS","REGMEDSMRY")
103 I TMP,$$PARAM^RORTSK01("PATIENTS","COMPLEX") D Q:RC<0 RC
104 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,REPORT)
105 . I TABLE<0 S RC=TABLE Q
106 . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","DRUGS")
107 . S IEN=0
108 . F S IEN=$O(@NODE@("DRG",IEN)) Q:IEN'>0 D
109 . . S BUF=@NODE@("DRG",IEN)
110 . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,TABLE)
111 . . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(@NODE@("DRG",IEN),U),ITEM,1)
112 . . S NPHIV=+$G(@NODE@("DRG",IEN,0))
113 . . S NPAIDS=+$G(@NODE@("DRG",IEN,1))
114 . . D ADDVAL^RORTSK11(RORTSK,"NP",NPHIV+NPAIDS,ITEM,3)
115 . . D ADDVAL^RORTSK11(RORTSK,"NPHIV",NPHIV,ITEM,3)
116 . . D ADDVAL^RORTSK11(RORTSK,"NPAIDS",NPAIDS,ITEM,3)
117 ;
118 ;--- List of patients
119 I $$PARAM^RORTSK01("OPTIONS","PTLIST") D Q:RC<0 RC
120 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
121 . I TABLE<0 S RC=TABLE Q
122 . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
123 . S IEN=0
124 . F S IEN=$O(@NODE@("PAT",IEN)) Q:IEN'>0 D
125 . . S BUF=@NODE@("PAT",IEN)
126 . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE,,IEN)
127 . . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(BUF,U,2),ITEM,1)
128 . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
129 . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,3),ITEM,1)
130 . . D ADDVAL^RORTSK11(RORTSK,"AIDSTAT",+$P(BUF,U,6),ITEM,1)
131 . . D ADDVAL^RORTSK11(RORTSK,"ARV",+$P(BUF,U,4),ITEM,1)
132 . . D ADDVAL^RORTSK11(RORTSK,"COMPLEX",+$P(BUF,U,5),ITEM,1)
133 ;
134 ;--- Summary
135 S BUF=@NODE@("PAT")
136 S ITEM=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
137 D ADDVAL^RORTSK11(RORTSK,"NP",$P(BUF,U)+$P(BUF,U,2),ITEM)
138 D ADDVAL^RORTSK11(RORTSK,"NPBASIC",+$P(BUF,U,1),ITEM)
139 D ADDVAL^RORTSK11(RORTSK,"NPCOMPLEX",+$P(BUF,U,2),ITEM)
140 D ADDVAL^RORTSK11(RORTSK,"NPARV",+$P(BUF,U,3),ITEM)
141 Q 0
Note: See TracBrowser for help on using the repository browser.