Changeset 184 for ccr/trunk/p/CCRMEDS2.m
- Timestamp:
- Oct 5, 2008, 9:16:50 PM (16 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/CCRMEDS2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/CCRMEDS2.m
r180 r184 1 CCRMEDS2 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 . ; Sig data is not in any API. We obtain it using the IEN from 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 . . ; However, it gets translated by a call to the administration 142 143 144 145 146 . . ; I looked), PSSFT is the name, 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 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 1 CCRMEDS2 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Pending Meds;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 ; MINXML is the Input XML Template, passed by name 26 ; DFN is Patient IEN 27 ; OUTXML is the resultant XML. 28 ; 29 ; MEDS is return array from RPC. 30 ; MAP is a mapping variable map (store result) for each med 31 ; MED is holds each array element from MEDS, one medicine 32 ; 33 ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending 34 ; meds 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 ; File for pending meds is 52.41 38 ; Unfortuantely, API does not supply us with any useful info beyond 39 ; the IEN in 52.41, and the Med Name, and route. 40 ; So, most of the info is going to get pulled from 52.41. 41 N MEDS,MAP 42 K ^TMP($J) 43 D PEN^PSO5241(DFN,"CCDCCR") 44 M MEDS=^TMP($J,"CCDCCR",DFN) 45 ; @(0) contains the number of meds or -1^NO DATA FOUND 46 ; If it is -1, we quit. 47 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT 48 I DEBUG ZWR MEDS 49 N RXIEN S RXIEN=0 50 N MEDCOUNT S MEDCOUNT=0 51 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST 52 . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order 53 . S MEDCOUNT=MEDCOUNT+1 54 . I DEBUG W "RXIEN IS ",RXIEN,! 55 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT)) 56 . K @MAP 57 . I DEBUG W "MAP= ",MAP,! 58 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM 59 . S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN 60 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 61 . ; Field 6 is "Effective date", and we pull it in timson format w/ I 62 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I")) 63 . ; Med never filled; next 4 fields are not applicable. 64 . S @MAP@("MEDLASTFILLDATETXT")="" 65 . S @MAP@("MEDLASTFILLDATE")="" 66 . S @MAP@("MEDRXNOTXT")="" 67 . S @MAP@("MEDRXNO")="" 68 . S @MAP@("MEDTYPETEXT")="Medication" 69 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 70 . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds 71 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I") 72 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2) 73 . ; NDC not supplied in API, but is rather trivial to obtain 74 . ; MED(11) piece 1 has the IEN of the drug (file 50) 75 . ; IEN is field 31 in the drug file. 76 . N MEDIEN S MEDIEN=$P(MED(11),U) 77 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$$GET1^DIQ(50,MEDIEN,31,"E") 78 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" 79 . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none" 80 . S @MAP@("MEDBRANDNAMETEXT")="" 81 . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 82 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 83 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 84 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 85 . ; Units, concentration, etc, come from another call 86 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 87 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 88 . ; NDF Entry IEN, and VA Product Name 89 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 90 . ; Documented in the same manual. 91 . D NDF^PSS50(MEDIEN,,,,,"CONC") 92 . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN) 93 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 94 . N VAPROD S VAPROD=$P(NDFDATA(22),U) 95 . N CONCDATA 96 . ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 97 . ; and this will crash the call. So... 98 . I NDFIEN="" S CONCDATA="" 99 . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 100 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) 101 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) 102 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) 103 . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2) 104 . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12) 105 . ; Oddly, there is no easy place to find the dispense unit. 106 . ; It's not included in the original call, so we have to go to the drug file. 107 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 108 . ; Node 14.5 is the Dispense Unit 109 . D DATA^PSS50(MEDIEN,,,,,"QTY") 110 . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 111 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 112 . ; 113 . ; --- START OF DIRECTIONS --- 114 . ; Sig data is not in any API. We obtain it using the IEN from 115 . ; the PEN API to file 52.41. It's in field 3, which is a multiple. 116 . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT) 117 . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call 118 . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG") 119 . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman. 120 . ; FMSIGNUM gets outputted as "IEN,RXIEN,". 121 . ; DIRNUM will be first piece for IEN. 122 . ; DIRNUM is the proper Sigline numer. 123 . ; SIGDATA is the simplfied array. Subscripts are really field numbers 124 . ; in subfile 52.413. 125 . F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D 126 . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",") 127 . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM) 128 . . ; If this is an order for a refill; it's not really a new order; move on to next 129 . . S @MAP@("M",DIRNUM,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 130 . . S @MAP@("M",DIRNUM,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 131 . . S @MAP@("M",DIRNUM,"MEDDELIVERYMETHOD")=SIGDATA(13) 132 . . S @MAP@("M",DIRNUM,"MEDDOSEVALUE")=SIGDATA(8) 133 . . S @MAP@("M",DIRNUM,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") 134 . . S @MAP@("M",DIRNUM,"MEDRATEVALUE")="" ; For inpatient 135 . . S @MAP@("M",DIRNUM,"MEDRATEUNIT")="" ; For inpatient 136 . . S @MAP@("M",DIRNUM,"MEDVEHICLETEXT")="" ; For inpatient 137 . . S @MAP@("M",DIRNUM,"MEDDIRECTIONROUTETEXT")=SIGDATA(10) 138 . . S @MAP@("M",DIRNUM,"MEDFREQUENCYVALUE")=SIGDATA(1) 139 . . ; Invervals... again another call. 140 . . ; The schedule is a free text field 141 . . ; However, it gets translated by a call to the administration 142 . . ; schedule file to see if that schedule exists. 143 . . ; That's the same thing I am going to do. 144 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ). 145 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO-- 146 . . ; I looked), PSSFT is the name, 147 . . ; and list is the ^TMP name to store the data in. 148 . . ; Also, freqency may have "PRN" in it, so strip that out 149 . . N FREQ S FREQ=SIGDATA(1) 150 . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp 151 . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE") 152 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE") 153 . . N INTERVAL 154 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL="" 155 . . E D 156 . . . N SUB S SUB=$O(SCHEDATA(0)) 157 . . . S INTERVAL=SCHEDATA(SUB,2) 158 . . S @MAP@("M",DIRNUM,"MEDINTERVALVALUE")=INTERVAL 159 . . S @MAP@("M",DIRNUM,"MEDINTERVALUNIT")="Minute" 160 . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months 161 . . N DUR S DUR=SIGDATA(2) 162 . . S @MAP@("M",DIRNUM,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR)) 163 . . N DURUNIT S DURUNIT=$E(DUR) 164 . . S @MAP@("M",DIRNUM,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"") 165 . . S @MAP@("M",DIRNUM,"MEDPRNFLAG")=SIGDATA(1)["PRN" 166 . . S @MAP@("M",DIRNUM,"MEDPROBLEMOBJECTID")="" 167 . . S @MAP@("M",DIRNUM,"MEDPROBLEMTYPETXT")="" 168 . . S @MAP@("M",DIRNUM,"MEDPROBLEMDESCRIPTION")="" 169 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODEVALUE")="" 170 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGSYSTEM")="" 171 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGVERSION")="" 172 . . S @MAP@("M",DIRNUM,"MEDPROBLEMSOURCEACTORID")="" 173 . . S @MAP@("M",DIRNUM,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field 174 . . S @MAP@("M",DIRNUM,"MEDDIRSEQ")=DIRNUM 175 . . S @MAP@("M",DIRNUM,"MEDMULDIRMOD")=SIGDATA(6) 176 . ; 177 . ; --- END OF DIRECTIONS --- 178 . ; 179 . S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" 180 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9" 181 . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13) 182 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED")) 183 . K @RESULT 184 . D MAP^GPLXPATH(MINXML,MAP,RESULT) 185 . ; D PARY^GPLXPATH(RESULT) 186 . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy 187 . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 188 N MEDTMP,MEDI 189 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 190 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 191 . W "MEDICATION MISSING ",! 192 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 193 Q 194 ;
Note:
See TracChangeset
for help on using the changeset viewer.
