Changeset 166 for ccr/trunk/p
- Timestamp:
- Sep 22, 2008, 11:38:33 AM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/CCRMEDS.m
r165 r166 1 CCRMEDS 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 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT 45 46 47 48 49 50 51 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))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 1 CCRMEDS ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08 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 . ; 106 . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 107 . S @MAP@("MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 108 . ; Sig data not in any API :-( Oh yes, you can get the whole thing, but... 109 . ; we want the compoenents. 110 . ; It's in node 6 of ^PSRX(IEN) 111 . ; So, here we go again 112 . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE 113 . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4) 114 . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE 115 . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^ 116 . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,1,0) 117 . S @MAP@("MEDDELIVERYMETHOD")=$P(SIGDATA,U,9) 118 . S @MAP@("MEDDOSEVALUE")=$P(SIGDATA,U,1) 119 . S @MAP@("MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") 120 . S @MAP@("MEDRATEVALUE")="" ; For inpatient 121 . S @MAP@("MEDRATEUNIT")="" ; For inpatient 122 . S @MAP@("MEDVEHICLETEXT")="" ; For inpatient 123 . S @MAP@("MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01) 124 . S @MAP@("MEDFREQUENCYVALUE")=$P(SIGDATA,U,8) 125 . ; Invervals... again another call. 126 . ; In the wisdom of the original programmers, the schedule is a free text field 127 . ; However, it gets translated by a call to the administration schedule file 128 . ; to see if that schedule exists. 129 . ; That's the same thing I am going to do. 130 . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ). 131 . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO-- 132 . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in. 133 . ; So... 134 . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE") 135 . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE") 136 . N INTERVAL 137 . I $P(SCHEDATA(0),U)=-1 S INTERVAL="" 138 . E D 139 . . N SUB S SUB=$O(SCHEDATA(0)) 140 . . S INTERVAL=SCHEDATA(SUB,2) 141 . S @MAP@("MEDINTERVALVALUE")=INTERVAL 142 . S @MAP@("MEDINTERVALUNIT")="Minute" 143 . S @MAP@("MEDDURATIONVALUE")=$P(SIGDATA,U,5) 144 . S @MAP@("MEDDURATIONUNIT")="" 145 . S @MAP@("MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN" 146 . S @MAP@("MEDPROBLEMOBJECTID")="" 147 . S @MAP@("MEDPROBLEMTYPETXT")="" 148 . S @MAP@("MEDPROBLEMDESCRIPTION")="" 149 . S @MAP@("MEDPROBLEMCODEVALUE")="" 150 . S @MAP@("MEDPROBLEMCODINGSYSTEM")="" 151 . S @MAP@("MEDPROBLEMCODINGVERSION")="" 152 . S @MAP@("MEDPROBLEMSOURCEACTORID")="" 153 . S @MAP@("MEDSTOPINDICATOR")="" 154 . S @MAP@("MEDDIRSEQ")="" 155 . S @MAP@("MEDMULDIRMOD")="" 156 . ; 157 . ; --- END OF DIRECTIONS --- 158 . ; 159 . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE" 160 . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0)) 161 . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command" 162 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0)) 163 . S @MAP@("MEDRFNO")=MED(9) 164 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT")) 165 . K @RESULT 166 . ; D MAP^GPLXPATH($NA(INXML),MAP,RESULT) 167 . D MAP^GPLXPATH(MINXML,MAP,RESULT) 168 . ; D PARY^GPLXPATH(RESULT) 169 . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy 170 . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 171 N MEDTMP,MEDI 172 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 173 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 174 . W "MEDICATION MISSING ",! 175 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 176 Q 177 ; -
ccr/trunk/p/GPLMEDS.m
r165 r166 81 81 . S @MEDVMAP@("MEDPRNFLAG")="" 82 82 . S @MEDVMAP@("MEDPROBLEMOBJECTID")="" 83 . S @MEDVMAP@(" PROBLEM")=""83 . S @MEDVMAP@("MEDPROBLEMTYPETXT")="" 84 84 . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")="" 85 85 . S @MEDVMAP@("MEDPROBLEMCODEVALUE")="" -
ccr/trunk/p/GPLRIMA.m
r165 r166 64 64 . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS") 65 65 . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D ; MEDS VARS EXISTS 66 . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MED ICATIONS")66 . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP") 67 67 . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING 68 68 . ; … … 404 404 N GTMP 405 405 D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES 406 I '$D(IWHICH) S IWHICH="ALL" 406 407 D RPCGV(.GTMP,DFN,IWHICH) 407 408 D PARY^GPLXPATH("GTMP")
Note:
See TracChangeset
for help on using the changeset viewer.
