source: FOIAVistA/tag/r/CLINICAL_CASE_REGISTRIES-ROR/RORX014A.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1RORX014A ;HOIFO/BH,SG - REGISTRY MEDS REPORT (QUERY & SORT) ; 11/25/05 5:52pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** ADDS THE DRUG COMBINATION TO THE REPORT
7 ;
8 ; RXLST List of drug IEN's separated by commas
9 ; PATIEN Patient IEN in file #2 (DFN)
10 ;
11ADD(RXLST,PATIEN) ;
12 N RXCIEN,RXCNDX,TMP,VA,VADM,VAERR
13 S RXCNDX=$E(RXLST,1,100)
14 ;--- Search for the combination
15 S RXCIEN=""
16 F D Q:RXCIEN="" Q:^TMP("RORX014",$J,"RXC",RXCIEN,1)=RXLST
17 . S RXCIEN=$O(^TMP("RORX014",$J,"RXC","B",RXCNDX,RXCIEN))
18 ;--- Add new combination
19 D:RXCIEN'>0
20 . S RXCIEN=$O(^TMP("RORX014",$J,"RXC"," "),-1)+1
21 . S ^TMP("RORX014",$J,"RXC",RXCIEN,1)=RXLST
22 . S ^TMP("RORX014",$J,"RXC","B",RXCNDX,RXCIEN)=""
23 ;--- Add new patient
24 S ^("P")=$G(^TMP("RORX014",$J,"RXC",RXCIEN,"P"))+1
25 D VADEM^RORUTL05(PATIEN,1)
26 S TMP=VA("BID")_U_VADM(1)_U_$$DATE^RORXU002(VADM(6)\1)
27 S ^TMP("RORX014",$J,"RXC",RXCIEN,"P",PATIEN)=TMP
28 Q
29 ;
30 ;***** QUERIES THE REGISTRY
31 ;
32 ; FLAGS Flags for the $$SKIP^RORXU005
33 ;
34 ; Return Values:
35 ; <0 Error code
36 ; 0 Ok
37 ; >0 Number of non-fatal errors
38 ;
39QUERY(FLAGS) ;
40 N RORPTN ; Number of patients in the registry
41 N RORXDST ; Descriptor for pharmacy search API
42 ;
43 N CNT,DRGIEN,ECNT,NAME,PATIEN,RC,RORIEN,RXFLAGS,STR,TMP,XREFNODE
44 ;
45 S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
46 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
47 S (CNT,ECNT,RC)=0
48 ;
49 ;--- Prepare parameters for the pharmacy search API
50 S RORXDST=$NA(RORXDST("RORX014"))
51 S RORXDST("RORCB")="$$RXSCB^RORX014A"
52 S RORXDST("GENERIC")=$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
53 S RXFLAGS="E"
54 S:$$PARAM^RORTSK01("PATIENTS","INPATIENT") RXFLAGS=RXFLAGS_"IV"
55 S:$$PARAM^RORTSK01("PATIENTS","OUTPATIENT") RXFLAGS=RXFLAGS_"O"
56 Q:RXFLAGS="E" 0
57 ;
58 ;--- Browse through the registry records
59 S RORIEN=0
60 F S RORIEN=$O(@XREFNODE@(RORIEN)) Q:RORIEN'>0 D Q:RC<0
61 . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
62 . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
63 . S CNT=CNT+1
64 . ;--- Check if the patient should be skipped
65 . Q:$$SKIP^RORXU005(RORIEN,FLAGS,RORSDT,ROREDT)
66 . ;
67 . ;--- Get the patient IEN (DFN)
68 . S PATIEN=$$PTIEN^RORUTL01(RORIEN) Q:PATIEN'>0
69 . ;
70 . ;--- Search for pharmacy data
71 . S TMP=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,RXFLAGS,RORSDT,ROREDT1)
72 . I TMP'>0 S:TMP<0 ECNT=ECNT+1 Q:$D(@RORXDST)<10
73 . ;
74 . S (NAME,STR)=""
75 . F S NAME=$O(@RORXDST@(NAME)) Q:NAME="" D
76 . . S DRGIEN=0
77 . . F S DRGIEN=$O(@RORXDST@(NAME,DRGIEN)) Q:DRGIEN'>0 D
78 . . . S ^TMP("RORX014",$J,"DRG",DRGIEN)=NAME
79 . . . S STR=STR_","_DRGIEN
80 . K @RORXDST
81 . ;
82 . D ADD($P(STR,",",2,999),PATIEN)
83 ;
84 ;---
85 Q $S(RC<0:RC,1:ECNT)
86 ;
87 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
88RXSCB(RORDST,ORDER,ORDFLG,DRUG,DATE) ;
89 N IEN,NAME
90 I ROR8DST("GENERIC") D
91 . S IEN=+ROR8DST("RORXGEN"),NAME=$P(ROR8DST("RORXGEN"),U,2)
92 E S IEN=+DRUG,NAME=$P(DRUG,U,2)
93 Q:(IEN'>0)!(NAME="") 1
94 S @RORDST@(NAME,IEN)=""
95 Q 0
96 ;
97 ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
98 ;
99 ; NRXC Number of drug combinations
100 ;
101 ; Return Values:
102 ; <0 Error code
103 ; 0 Ok
104 ; >0 Number of non-fatal errors
105 ;
106SORT(NRXC) ;
107 N IEN,TMP
108 S (IEN,NRXC)=0
109 F S IEN=$O(^TMP("RORX014",$J,"RXC",IEN)) Q:IEN'>0 D
110 . S TMP=^TMP("RORX014",$J,"RXC",IEN,"P")
111 . S ^TMP("RORX014",$J,"RXC","P",TMP,IEN)="",NRXC=NRXC+1
112 Q 0
113 ;
114 ;***** STORES THE REPORT DATA
115 ;
116 ; REPORT IEN of the REPORT element
117 ; NRXC Number of drug combinations
118 ;
119 ; Return Values:
120 ; <0 Error code
121 ; 0 Ok
122 ; >0 Number of non-fatal errors
123 ;
124STORE(REPORT,NRXC) ;
125 N BUF,CNT,DRG,ITEM,NODE,PATIEN,RORI,RXCIEN,RXCNT,RXCOMB,SECTION,TABLE,VA,VADM,VAERR
126 S NODE=$NA(^TMP("RORX014",$J))
127 S SECTION=$$ADDVAL^RORTSK11(RORTSK,"RXCOMBLST",,REPORT)
128 Q:SECTION<0 SECTION
129 D ADDATTR^RORTSK11(RORTSK,SECTION,"TABLE","RXCOMBLST")
130 ;---
131 Q:NRXC'>0 0
132 ;---
133 S RXCNT="",CNT=0
134 F S RXCNT=$O(@NODE@("RXC","P",RXCNT),-1) Q:RXCNT="" D
135 . S RC=$$LOOP^RORTSK01(CNT/NRXC),CNT=CNT+1 Q:RC<0
136 . S RXCIEN=""
137 . F S RXCIEN=$O(@NODE@("RXC","P",RXCNT,RXCIEN),-1) Q:RXCIEN="" D
138 . . S RXCOMB=$$ADDVAL^RORTSK11(RORTSK,"RXCOMB",,SECTION)
139 . . ;--- List of drugs
140 . . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,RXCOMB)
141 . . S BUF=@NODE@("RXC",RXCIEN,1)
142 . . F RORI=1:1 S DRG=$P(BUF,",",RORI) Q:DRG="" D
143 . . . S DRG=$P(^TMP("RORX014",$J,"DRG",DRG),U)
144 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",DRG,TABLE,1)
145 . . ;--- Number of unique patients
146 . . D ADDVAL^RORTSK11(RORTSK,"NP",RXCNT,RXCOMB,3)
147 . . ;--- List of patients
148 . . Q:'$$PARAM^RORTSK01("OPTIONS","COMPLETE")
149 . . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,RXCOMB)
150 . . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
151 . . S PATIEN=""
152 . . F S PATIEN=$O(@NODE@("RXC",RXCIEN,"P",PATIEN)) Q:PATIEN="" D
153 . . . S BUF=@NODE@("RXC",RXCIEN,"P",PATIEN)
154 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE,,PATIEN)
155 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(BUF,U,2),ITEM,1)
156 . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
157 . . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,3),ITEM,1)
158 Q 0
Note: See TracBrowser for help on using the repository browser.