- Timestamp:
- Aug 19, 2011, 12:49:48 PM (13 years ago)
- Location:
- qrda/C0Q/trunk/p
- Files:
-
- 8 added
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
qrda/C0Q/trunk/p/C0QMAIN.m
r1222 r1223 1 C0QMAIN 2 ;;0.1;C0Q;nopatch;noreleasedate; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 C0QQFN() 23 C0QMFN() 24 C0QMMFN() 25 C0QMMNFN() 26 C0QMMDFN() 27 RLSTFN() 28 RLSTPFN() 29 1 C0QMAIN ; GPL - Quality Reporting Main Processing ;10/13/10 17:05 2 ;;0.1;C0Q;nopatch;noreleasedate;Build 13 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 5 ; 6 ;This program is free software; you can redistribute it and/or modify 7 ;it under the terms of the GNU General Public License as published by 8 ;the Free Software Foundation; either version 2 of the License, or 9 ;(at your option) any later version. 10 ; 11 ;This program is distributed in the hope that it will be useful, 12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ;GNU General Public License for more details. 15 ; 16 ;You should have received a copy of the GNU General Public License along 17 ;with this program; if not, write to the Free Software Foundation, Inc., 18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 Q 21 ; 22 C0QQFN() Q 1130580001.101 ; FILE NUMBER FOR C0Q QUALITY MEASURE FILE 23 C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE 24 C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE 25 C0QMMNFN() Q 1130580001.20111 ; FN FOR NUMERATOR SUBFILE 26 C0QMMDFN() Q 1130580001.20112 ; FN FOR DENOMINATOR SUBFILE 27 RLSTFN() Q 810.5 ; FN FOR REMINDER PATIENT LIST FILE 28 RLSTPFN() Q 810.53 ; FN FOR REMINDER PATIENT LIST PATIENT SUBFILE 29 C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ; 30 30 EXPORT ; EXPORT ENTRY POINT FOR CCR 31 31 ; Select a patient. … … 48 48 Q 49 49 ; 50 NBYP ; ENTRY POINT FOR COMMAND LINE BY PATIENT MEASURE LISTING 51 ; 52 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC 53 I Y<1 Q ; EXIT 54 N MSIEN S MSIEN=+Y 55 W !,"NUMERATOR PATIENT LIST",! 56 N C0QPAT 57 D PATS(.C0QPAT,MSIEN,"N") ; GET THE NUMERATOR PATIENT LIST 58 I $D(C0QPAT) D ; LIST RETURNED 59 . ; 60 Q 61 ; 62 DBYP ; ENTRY POINT FOR COMMAND LINE BY PATIENT MEASURE LISTING 63 ; 64 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC 65 I Y<1 Q ; EXIT 66 N MSIEN S MSIEN=+Y 67 N C0QPAT 68 W !,"DENOMINATOR PATIENT LIST",! 69 D PATS(.C0QPAT,MSIEN,"D") ; GET THE NUMERATOR PATIENT LIST 70 I $D(C0QPAT) D ; LIST RETURNED 71 . ; 72 . ; 73 Q 74 ; 75 ENEXP ; EXTERNAL MENU ENTRY POINT FOR EXP 76 ; 77 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC 78 I Y<1 Q ; EXIT 79 N MSIEN S MSIEN=+Y 80 D EXP(MSIEN) 81 Q 82 ; 83 EXP(MSET,NOEX) ; EXPORT ALL PATIENTS FOR MEASURE SET IEN MSET 84 ; ALSO, WRITE OUT THE BY PATIENT MEASURE TEXT FILE 85 ; IF NOEX=1, THEN ONLY THE MEASURE TEXT FILE GETS WRITTEN, NO EXPORTS ARE 86 ; DONE 87 I '$D(NOEX) S NOEX=0 88 N ZQI,ZARY,ZFN,ODIR 89 S ZQI="" 90 D PATS(.ZARY,MSET,"D",1) 91 S ZFN="MEASURES-BY-PATIENT.txt" 92 S ODIR=^TMP("C0CCCR","ODIR") ; OUTPUT DIRECTORY 93 S GARY=$NA(^TMP("C0Q",$J)) 94 K @GARY 95 M @GARY=ZARY 96 S GARY1=$NA(@GARY@(1)) 97 N ZY 98 S ZY=$$OUTPUT^C0CXPATH(GARY1,ZFN,ODIR) 99 W !,ZY 100 I NOEX=1 Q ; DO NOT EXPORT 101 F S ZQI=$O(ZARY(ZQI)) Q:ZQI="" D ; FOR EACH PATIENT 102 . D XPAT^C0CCCR(+ZARY(ZQI)) ; 103 Q 104 ; 105 PATS(ZRTN,MSIEN,NORD,QT) ; BUILDS A LIST OF PATIENTS AND THEIR MEASURES 106 ; FOR MEASURE SET MSET. NORD="N" (DEFAULT) MEANS NUMERATOR PATIENTS 107 ; NORD="D" MEANS DENOMINATOR PATIENTS 108 ; QT=1 MEANS QUIET 109 I $G(QT)'=1 S QT=0 110 N ZI,ZJ,ZK,ZIDX,ZN,ZM 111 S ZN=0 ; COUNT OF PATIENTS 112 S ZI="" 113 ; GOING TO USE THE NUMERATOR BY PATIENT INDEX 114 I '$D(NORD) S NORD="N" 115 I '((NORD="N")!(NORD="D")) S NORD="N" 116 I NORD="N" S ZIDX=$NA(^C0Q(201,"ANBYP")) 117 E S ZIDX=$NA(^C0Q(201,"ADBYP")) 118 F S ZI=$O(@ZIDX@(ZI)) Q:ZI="" D ; FOR EACH PATIENT 119 . I $O(@ZIDX@(ZI,MSIEN,""))'="" D ; IF PATIENT IS IN THIS SET 120 . . I 'QT W !,$$GET1^DIQ(2,ZI_",",.01) ;PATIENT NAME 121 . . S ZN=ZN+1 ; INCREMENT PATIENT COUNT 122 . . S ZRTN(ZN)=ZI 123 . E Q ; NEXT PATIENT 124 . S (ZJ,ZK)="" 125 . F S ZJ=$O(@ZIDX@(ZI,MSIEN,ZJ)) Q:ZJ="" D ; FOR EACH MEASURE 126 . . ;S ZL=$O(@ZIDX@(ZI,MSIEN,ZJ,"")) ; MEASURE IS FOURTH 127 . . S ZK="" 128 . . S ZK=$$GET1^DIQ($$C0QMMFN,ZJ_","_MSIEN_",",.01,"I") 129 . . ;W !,"ZK:",ZK," ZJ:",ZJ," ZI",ZI,! 130 . . S ZM=$$GET1^DIQ($$C0QQFN,ZK_",",.01) ; MEASURE NAME 131 . . I 'QT W " ",ZM 132 . . S ZRTN(ZN)=ZRTN(ZN)_" "_ZM 133 Q 134 ; 135 EN ; ENTRY POINT FOR COMMAND LINE AND MENU ACCESS TO C0QRPC 136 ; 137 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC 138 I Y<1 Q ; EXIT 139 N MSIEN S MSIEN=+Y 140 D C0QRPC(.G,MSIEN) 141 Q 142 ; 143 EN2 ; SUMMARY ENTRY POINT FOR COMMAND LINE AND MENU ACCESS TO C0QRPC 144 ; 145 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC 146 I Y<1 Q ; EXIT 147 N MSIEN S MSIEN=+Y 148 S C0QSUM=1 149 D C0QRPC(.G,MSIEN) 150 Q 151 ; 152 C0QRPC(RTN,MSET,FMT,NOPURGE) ; RPC FORMAT 153 ; MSET IS THE NAME OR IEN OF THE MEASURE SET 154 ; RTN IS THE RETURN ARRAY OF THE RESULTS PASSED BY REFERENCE 155 ; FMT IS THE FORMAT OF THE OUTPUT - "ARRAY" OR "HTML" OR "XML" 156 ; NOTE: ARRAY IS DEFAULT AND THE OTHERS ARE NOT IMPLEMENTED YET 157 ; IF NOPURGE IS 1, PATIENT LISTS WILL NOT BE DELETED BEFORE ADDING 158 ; IF NOPURGE IS 0 OR OMITTED, PATIENT LISTS WILL BE DELETED THEN ADDED 159 W !,"LOOKING FOR MEASURE SET ",MSET,! 160 N ZI S ZI="" 161 N C0QM ; FOR HOLDING THE MEASURES IN THE SET 162 D LIST^DIC($$C0QMMFN,","_MSET_",",".01I") ; GET ALL THE MEASURES 163 D DELIST("C0QM") 164 N ZII S ZII="" 165 F S ZII=$O(C0QM(ZII)) Q:ZII="" D ; FOR EACH MEASURE 166 . D CLEARMEA(MSET,ZII) ; FIRST CLEAR OUT THE MEASURE 167 K C0QM 168 D CLEAN^DILF 169 D LIST^DIC($$C0QMMFN,","_MSET_",",".01I") ; GET ALL THE MEASURES AGAIN 170 D DELIST("C0QM") 171 F S ZII=$O(C0QM(ZII)) Q:ZII="" D ; FOR EACH MEASURE 172 . S ZI=$P(C0QM(ZII),U,1) ; IEN OF THE MEASURE IN THE C0Q QUALITY MEAS FILE 173 . ;W $$GET1^DIQ($$C0QQFN,ZI_",","DISPLAY NAME"),! 174 . ;N C0QNL,C0QDL ;NUMERATOR AND DENOMINATOR LIST POINTERS 175 . W !,"MEASURE: ",$$GET1^DIQ($$C0QQFN,ZI_",",.01),! ; PRINT THE MEASURE NAME 176 . ; FOLLOW THE POINTERS TO THE C0Q QUALITYM MEASURE FILE AND GET LIST PTRS 177 . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1,"I") ; NUMERATOR POINTER 178 . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2,"I") ; DENOMINATOR POINTER 179 . ; NOW FOLLOW THE LIST POINTERS TO THE REMINDER PATIENT LIST FILE 180 . W "NUMERATOR: ",$$GET1^DIQ($$RLSTFN,C0QNL_",","NAME"),! 181 . ; FIRST PROCESS THE NUMERATOR 182 . K ^TMP("DILIST",$J) 183 . D LIST^DIC($$RLSTPFN,","_C0QNL_",",".01I") ; GET THE LIST OF PATIENTS 184 . ;D DELIST("G") ; 185 . ;I $D(G) ZWR G 186 . K C0QNUMP 187 . S NCNT=$O(^TMP("DILIST",$J,"ID",""),-1) ; NUMERATOR COUNT 188 . N ZJ S ZJ="" 189 . F S ZJ=$O(^TMP("DILIST",$J,"ID",ZJ)) Q:ZJ="" D ; 190 . . S ZDFN=^TMP("DILIST",$J,"ID",ZJ,.01) 191 . . S C0QNUMP("N",ZJ,ZDFN)="" 192 . I '$G(C0QSUM) ZWR ^TMP("DILIST",$J,1,*) ; LIST THE PATIENT NAMES 193 . D ADDPATS(MSET,ZII,"C0QNUMP") 194 . ; NEXT PROCESS THE DENOMINATOR 195 . W "DENOMINATOR: ",$$GET1^DIQ($$RLSTFN,C0QDL_",","NAME"),! 196 . K ^TMP("DILIST",$J) 197 . D LIST^DIC($$RLSTPFN,","_C0QDL_",",".01I") ; GET THE LIST OF PATIENTS 198 . ;D DELIST("G") 199 . ;I $D(G) ZWR G 200 . ;S ZJ="" 201 . S DCNT=$O(^TMP("DILIST",$J,"ID",""),-1) ; DENOMONIATOR COUNT 202 . K C0QDEMP 203 . F S ZJ=$O(^TMP("DILIST",$J,"ID",ZJ)) Q:ZJ="" D ; 204 . . S ZDFN=^TMP("DILIST",$J,"ID",ZJ,.01) 205 . . S C0QDEMP("D",ZJ,ZDFN)="" 206 . D ADDPATS(MSET,ZII,"C0QDEMP") 207 . I $G(C0QSUM)'=1 ZWR ^TMP("DILIST",$J,1,*) ; LIST THE PATIENT NAMES 208 . E D ; 209 . . W "NUM CNT: ",NCNT 210 . . W " DEN CNT: ",DCNT,! 211 Q 212 ; 213 CLEARMEA(MSET,MEAS) ; DELETE AND THEN RECREATE AS EMPTY THE 214 ; MEASURE MEAS IN MEASURE SET IEN MSET 215 ; 216 N C0QFDA,MFN,MEASURE 217 S MFN=$$C0QMMFN() ; FILE NUMBER FOR MEASURE SUBFILE 218 D CLEAN^DILF 219 S MEASURE=$$GET1^DIQ(MFN,MEAS_","_MSET_",",.01,"I") ; MEASURE POINTER 220 D CLEAN^DILF 221 K ZERR 222 S C0QFDA(MFN,MEAS_","_MSET_",",.01)="@" ; GET READY TO DELETE THE MEASURE 223 D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE 224 I $D(ZERR) D ; 225 . W "ERROR",! 226 . ZWR ZERR 227 . B 228 K C0QFDA 229 S C0QFDA(MFN,"+1,"_MSET_",",.01)=MEASURE ; GET READY TO RECREATE THE SUBFILE 230 D UPDIE ; CREATE THE SUBFILE 231 Q 232 ; 233 ADDPATS(MSET,MEAS,PATS) ;ADD PATIENTS TO NUMERATOR AND DENOMINATOR 234 ; OF MEASURE SET IEN MSET MEASURE IEN MEAS 235 ; PATS IS OF THE FORM @PATS@("N",X,DFN)="" AND @PATS@("D",X,DFN)="" 236 ; WHERE N IS FOR NUMERATOR AND D IS FOR DENOMINATOR AND X 1..N 237 ; IF PATIENTS ARE ALREADY THERE, THEY WILL NOT BE ADDED AGAIN 238 N C0QI,C0QJ 239 N C0QFDA 240 S C0QI="" 241 F S C0QI=$O(@PATS@("N",C0QI)) Q:C0QI="" D ; FOR EACH NUMERATOR PATIENT 242 . S C0QFDA($$C0QMMNFN,"?+"_C0QI_","_MEAS_","_MSET_",",.01)=$O(@PATS@("N",C0QI,"")) 243 ;W "ADDING NUMERATOR",! 244 ;I $D(C0QFDA) ZWR C0QFDA 245 I $D(C0QFDA) D UPDIE 246 K C0QFDA 247 S C0QI="" 248 F S C0QI=$O(@PATS@("D",C0QI)) Q:C0QI="" D ; FOR EACH NUMERATOR PATIENT 249 . S C0QFDA($$C0QMMDFN,"?+"_C0QI_","_MEAS_","_MSET_",",.01)=$O(@PATS@("D",C0QI,"")) 250 ;W "ADDING DENOMINATOR",! 251 ;I $D(C0QFDA) ZWR C0QFDA 252 I $D(C0QFDA) D UPDIE 253 Q 254 ; 255 DELIST(RTN) ; DECODES ^TMP("DILIST",$J) INTO 256 ; @RTN@(IEN)=INTERNAL VALUE^EXTERNAL VALUE 257 N ZI,IV,EV,ZDI,ZIEN 258 S ZI="" 259 S ZDI=$NA(^TMP("DILIST",$J)) 260 K @RTN 261 F S ZI=$O(@ZDI@(1,ZI)) Q:ZI="" D ; 262 . S EV=@ZDI@(1,ZI) ;EXTERNAL VALUE 263 . S IV=$G(@ZDI@("ID",ZI,.01)) ; INTERNAL VALUE 264 . S ZIEN=@ZDI@(2,ZI) ; IEN 265 . S @RTN@(ZIEN)=IV_"^"_EV 266 Q 267 ; 268 DELPATS(MSET,MEAS,NDEL) ; DELETE PATIENTS FROM NUMERATOR AND DENOMINATOR 269 ; FOR A MEASURE (ONLY AFFECTS THE C0Q MEASURES FILE) 270 ; MSET IS THE IEN OF THE MEASURE SET 271 ; MEAS IS THE IEN OF THE MEASURE 272 ; NDEL IS A LIST OF PATIENTS TO NOT DELETE (NOT IMPLEMENTED YET) 273 ; IN THE FORM @NDEL@("N",IEN,DFN)="" FOR NUMERATOR PATIENTS 274 ; AND @NDEL@("D",IEN,DFN)="" FOR DENOMINATOR PATIENTS WHERE IEN IS 275 ; THE IEN OF THE PATIENT RECORD IN THE SUBFILE 276 ; THIS FEATURE WILL ALLOW EFFICIENCIES FOR LONG PATIENT LISTS 277 ; IN THAT PATIENTS THAT ARE GOING TO BE ADDED ARE NOT FIRST DELETED 278 N C0QI,C0QJ 279 D LIST^DIC($$C0QMMFN,","_MSET_",") 280 K C0QFDA 281 ZWR ^TMP("DILIST",$J,*) 282 ZWR ^TMP("DIERR",$J,*) 283 D 284 Q 285 ; 50 NBYP ; ENTRY POINT FOR COMMAND LINE BY PATIENT MEASURE LISTING 51 ; 52 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC 53 I Y<1 Q ; EXIT 54 N MSIEN S MSIEN=+Y 55 W !,"NUMERATOR PATIENT LIST",! 56 N C0QPAT 57 D PATS(.C0QPAT,MSIEN,"N") ; GET THE NUMERATOR PATIENT LIST 58 I $D(C0QPAT) D ; LIST RETURNED 59 . ; 60 Q 61 ; 62 DBYP ; ENTRY POINT FOR COMMAND LINE BY PATIENT MEASURE LISTING 63 ; 64 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC 65 I Y<1 Q ; EXIT 66 N MSIEN S MSIEN=+Y 67 N C0QPAT 68 W !,"DENOMINATOR PATIENT LIST",! 69 D PATS(.C0QPAT,MSIEN,"D") ; GET THE NUMERATOR PATIENT LIST 70 I $D(C0QPAT) D ; LIST RETURNED 71 . ; 72 . ; 73 Q 74 ; 75 ENEXP ; EXTERNAL MENU ENTRY POINT FOR EXP 76 ; 77 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC 78 I Y<1 Q ; EXIT 79 N MSIEN S MSIEN=+Y 80 D EXP(MSIEN) 81 Q 82 ; 83 EXP(MSET,NOEX) ; EXPORT ALL PATIENTS FOR MEASURE SET IEN MSET 84 ; ALSO, WRITE OUT THE BY PATIENT MEASURE TEXT FILE 85 ; IF NOEX=1, THEN ONLY THE MEASURE TEXT FILE GETS WRITTEN, NO EXPORTS ARE 86 ; DONE 87 I '$D(NOEX) S NOEX=0 88 N ZQI,ZARY,ZFN,ODIR 89 S ZQI="" 90 D PATS(.ZARY,MSET,"D",1) 91 S ZFN="MEASURES-BY-PATIENT.txt" 92 S ODIR=^TMP("C0CCCR","ODIR") ; OUTPUT DIRECTORY 93 S GARY=$NA(^TMP("C0Q",$J)) 94 K @GARY 95 M @GARY=ZARY 96 S GARY1=$NA(@GARY@(1)) 97 N ZY 98 S ZY=$$OUTPUT^C0CXPATH(GARY1,ZFN,ODIR) 99 W !,ZY 100 I NOEX=1 Q ; DO NOT EXPORT 101 F S ZQI=$O(ZARY(ZQI)) Q:ZQI="" D ; FOR EACH PATIENT 102 . D XPAT^C0CCCR(+ZARY(ZQI)) ; 103 Q 104 ; 105 PATS(ZRTN,MSIEN,NORD,QT) ; BUILDS A LIST OF PATIENTS AND THEIR MEASURES 106 ; FOR MEASURE SET MSET. NORD="N" (DEFAULT) MEANS NUMERATOR PATIENTS 107 ; NORD="D" MEANS DENOMINATOR PATIENTS 108 ; QT=1 MEANS QUIET 109 I $G(QT)'=1 S QT=0 110 N ZI,ZJ,ZK,ZIDX,ZN,ZM 111 S ZN=0 ; COUNT OF PATIENTS 112 S ZI="" 113 ; GOING TO USE THE NUMERATOR BY PATIENT INDEX 114 I '$D(NORD) S NORD="N" 115 I '((NORD="N")!(NORD="D")) S NORD="N" 116 I NORD="N" S ZIDX=$NA(^C0Q(201,"ANBYP")) 117 E S ZIDX=$NA(^C0Q(201,"ADBYP")) 118 F S ZI=$O(@ZIDX@(ZI)) Q:ZI="" D ; FOR EACH PATIENT 119 . I $O(@ZIDX@(ZI,MSIEN,""))'="" D ; IF PATIENT IS IN THIS SET 120 . . I 'QT W !,$$GET1^DIQ(2,ZI_",",.01) ;PATIENT NAME 121 . . S ZN=ZN+1 ; INCREMENT PATIENT COUNT 122 . . S ZRTN(ZN)=ZI 123 . E Q ; NEXT PATIENT 124 . S (ZJ,ZK)="" 125 . F S ZJ=$O(@ZIDX@(ZI,MSIEN,ZJ)) Q:ZJ="" D ; FOR EACH MEASURE 126 . . ;S ZL=$O(@ZIDX@(ZI,MSIEN,ZJ,"")) ; MEASURE IS FOURTH 127 . . S ZK="" 128 . . S ZK=$$GET1^DIQ($$C0QMMFN,ZJ_","_MSIEN_",",.01,"I") 129 . . ;W !,"ZK:",ZK," ZJ:",ZJ," ZI",ZI,! 130 . . S ZM=$$GET1^DIQ($$C0QQFN,ZK_",",.01) ; MEASURE NAME 131 . . I 'QT W " ",ZM 132 . . S ZRTN(ZN)=ZRTN(ZN)_" "_ZM 133 Q 134 ; 135 EN ; ENTRY POINT FOR COMMAND LINE AND MENU ACCESS TO C0QRPC 136 ; 137 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC 138 I Y<1 Q ; EXIT 139 N MSIEN S MSIEN=+Y 140 D C0QRPC(.G,MSIEN) 141 Q 142 ; 143 EN2 ; SUMMARY ENTRY POINT FOR COMMAND LINE AND MENU ACCESS TO C0QRPC 144 ; 145 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC 146 I Y<1 Q ; EXIT 147 N MSIEN S MSIEN=+Y 148 S C0QSUM=1 149 D C0QRPC(.G,MSIEN) 150 ; iterate over the measures 151 S MEASURE=0 152 F S MEASURE=$O(^C0Q(201,MSIEN,5,MEASURE)) Q:MEASURE'>0 D 153 . S NUMER=0,DENOM=0 154 . ; now count the numerator patients 155 . S P=0 F S P=$O(^C0Q(201,MSIEN,5,MEASURE,1,P)) Q:P'>0 S NUMER=NUMER+1 156 . S $P(^C0Q(201,MSIEN,5,MEASURE,2),U)=NUMER 157 . ; and count the denominator patients 158 . S P=0 F S P=$O(^C0Q(201,MSIEN,5,MEASURE,3,P)) Q:P'>0 S DENOM=DENOM+1 159 . Q:DENOM=0 160 . ; and stuff the values 161 . S $P(^C0Q(201,MSIEN,5,MEASURE,4),U,1,2)=DENOM_U_$J(100*NUMER/DENOM,0,0) 162 . Q 163 Q 164 ; 165 C0QRPC(RTN,MSET,FMT,NOPURGE) ; RPC FORMAT 166 ; MSET IS THE NAME OR IEN OF THE MEASURE SET 167 ; RTN IS THE RETURN ARRAY OF THE RESULTS PASSED BY REFERENCE 168 ; FMT IS THE FORMAT OF THE OUTPUT - "ARRAY" OR "HTML" OR "XML" 169 ; NOTE: ARRAY IS DEFAULT AND THE OTHERS ARE NOT IMPLEMENTED YET 170 ; IF NOPURGE IS 1, PATIENT LISTS WILL NOT BE DELETED BEFORE ADDING 171 ; IF NOPURGE IS 0 OR OMITTED, PATIENT LISTS WILL BE DELETED THEN ADDED 172 ;W !,"LOOKING FOR MEASURE SET ",MSET,! 173 N ZI S ZI="" 174 N C0QM ; FOR HOLDING THE MEASURES IN THE SET 175 D LIST^DIC($$C0QMMFN,","_MSET_",",".01I") ; GET ALL THE MEASURES 176 D DELIST("C0QM") 177 N ZII S ZII="" 178 F S ZII=$O(C0QM(ZII)) Q:ZII="" D ; FOR EACH MEASURE 179 . D CLEARMEA(MSET,ZII) ; FIRST CLEAR OUT THE MEASURE 180 K C0QM 181 D CLEAN^DILF 182 D LIST^DIC($$C0QMMFN,","_MSET_",",".01I") ; GET ALL THE MEASURES AGAIN 183 D DELIST("C0QM") 184 F S ZII=$O(C0QM(ZII)) Q:ZII="" D ; FOR EACH MEASURE 185 . S ZI=$P(C0QM(ZII),U,1) ; IEN OF THE MEASURE IN THE C0Q QUALITY MEAS FILE 186 . ;W $$GET1^DIQ($$C0QQFN,ZI_",","DISPLAY NAME"),! 187 . ;N C0QNL,C0QDL ;NUMERATOR AND DENOMINATOR LIST POINTERS 188 . ;W !,"MEASURE: ",$$GET1^DIQ($$C0QQFN,ZI_",",.01),! ; PRINT THE MEASURE NAME 189 . ; FOLLOW THE POINTERS TO THE C0Q QUALITYM MEASURE FILE AND GET LIST PTRS 190 . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1,"I") ; NUMERATOR POINTER 191 . I C0QNL="" D ; CHECK ALTERNATE LIST 192 . . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1.1,"I") ; NUMERATOR POINTER 193 . . I C0QNL'="" S C0QNALT=1 194 . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2,"I") ; DENOMINATOR POINTER 195 . I C0QDL="" D ; CHECK ALTERNATE LIST 196 . . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2.1,"I") ; DENOMINATOR POINTER 197 . . I C0QDL'="" S C0QDALT=1 198 . ; NOW FOLLOW THE LIST POINTERS TO THE REMINDER PATIENT LIST FILE 199 . ;W "NUMERATOR: ",$$GET1^DIQ($$RLSTFN,C0QNL_",","NAME"),! 200 . ; FIRST PROCESS THE NUMERATOR 201 . K ^TMP("DILIST",$J) 202 . N C0QUFN ; FILE NUMBER TO USE 203 . I $G(C0QNALT)=1 S C0QUFN=$$C0QALFN() 204 . E S C0QUFN=$$RLSTPFN 205 . D LIST^DIC(C0QUFN,","_C0QNL_",",".01I") ; GET THE LIST OF PATIENTS 206 . ;D DELIST("G") ; 207 . ;I $D(G) ZWR G 208 . K C0QNUMP 209 . S NCNT=$O(^TMP("DILIST",$J,"ID",""),-1) ; NUMERATOR COUNT 210 . N ZJ S ZJ="" 211 . F S ZJ=$O(^TMP("DILIST",$J,"ID",ZJ)) Q:ZJ="" D ; 212 . . S ZDFN=^TMP("DILIST",$J,"ID",ZJ,.01) 213 . . S C0QNUMP("N",ZJ,ZDFN)="" 214 . ;I '$G(C0QSUM) ZWR ^TMP("DILIST",$J,1,*) ; LIST THE PATIENT NAMES 215 . D ADDPATS(MSET,ZII,"C0QNUMP") 216 . ; NEXT PROCESS THE DENOMINATOR 217 . ;W "DENOMINATOR: ",$$GET1^DIQ($$RLSTFN,C0QDL_",","NAME"),! 218 . K ^TMP("DILIST",$J) 219 . I $G(C0QDALT)=1 S C0QUFN=$$C0QALFN() 220 . E S C0QUFN=$$RLSTPFN 221 . D LIST^DIC(C0QUFN,","_C0QDL_",",".01I") ; GET THE LIST OF PATIENTS 222 . ;D DELIST("G") 223 . ;I $D(G) ZWR G 224 . ;S ZJ="" 225 . S DCNT=$O(^TMP("DILIST",$J,"ID",""),-1) ; DENOMONIATOR COUNT 226 . K C0QDEMP 227 . F S ZJ=$O(^TMP("DILIST",$J,"ID",ZJ)) Q:ZJ="" D ; 228 . . S ZDFN=^TMP("DILIST",$J,"ID",ZJ,.01) 229 . . S C0QDEMP("D",ZJ,ZDFN)="" 230 . D ADDPATS(MSET,ZII,"C0QDEMP") 231 . ;I $G(C0QSUM)'=1 ZWR ^TMP("DILIST",$J,1,*) ; LIST THE PATIENT NAMES 232 . ;E D ; 233 . ;. W "NUM CNT: ",NCNT 234 . ;. W " DEN CNT: ",DCNT,! 235 Q 236 ; 237 CLEARMEA(MSET,MEAS) ; DELETE AND THEN RECREATE AS EMPTY THE 238 ; MEASURE MEAS IN MEASURE SET IEN MSET 239 ; 240 N C0QFDA,MFN,MEASURE 241 S MFN=$$C0QMMFN() ; FILE NUMBER FOR MEASURE SUBFILE 242 D CLEAN^DILF 243 S MEASURE=$$GET1^DIQ(MFN,MEAS_","_MSET_",",.01,"I") ; MEASURE POINTER 244 D CLEAN^DILF 245 K ZERR 246 S C0QFDA(MFN,MEAS_","_MSET_",",.01)="@" ; GET READY TO DELETE THE MEASURE 247 D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE 248 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED 249 ;. W "ERROR",! 250 ;. ZWR ZERR 251 ;. B 252 K C0QFDA 253 S C0QFDA(MFN,"+1,"_MSET_",",.01)=MEASURE ; GET READY TO RECREATE THE SUBFILE 254 D UPDIE ; CREATE THE SUBFILE 255 Q 256 ; 257 ADDPATS(MSET,MEAS,PATS) ;ADD PATIENTS TO NUMERATOR AND DENOMINATOR 258 ; OF MEASURE SET IEN MSET MEASURE IEN MEAS 259 ; PATS IS OF THE FORM @PATS@("N",X,DFN)="" AND @PATS@("D",X,DFN)="" 260 ; WHERE N IS FOR NUMERATOR AND D IS FOR DENOMINATOR AND X 1..N 261 ; IF PATIENTS ARE ALREADY THERE, THEY WILL NOT BE ADDED AGAIN 262 N C0QI,C0QJ 263 N C0QFDA 264 S C0QI="" 265 F S C0QI=$O(@PATS@("N",C0QI)) Q:C0QI="" D ; FOR EACH NUMERATOR PATIENT 266 . S C0QFDA($$C0QMMNFN,"?+"_C0QI_","_MEAS_","_MSET_",",.01)=$O(@PATS@("N",C0QI,"")) 267 ;W "ADDING NUMERATOR",! 268 ;I $D(C0QFDA) ZWR C0QFDA 269 I $D(C0QFDA) D UPDIE 270 K C0QFDA 271 S C0QI="" 272 F S C0QI=$O(@PATS@("D",C0QI)) Q:C0QI="" D ; FOR EACH NUMERATOR PATIENT 273 . S C0QFDA($$C0QMMDFN,"?+"_C0QI_","_MEAS_","_MSET_",",.01)=$O(@PATS@("D",C0QI,"")) 274 ;W "ADDING DENOMINATOR",! 275 ;I $D(C0QFDA) ZWR C0QFDA 276 I $D(C0QFDA) D UPDIE 277 Q 278 ; 279 DELIST(RTN) ; DECODES ^TMP("DILIST",$J) INTO 280 ; @RTN@(IEN)=INTERNAL VALUE^EXTERNAL VALUE 281 N ZI,IV,EV,ZDI,ZIEN 282 S ZI="" 283 S ZDI=$NA(^TMP("DILIST",$J)) 284 K @RTN 285 F S ZI=$O(@ZDI@(1,ZI)) Q:ZI="" D ; 286 . S EV=@ZDI@(1,ZI) ;EXTERNAL VALUE 287 . S IV=$G(@ZDI@("ID",ZI,.01)) ; INTERNAL VALUE 288 . S ZIEN=@ZDI@(2,ZI) ; IEN 289 . S @RTN@(ZIEN)=IV_"^"_EV 290 Q 291 ; 292 DELPATS(MSET,MEAS,NDEL) ; DELETE PATIENTS FROM NUMERATOR AND DENOMINATOR 293 ; FOR A MEASURE (ONLY AFFECTS THE C0Q MEASURES FILE) 294 ; MSET IS THE IEN OF THE MEASURE SET 295 ; MEAS IS THE IEN OF THE MEASURE 296 ; NDEL IS A LIST OF PATIENTS TO NOT DELETE (NOT IMPLEMENTED YET) 297 ; IN THE FORM @NDEL@("N",IEN,DFN)="" FOR NUMERATOR PATIENTS 298 ; AND @NDEL@("D",IEN,DFN)="" FOR DENOMINATOR PATIENTS WHERE IEN IS 299 ; THE IEN OF THE PATIENT RECORD IN THE SUBFILE 300 ; THIS FEATURE WILL ALLOW EFFICIENCIES FOR LONG PATIENT LISTS 301 ; IN THAT PATIENTS THAT ARE GOING TO BE ADDED ARE NOT FIRST DELETED 302 N C0QI,C0QJ 303 D LIST^DIC($$C0QMMFN,","_MSET_",") 304 K C0QFDA 305 ;ZWR ^TMP("DILIST",$J,*) 306 ;ZWR ^TMP("DIERR",$J,*) 307 ;D 308 Q 309 ; 286 310 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 287 K ZERR 288 D CLEAN^DILF 289 D UPDATE^DIE("","C0QFDA","","ZERR") 290 I $D(ZERR) D ; 291 . W "ERROR",! 292 . ZWR ZERR 293 . B 294 K C0QFDA 295 Q 296 ; 311 K ZERR 312 D CLEAN^DILF 313 D UPDATE^DIE("","C0QFDA","","ZERR") 314 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED 315 ;. W "ERROR",! 316 ;. ZWR ZERR 317 ;. B 318 K C0QFDA 319 Q 320 ; 321 QUE ;QUE THE RUN OF THE PATIENT LISTS AND THE BUILD THE LISTS OF THE PATIENTS 322 ;AND THEIR MEASURES 323 S MSIEN=$$GET^XPAR("DIV."_$P($$SITE^VASITE(),U,2),"C0Q MEASUREMENT TO USE") 324 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE 325 S ZTDESC="CREATE PATIENT LIST" 326 S ZTRTN="RUN^C0QMAIN" 327 S ZTSAVE("MSIEN")="" 328 S ZTIO="" 329 S ZTDTH=$$NOW^XLFDT 330 D ^%ZTLOAD 331 Q 332 ; 333 RUN ; DO THE REAL WORK 334 I '$D(MSIEN) S MSIEN=$$GET^XPAR("DIV."_$P($$SITE^VASITE(),U,2),"C0Q MEASUREMENT TO USE") 335 S BEG=$P(^C0Q(201,MSIEN,4),U,3) ;Begin date 336 S END=$P(^C0Q(201,MSIEN,4),U,4) ;End date 337 S PATCREAT="N" ;Secure list - N=No 338 S PLISTPUG="N" ;Purge list after 5 years - N=No 339 S PXRMDPAT=0 ;Include deceased patients - N=No 340 S PXRMTPAT=0 ;Include test patients - N=No 341 S PXRMNODE="PXRMRULE" ;Node in ^TMP($J,"PXRMRULE" 342 N ZI S ZI="" 343 F S ZI=$O(^C0Q(201,MSIEN,5,"B",ZI)) Q:ZI'>0 D ; LOOP THROUGH EACH QM 344 . S PXRMLSTN=+$P(^C0Q(101,ZI,0),U,2) ; NUMERATOR MEASURE 345 . S PXRMLSTD=+$P(^C0Q(101,ZI,0),U,3) ; DENOMINATOR MEASURE 346 . S PXRMRULN=+$P(^PXRMXP(810.5,PXRMLSTN,0),U,6) ; RULES FOR THE LIST 347 . S PXRMRULD=+$P(^PXRMXP(810.5,PXRMLSTD,0),U,6) 348 . D RUN^PXRMLCR(PXRMRULD,PXRMLSTD,PXRMNODE,BEG,END,PXRMDPAT,PXRMTPAT) 349 . D RUN^PXRMLCR(PXRMRULN,PXRMLSTN,PXRMNODE,BEG,END,PXRMDPAT,PXRMTPAT) 350 D C0QRPC(.G,MSIEN) 351 Q
Note:
See TracChangeset
for help on using the changeset viewer.