- Timestamp:
- Oct 4, 2008, 1:03:02 PM (17 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/CCRMEDS.m
r174 r176 1 1 CCRMEDS ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 EXTRACT(MINXML,DFN,OUTXML) 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 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. 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 W "NO ENTRY FROM TOP",! 21 Q 22 ; 23 EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 24 ; 25 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 26 ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE 27 ; 28 ; MEDS is return array from RPC. 29 ; MAP is a mapping variable map (store result) for each med 30 ; MED is holds each array element from MEDS(J), one medicine 31 ; J is a counter. 32 ; 33 ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all 34 ; med data available. 35 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf 36 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). 37 ; D PARY^GPLXPATH(MINXML) 38 N MEDS,MAP 39 K ^TMP($J) 40 D RX^PSO52API(DFN,"CCDCCR") 41 M MEDS=^TMP($J,"CCDCCR",DFN) 42 ; @(0) contains the number of meds or -1^NO DATA FOUND 43 ; If it is -1, we quit. 44 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT 45 I DEBUG ZWR MEDS 46 N RXIEN S RXIEN=0 47 N MEDCOUNT S MEDCOUNT=0 48 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST 49 . S MEDCOUNT=MEDCOUNT+1 50 . I DEBUG W "RXIEN IS ",RXIEN,! 51 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT)) 52 . K @MAP 53 . I DEBUG W "MAP= ",MAP,! 54 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM 55 . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number 56 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 57 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U)) 58 . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" 59 . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U)) 60 . S @MAP@("MEDRXNOTXT")="Prescription Number" 61 . S @MAP@("MEDRXNO")=MED(.01) 62 . S @MAP@("MEDTYPETEXT")="Medication" 63 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 64 . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2) 65 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U) 66 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2) 67 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27) 68 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" 69 . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none" 70 . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5) 71 . N MEDIEN S MEDIEN=$P(MED(6),U) 72 . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 73 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 74 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 75 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 76 . ; Units, concentration, etc, come from another call 77 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 78 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 79 . ; NDF Entry IEN, and VA Product Name 80 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 81 . ; Documented in the same manual. 82 . D NDF^PSS50(MEDIEN,,,,,"CONC") 83 . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN) 84 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 85 . N VAPROD S VAPROD=$P(NDFDATA(22),U) 86 . N CONCDATA 87 . ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 88 . ; and this will crash the call. So... 89 . I NDFIEN="" S CONCDATA="" 90 . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 91 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) 92 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) 93 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) 94 . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2) 95 . S @MAP@("MEDQUANTITYVALUE")=MED(7) 96 . ; Oddly, there is no easy place to find the dispense unit. 97 . ; It's not included in the original call, so we have to go to the drug file. 98 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 99 . ; Node 14.5 is the Dispense Unit 100 . D DATA^PSS50(MEDIEN,,,,,"QTY") 101 . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 102 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 103 . ; 104 . ; --- START OF DIRECTIONS --- 105 . ; Sig data not in any API :-( Oh yes, you can get the whole thing, but... 106 . ; we want the compoenents. 107 . ; It's in node 6 of ^PSRX(IEN) 108 . ; So, here we go again 109 . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE 110 . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4) 111 . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE 112 . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^ 113 . ; 114 . N DIRNUM S DIRNUM=0 ; Sigline number 115 . F S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM="" D 116 . . S @MAP@("M",DIRNUM,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 117 . . S @MAP@("M",DIRNUM,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 118 . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0) 119 . . S @MAP@("M",DIRNUM,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9) 120 . . S @MAP@("M",DIRNUM,"MEDDOSEVALUE")=$P(SIGDATA,U,1) 121 . . S @MAP@("M",DIRNUM,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") 122 . . S @MAP@("M",DIRNUM,"MEDRATEVALUE")="" ; For inpatient 123 . . S @MAP@("M",DIRNUM,"MEDRATEUNIT")="" ; For inpatient 124 . . S @MAP@("M",DIRNUM,"MEDVEHICLETEXT")="" ; For inpatient 125 . . S @MAP@("M",DIRNUM,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01) 126 . . S @MAP@("M",DIRNUM,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8) 127 . . ; Invervals... again another call. 128 . . ; In the wisdom of the original programmers, the schedule is a free text field 129 . . ; However, it gets translated by a call to the administration schedule file 130 . . ; to see if that schedule exists. 131 . . ; That's the same thing I am going to do. 132 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ). 133 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO-- 134 . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in. 135 . . ; So... 136 . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE") 137 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE") 138 . . N INTERVAL 139 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL="" 140 . . E D 141 . . . N SUB S SUB=$O(SCHEDATA(0)) 142 . . . S INTERVAL=SCHEDATA(SUB,2) 143 . . S @MAP@("M",DIRNUM,"MEDINTERVALVALUE")=INTERVAL 144 . . S @MAP@("M",DIRNUM,"MEDINTERVALUNIT")="Minute" 145 . . S @MAP@("M",DIRNUM,"MEDDURATIONVALUE")=$P(SIGDATA,U,5) 146 . . S @MAP@("M",DIRNUM,"MEDDURATIONUNIT")="" 147 . . S @MAP@("M",DIRNUM,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN" 148 . . S @MAP@("M",DIRNUM,"MEDPROBLEMOBJECTID")="" 149 . . S @MAP@("M",DIRNUM,"MEDPROBLEMTYPETXT")="" 150 . . S @MAP@("M",DIRNUM,"MEDPROBLEMDESCRIPTION")="" 151 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODEVALUE")="" 152 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGSYSTEM")="" 153 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGVERSION")="" 154 . . S @MAP@("M",DIRNUM,"MEDPROBLEMSOURCEACTORID")="" 155 . . S @MAP@("M",DIRNUM,"MEDSTOPINDICATOR")="" 156 . . S @MAP@("M",DIRNUM,"MEDDIRSEQ")=DIRNUM 157 . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6) 158 . . S @MAP@("M",DIRNUM,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"") 159 . ; 160 . ; --- END OF DIRECTIONS --- 161 . ; 162 . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE" 163 . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0)) 164 . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command" 165 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0)) 166 . S @MAP@("MEDRFNO")=MED(9) 167 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED")) 168 . K @RESULT 169 . D MAP^GPLXPATH(MINXML,MAP,RESULT) 170 . ; D PARY^GPLXPATH(RESULT) 171 . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy 172 . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 173 N MEDTMP,MEDI 174 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 175 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 176 . W "MEDICATION MISSING ",! 177 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 178 Q 179 ; -
ccr/trunk/p/GPLRIMA.m
r168 r176 410 410 ; IWHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS" 411 411 N GTMP 412 D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES 412 I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT 413 . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES 413 414 I '$D(IWHICH) S IWHICH="ALL" 414 415 D RPCGV(.GTMP,DFN,IWHICH) -
ccr/trunk/p/GPLXPATH.m
r167 r176 433 433 F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH 434 434 . ; W H2I_"^"_@IHASH@(H2I),! 435 . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES 436 . . W "GPLZZ",! 437 . . W $NA(@IHASH@(H2I)),! 438 . . Q ; 435 439 . D PUSH(IARYRTN,H2I_"^"_@IHASH@(H2I)) 436 440 . ; W @IARYRTN@(0),!
Note:
See TracChangeset
for help on using the changeset viewer.
