- Timestamp:
- Mar 17, 2009, 7:40:10 PM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 5 edited
-
CCRMEDS.m (modified) (6 diffs)
-
CCRMEDS1.m (modified) (3 diffs)
-
CCRMEDS2.m (modified) (3 diffs)
-
CCRMEDS3.m (modified) (3 diffs)
-
CCRMEDS6.m (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/CCRMEDS.m
r396 r412 1 1 CCRMEDS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08 14:33 2 2 ;;0.1;CCDCCR;;JUL 16,2008; 3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 3 ;Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 5 6 ; 6 7 ;This program is free software; you can redistribute it and/or modify … … 33 34 ; INPATIENT MEDS IN EXTRACT^CCRMEDS4 34 35 ; ALL OTHERS HERE 35 S MEDTVMAP=$NA(^TMP(" GPLCCR",$J,"MEDMAP"))36 S MEDTVMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 36 37 K @MEDTVMAP ; CLEAR VARIABLE ARRAY 37 38 S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED 38 S MEDTARYTMP=$NA(^TMP(" GPLCCR",$J,"MEDARYTMP"))39 S MEDTARYTMP=$NA(^TMP("C0CCCR",$J,"MEDARYTMP")) 39 40 K @MEDTARYTMP ; KILL XML ARRAY 40 41 I $G(DUZ("AG"))="I" D Q ; … … 54 55 . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML 55 56 . I @MEDOUTXML@(0)>0 D ; IF WE NEED TO COMBINE MEDS 56 . . D INSINNER^ GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE57 . E D CP^ GPLXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY57 . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE 58 . E D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY 58 59 . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP 59 60 . ; W MEDCNT,! … … 65 66 . ; S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML 66 67 . I @MEDOUTXML@(0)>0 D ; IF WE NEED TO COMBINE MEDS 67 . . D INSINNER^ GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD NON-VA TO MEDS68 . E D CP^ GPLXPATH(PENDINGXML,MEDOUTXML) ; NO PREVIOUS MEDS, JUST COPY68 . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD NON-VA TO MEDS 69 . E D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO PREVIOUS MEDS, JUST COPY 69 70 . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP 70 71 . ; W MEDCNT,! … … 81 82 . Q 82 83 ; I DEBUG ZWR MEDRSLT 83 M GPLMEDS=MEDRSLT84 S MEDTVMAP=$NA(^TMP(" GPLCCR",$J,"MEDMAP"))85 S MEDTARYTMP=$NA(^TMP(" GPLCCR",$J,"MEDARYTMP"))84 M C0CMEDS=MEDRSLT 85 S MEDTVMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 86 S MEDTARYTMP=$NA(^TMP("C0CCCR",$J,"MEDARYTMP")) 86 87 ; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE 87 88 ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS … … 188 189 . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI)) 189 190 . K @MEDARYTMP 190 . D MAP^ GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)191 . D MAP^C0CXPATH(MEDXML,MEDVMAP,MEDARYTMP) 191 192 . I ZI=1&('HASOP) D ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE 192 193 . . ; W "FIRST ONE",! 193 . . D CP^ GPLXPATH(MEDARYTMP,MEDOUTXML)194 . . D CP^C0CXPATH(MEDARYTMP,MEDOUTXML) 194 195 . E D ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML 195 . . D INSINNER^ GPLXPATH(MEDOUTXML,MEDARYTMP)196 . . D INSINNER^C0CXPATH(MEDOUTXML,MEDARYTMP) 196 197 N MEDTMP,MEDI 197 D MISSING^ GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS198 D MISSING^C0CXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 198 199 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 199 200 . W "MEDICATION MISSING ",! -
ccr/trunk/p/CCRMEDS1.m
r396 r412 36 36 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf 37 37 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). 38 ; D PARY^ GPLXPATH(MINXML)38 ; D PARY^C0CXPATH(MINXML) 39 39 N MEDS,MAP 40 40 K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!! … … 47 47 N RXIEN S RXIEN=0 48 48 N MEDCOUNT S MEDCOUNT=0 49 S MEDMAP=$NA(^TMP(" GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP49 S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP 50 50 S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY 51 51 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST 52 52 . S MEDCOUNT=MEDCOUNT+1 53 53 . I DEBUG W "RXIEN IS ",RXIEN,! 54 . S MAP=$NA(^TMP(" GPLCCR",$J,"MEDMAP",MEDCOUNT))54 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT)) 55 55 . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN CCRMEDS 56 56 . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY … … 204 204 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0)) 205 205 . S @MAP@("MEDRFNO")=MED(9) 206 . N RESULT S RESULT=$NA(^TMP(" GPLCCR",$J,"MAPPED"))206 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 207 207 . K @RESULT 208 . D MAP^ GPLXPATH(MINXML,MAP,RESULT)209 . ; D PARY^ GPLXPATH(RESULT)208 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 209 . ; D PARY^C0CXPATH(RESULT) 210 210 . ; MAPPING DIRECTIONS 211 211 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 212 212 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 213 . D QUERY^ GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)214 . D REPLACE^ GPLXPATH(RESULT,"","//Medications/Medication/Directions")213 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 214 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 215 215 . ; N MDZ1,MDZNA 216 216 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 217 217 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 218 218 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 219 . . . D MAP^ GPLXPATH(DIRXML1,MDZNA,DIRXML2)220 . . . D INSERT^ GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")221 . D:MEDCOUNT=1 CP^ GPLXPATH(RESULT,OUTXML) ; First one is a copy222 . D:MEDCOUNT>1 INSINNER^ GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML219 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 220 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 221 . D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 222 . D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 223 223 N MEDTMP,MEDI 224 D MISSING^ GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS224 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 225 225 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 226 226 . W "MEDICATION MISSING ",! -
ccr/trunk/p/CCRMEDS2.m
r396 r412 51 51 N MEDCOUNT S MEDCOUNT=0 52 52 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING 53 S MEDMAP=$NA(^TMP(" GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP53 S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP 54 54 S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY 55 55 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST … … 57 57 . S MEDCOUNT=MEDCOUNT+1 58 58 . I DEBUG W "RXIEN IS ",RXIEN,! 59 . S MAP=$NA(^TMP(" GPLCCR",$J,"MEDMAP",MEDCOUNT))59 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT)) 60 60 . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN CCRMEDS 61 61 . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY … … 243 243 . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),! 244 244 . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13) 245 . N RESULT S RESULT=$NA(^TMP(" GPLCCR",$J,"MAPPED"))245 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 246 246 . K @RESULT 247 . D MAP^ GPLXPATH(MINXML,MAP,RESULT)248 . ; D PARY^ GPLXPATH(RESULT)247 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 248 . ; D PARY^C0CXPATH(RESULT) 249 249 . ; MAPPING DIRECTIONS 250 250 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 251 251 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 252 . D QUERY^ GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)253 . D REPLACE^ GPLXPATH(RESULT,"","//Medications/Medication/Directions")252 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 253 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 254 254 . ; N MDZ1,MDZNA 255 255 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 256 256 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 257 257 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 258 . . . D MAP^ GPLXPATH(DIRXML1,MDZNA,DIRXML2)259 . . . D INSERT^ GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")258 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 259 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 260 260 . I MEDFIRST D ; 261 261 . . S MEDFIRST=0 ; RESET FIRST FLAG 262 . . D CP^ GPLXPATH(RESULT,OUTXML) ; First one is a copy263 . D:'MEDFIRST INSINNER^ GPLXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML262 . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 263 . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML 264 264 N MEDTMP,MEDI 265 D MISSING^ GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS265 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 266 266 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 267 267 . W "MEDICATION MISSING ",! -
ccr/trunk/p/CCRMEDS3.m
r396 r412 50 50 I DEBUG ZWR MEDS 51 51 N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array. 52 S MEDMAP=$NA(^TMP(" GPLCCR",$J,"MEDMAP"))52 S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 53 53 N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array 54 54 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE … … 57 57 . I MED(5,"I")!MED(6,"I") QUIT ; If disconinued, we don't want to pull it. 58 58 . S MEDCOUNT=MEDCOUNT+1 59 . S MAP=$NA(^TMP(" GPLCCR",$J,"MEDMAP",MEDCOUNT))59 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT)) 60 60 . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY 61 61 . N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient … … 203 203 . E S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" 204 204 . S @MAP@("MEDRFNO")="" 205 . N RESULT S RESULT=$NA(^TMP(" GPLCCR",$J,"MAPPED"))205 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 206 206 . K @RESULT 207 . D MAP^ GPLXPATH(MINXML,MAP,RESULT)208 . ; D PARY^ GPLXPATH(RESULT)207 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 208 . ; D PARY^C0CXPATH(RESULT) 209 209 . ; MAPPING DIRECTIONS 210 210 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 211 211 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 212 . D QUERY^ GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)213 . D REPLACE^ GPLXPATH(RESULT,"","//Medications/Medication/Directions")212 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 213 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 214 214 . ; N MDZ1,MDZNA 215 215 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 216 216 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 217 217 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 218 . . . D MAP^ GPLXPATH(DIRXML1,MDZNA,DIRXML2)219 . . . D INSERT^ GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")218 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 219 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 220 220 . I MEDFIRST D ; 221 221 . . S MEDFIRST=0 ; RESET FIRST FLAG 222 . . D CP^ GPLXPATH(RESULT,OUTXML) ; First one is a copy223 . D:'MEDFIRST INSINNER^ GPLXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML222 . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 223 . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML 224 224 N MEDTMP,MEDI 225 D MISSING^ GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS225 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 226 226 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 227 227 . W "MEDICATION MISSING ",! -
ccr/trunk/p/CCRMEDS6.m
r396 r412 58 58 N J S J="" F S J=$O(MEDS1(J)) Q:J="" I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J) 59 59 K MEDS1 60 S MEDMAP=$NA(^TMP(" GPLCCR",$J,"MEDMAP")) ; this is the variable map60 S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; this is the variable map 61 61 S @MEDMAP@(0)=0 ; Initial count of meds 62 62 S MEDCNT="" ; Initialize for $Order 63 63 F S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT="" D ; for each medication in the list 64 64 . I DEBUG W "MEDCNT IS ",MEDCNT,! 65 . S MAP=$NA(^TMP(" GPLCCR",$J,"MEDMAP",MEDCNT))65 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT)) 66 66 . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN CCRMEDS 67 67 . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; increment total meds in var array … … 274 274 . ; 275 275 . ; ------ BEGIN XML INSERTION 276 . N RESULT S RESULT=$NA(^TMP(" GPLCCR",$J,"MAPPED"))276 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 277 277 . K @RESULT 278 . D MAP^ GPLXPATH(MINXML,MAP,RESULT)279 . ; D PARY^ GPLXPATH(RESULT)278 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 279 . ; D PARY^C0CXPATH(RESULT) 280 280 . ; MAPPING DIRECTIONS 281 281 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 282 282 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 283 . D QUERY^ GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)284 . D REPLACE^ GPLXPATH(RESULT,"","//Medications/Medication/Directions")283 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 284 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 285 285 . ; N MDZ1,MDZNA 286 286 . N DIRCNT S DIRCNT="" … … 288 288 . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; FOR EACH DIRECTION 289 289 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT)) 290 . . . D MAP^ GPLXPATH(DIRXML1,MDZNA,DIRXML2)291 . . . D INSERT^ GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")292 . D:MEDCNT=1 CP^ GPLXPATH(RESULT,OUTXML) ; First one is a copy293 . D:MEDCNT>1 INSINNER^ GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML290 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 291 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 292 . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 293 . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 294 294 N MEDTMP,MEDI 295 D MISSING^ GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS295 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 296 296 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 297 297 . W "MEDICATION MISSING ",!
Note:
See TracChangeset
for help on using the changeset viewer.
