From 31e35c2eb9f511e014d048c7c1ffb36a1013a2c2 Mon Sep 17 00:00:00 2001 From: sam Date: Sat, 4 Oct 2008 21:52:28 +0000 Subject: [PATCH] Bug fixes for CCRMEDS2 --- p/CCRMEDS.m | 2 +- p/CCRMEDS2.m | 385 ++++++++++++++++++++++++++------------------------- 2 files changed, 195 insertions(+), 192 deletions(-) diff --git a/p/CCRMEDS.m b/p/CCRMEDS.m index 238a56e..fd6300a 100644 --- a/p/CCRMEDS.m +++ b/p/CCRMEDS.m @@ -176,4 +176,4 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE . W "MEDICATION MISSING ",! . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! Q - ; \ No newline at end of file + ; diff --git a/p/CCRMEDS2.m b/p/CCRMEDS2.m index 3d89471..8ff6e59 100644 --- a/p/CCRMEDS2.m +++ b/p/CCRMEDS2.m @@ -1,191 +1,194 @@ -CCRMEDS2 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Pending Meds;08/24/08 - ;;0.1;CCDCCR;;JUL 16,2008; - ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ; General Public License See attached copy of the License. - ; - ; This program is free software; you can redistribute it and/or modify - ; it under the terms of the GNU General Public License as published by - ; the Free Software Foundation; either version 2 of the License, or - ; (at your option) any later version. - ; - ; This program is distributed in the hope that it will be useful, - ; but WITHOUT ANY WARRANTY; without even the implied warranty of - ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ; GNU General Public License for more details. - ; - ; You should have received a copy of the GNU General Public License along - ; with this program; if not, write to the Free Software Foundation, Inc., - ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - W "NO ENTRY FROM TOP",! - Q - ; -EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE - ; - ; MINXML is the Input XML Template, passed by name - ; DFN is Patient IEN - ; OUTXML is the resultant XML. - ; - ; MEDS is return array from RPC. - ; MAP is a mapping variable map (store result) for each med - ; MED is holds each array element from MEDS, one medicine - ; - ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending - ; meds data available. - ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf - ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). - ; File for pending meds is 52.41 - ; Unfortuantely, API does not supply us with any useful info beyond - ; the IEN in 52.41, and the Med Name, and route. - ; So, most of the info is going to get pulled from 52.41. - N MEDS,MAP - K ^TMP($J) - D PEN^PSO5241(DFN,"CCDCCR") - M MEDS=^TMP($J,"CCDCCR",DFN) - ; @(0) contains the number of meds or -1^NO DATA FOUND - ; If it is -1, we quit. - I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT - I DEBUG ZWR MEDS - N RXIEN S RXIEN=0 - N MEDCOUNT S MEDCOUNT=0 - F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST - . S MEDCOUNT=MEDCOUNT+1 - . I DEBUG W "RXIEN IS ",RXIEN,! - . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT)) - . K @MAP - . I DEBUG W "MAP= ",MAP,! - . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM - . S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN - . S @MAP@("MEDISSUEDATETXT")="Issue Date" - . ; Field 6 is "Effective date", and we pull it in timson format w/ I - . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I")) - . ; Med never filled; next 4 fields are not applicable. - . S @MAP@("MEDLASTFILLDATETXT")="" - . S @MAP@("MEDLASTFILLDATE")="" - . S @MAP@("MEDRXNOTXT")="" - . S @MAP@("MEDRXNO")="" - . S @MAP@("MEDTYPETEXT")="Medication" - . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses - . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds - . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I") - . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2) - . ; NDC not supplied in API, but is rather trivial to obtain - . ; MED(11) piece 1 has the IEN of the drug (file 50) - . ; IEN is field 31 in the drug file. - . N MEDIEN S MEDIEN=$P(MED(11),U) - . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$$GET1^DIQ(50,MEDIEN,31,"E") - . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" - . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none" - . S @MAP@("MEDBRANDNAMETEXT")="" - . D DOSE^PSS50(MEDIEN,,,,,"DOSE") - . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) - . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) - . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) - . ; Units, concentration, etc, come from another call - . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit - . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters - . ; NDF Entry IEN, and VA Product Name - . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") - . ; Documented in the same manual. - . D NDF^PSS50(MEDIEN,,,,,"CONC") - . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN) - . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) - . N VAPROD S VAPROD=$P(NDFDATA(22),U) - . N CONCDATA - . ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" - . ; and this will crash the call. So... - . I NDFIEN="" S CONCDATA="" - . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) - . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) - . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) - . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) - . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2) - . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12) - . ; Oddly, there is no easy place to find the dispense unit. - . ; It's not included in the original call, so we have to go to the drug file. - . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") - . ; Node 14.5 is the Dispense Unit - . D DATA^PSS50(MEDIEN,,,,,"QTY") - . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) - . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) - . ; - . ; --- START OF DIRECTIONS --- - . ; Sig data is not in any API. We obtain it using the IEN from - . ; the PEN API to file 52.41. It's in field 3, which is a multiple. - . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT) - . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG") - . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman. - . ; FMSIGNUM gets outputted as "IEN,RXIEN,". - . ; DIRNUM will be first piece for IEN. - . ; DIRNUM is the proper Sigline numer. - . ; SIGDATA is the simplfied array. Subscripts are really field numbers - . ; in subfile 52.413. - . F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D - . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",") - . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM) - . . S @MAP@("M",DIRNUM,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. - . . S @MAP@("M",DIRNUM,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. - . . S @MAP@("M",DIRNUM,"MEDDELIVERYMETHOD")=SIGDATA(13) - . . S @MAP@("M",DIRNUM,"MEDDOSEVALUE")=SIGDATA(8) - . . S @MAP@("M",DIRNUM,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") - . . S @MAP@("M",DIRNUM,"MEDRATEVALUE")="" ; For inpatient - . . S @MAP@("M",DIRNUM,"MEDRATEUNIT")="" ; For inpatient - . . S @MAP@("M",DIRNUM,"MEDVEHICLETEXT")="" ; For inpatient - . . S @MAP@("M",DIRNUM,"MEDDIRECTIONROUTETEXT")=SIGDATA(10) - . . S @MAP@("M",DIRNUM,"MEDFREQUENCYVALUE")=SIGDATA(1) - . . ; Invervals... again another call. - . . ; The schedule is a free text field - . . ; However, it gets translated by a call to the administration - . . ; schedule file to see if that schedule exists. - . . ; That's the same thing I am going to do. - . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ). - . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO-- - . . ; I looked), PSSFT is the name, - . . ; and list is the ^TMP name to store the data in. - . . ; Also, freqency may have "PRN" in it, so strip that out - . . N FREQ S FREQ=SIGDATA(1) - . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp - . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE") - . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE") - . . N INTERVAL - . . I $P(SCHEDATA(0),U)=-1 S INTERVAL="" - . . E D - . . . N SUB S SUB=$O(SCHEDATA(0)) - . . . S INTERVAL=SCHEDATA(SUB,2) - . . S @MAP@("M",DIRNUM,"MEDINTERVALVALUE")=INTERVAL - . . S @MAP@("M",DIRNUM,"MEDINTERVALUNIT")="Minute" - . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months - . . N DUR S DUR=SIGDATA(2) - . . S @MAP@("M",DIRNUM,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR)) - . . N DURUNIT S DURUNIT=$E(DUR) - . . S @MAP@("M",DIRNUM,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"") - . . S @MAP@("M",DIRNUM,"MEDPRNFLAG")=SIGDATA(1)["PRN" - . . S @MAP@("M",DIRNUM,"MEDPROBLEMOBJECTID")="" - . . S @MAP@("M",DIRNUM,"MEDPROBLEMTYPETXT")="" - . . S @MAP@("M",DIRNUM,"MEDPROBLEMDESCRIPTION")="" - . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODEVALUE")="" - . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGSYSTEM")="" - . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGVERSION")="" - . . S @MAP@("M",DIRNUM,"MEDPROBLEMSOURCEACTORID")="" - . . S @MAP@("M",DIRNUM,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field - . . S @MAP@("M",DIRNUM,"MEDDIRSEQ")=DIRNUM - . . S @MAP@("M",DIRNUM,"MEDMULDIRMOD")=SIGDATA(6) - . ; - . ; --- END OF DIRECTIONS --- - . ; - . S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" - . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9" - . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13) - . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED")) - . K @RESULT - . D MAP^GPLXPATH(MINXML,MAP,RESULT) - . ; D PARY^GPLXPATH(RESULT) - . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy - . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML - N MEDTMP,MEDI - D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS - I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ - . W "MEDICATION MISSING ",! - . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! - Q - ; +CCRMEDS2 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Pending Meds;08/24/08 + ;;0.1;CCDCCR;;JUL 16,2008; + ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU + ; General Public License See attached copy of the License. + ; + ; This program is free software; you can redistribute it and/or modify + ; it under the terms of the GNU General Public License as published by + ; the Free Software Foundation; either version 2 of the License, or + ; (at your option) any later version. + ; + ; This program is distributed in the hope that it will be useful, + ; but WITHOUT ANY WARRANTY; without even the implied warranty of + ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ; GNU General Public License for more details. + ; + ; You should have received a copy of the GNU General Public License along + ; with this program; if not, write to the Free Software Foundation, Inc., + ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + W "NO ENTRY FROM TOP",! + Q + ; +EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE + ; + ; MINXML is the Input XML Template, passed by name + ; DFN is Patient IEN + ; OUTXML is the resultant XML. + ; + ; MEDS is return array from RPC. + ; MAP is a mapping variable map (store result) for each med + ; MED is holds each array element from MEDS, one medicine + ; + ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending + ; meds data available. + ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf + ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). + ; File for pending meds is 52.41 + ; Unfortuantely, API does not supply us with any useful info beyond + ; the IEN in 52.41, and the Med Name, and route. + ; So, most of the info is going to get pulled from 52.41. + N MEDS,MAP + K ^TMP($J) + D PEN^PSO5241(DFN,"CCDCCR") + M MEDS=^TMP($J,"CCDCCR",DFN) + ; @(0) contains the number of meds or -1^NO DATA FOUND + ; If it is -1, we quit. + I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT + I DEBUG ZWR MEDS + N RXIEN S RXIEN=0 + N MEDCOUNT S MEDCOUNT=0 + F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST + . S MEDCOUNT=MEDCOUNT+1 + . I DEBUG W "RXIEN IS ",RXIEN,! + . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT)) + . K @MAP + . I DEBUG W "MAP= ",MAP,! + . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM + . S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN + . S @MAP@("MEDISSUEDATETXT")="Issue Date" + . ; Field 6 is "Effective date", and we pull it in timson format w/ I + . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I")) + . ; Med never filled; next 4 fields are not applicable. + . S @MAP@("MEDLASTFILLDATETXT")="" + . S @MAP@("MEDLASTFILLDATE")="" + . S @MAP@("MEDRXNOTXT")="" + . S @MAP@("MEDRXNO")="" + . S @MAP@("MEDTYPETEXT")="Medication" + . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses + . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds + . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I") + . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2) + . ; NDC not supplied in API, but is rather trivial to obtain + . ; MED(11) piece 1 has the IEN of the drug (file 50) + . ; IEN is field 31 in the drug file. + . N MEDIEN S MEDIEN=$P(MED(11),U) + . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$$GET1^DIQ(50,MEDIEN,31,"E") + . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" + . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none" + . S @MAP@("MEDBRANDNAMETEXT")="" + . D DOSE^PSS50(MEDIEN,,,,,"DOSE") + . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) + . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) + . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) + . ; Units, concentration, etc, come from another call + . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit + . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters + . ; NDF Entry IEN, and VA Product Name + . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") + . ; Documented in the same manual. + . D NDF^PSS50(MEDIEN,,,,,"CONC") + . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN) + . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) + . N VAPROD S VAPROD=$P(NDFDATA(22),U) + . N CONCDATA + . ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" + . ; and this will crash the call. So... + . I NDFIEN="" S CONCDATA="" + . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) + . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) + . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) + . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) + . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2) + . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12) + . ; Oddly, there is no easy place to find the dispense unit. + . ; It's not included in the original call, so we have to go to the drug file. + . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") + . ; Node 14.5 is the Dispense Unit + . D DATA^PSS50(MEDIEN,,,,,"QTY") + . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) + . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) + . ; + . ; --- START OF DIRECTIONS --- + . ; Sig data is not in any API. We obtain it using the IEN from + . ; the PEN API to file 52.41. It's in field 3, which is a multiple. + . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT) + . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call + . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG") + . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman. + . ; FMSIGNUM gets outputted as "IEN,RXIEN,". + . ; DIRNUM will be first piece for IEN. + . ; DIRNUM is the proper Sigline numer. + . ; SIGDATA is the simplfied array. Subscripts are really field numbers + . ; in subfile 52.413. + . F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D + . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",") + . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM) + . . ; If this is an order for a refill; it's not really a new order; move on to next + . . I SIGDATA(2)="RF" QUIT + . . S @MAP@("M",DIRNUM,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. + . . S @MAP@("M",DIRNUM,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. + . . S @MAP@("M",DIRNUM,"MEDDELIVERYMETHOD")=SIGDATA(13) + . . S @MAP@("M",DIRNUM,"MEDDOSEVALUE")=SIGDATA(8) + . . S @MAP@("M",DIRNUM,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") + . . S @MAP@("M",DIRNUM,"MEDRATEVALUE")="" ; For inpatient + . . S @MAP@("M",DIRNUM,"MEDRATEUNIT")="" ; For inpatient + . . S @MAP@("M",DIRNUM,"MEDVEHICLETEXT")="" ; For inpatient + . . S @MAP@("M",DIRNUM,"MEDDIRECTIONROUTETEXT")=SIGDATA(10) + . . S @MAP@("M",DIRNUM,"MEDFREQUENCYVALUE")=SIGDATA(1) + . . ; Invervals... again another call. + . . ; The schedule is a free text field + . . ; However, it gets translated by a call to the administration + . . ; schedule file to see if that schedule exists. + . . ; That's the same thing I am going to do. + . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ). + . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO-- + . . ; I looked), PSSFT is the name, + . . ; and list is the ^TMP name to store the data in. + . . ; Also, freqency may have "PRN" in it, so strip that out + . . N FREQ S FREQ=SIGDATA(1) + . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp + . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE") + . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE") + . . N INTERVAL + . . I $P(SCHEDATA(0),U)=-1 S INTERVAL="" + . . E D + . . . N SUB S SUB=$O(SCHEDATA(0)) + . . . S INTERVAL=SCHEDATA(SUB,2) + . . S @MAP@("M",DIRNUM,"MEDINTERVALVALUE")=INTERVAL + . . S @MAP@("M",DIRNUM,"MEDINTERVALUNIT")="Minute" + . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months + . . N DUR S DUR=SIGDATA(2) + . . S @MAP@("M",DIRNUM,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR)) + . . N DURUNIT S DURUNIT=$E(DUR) + . . S @MAP@("M",DIRNUM,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"") + . . S @MAP@("M",DIRNUM,"MEDPRNFLAG")=SIGDATA(1)["PRN" + . . S @MAP@("M",DIRNUM,"MEDPROBLEMOBJECTID")="" + . . S @MAP@("M",DIRNUM,"MEDPROBLEMTYPETXT")="" + . . S @MAP@("M",DIRNUM,"MEDPROBLEMDESCRIPTION")="" + . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODEVALUE")="" + . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGSYSTEM")="" + . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGVERSION")="" + . . S @MAP@("M",DIRNUM,"MEDPROBLEMSOURCEACTORID")="" + . . S @MAP@("M",DIRNUM,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field + . . S @MAP@("M",DIRNUM,"MEDDIRSEQ")=DIRNUM + . . S @MAP@("M",DIRNUM,"MEDMULDIRMOD")=SIGDATA(6) + . ; + . ; --- END OF DIRECTIONS --- + . ; + . S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" + . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9" + . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13) + . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED")) + . K @RESULT + . D MAP^GPLXPATH(MINXML,MAP,RESULT) + . ; D PARY^GPLXPATH(RESULT) + . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy + . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML + N MEDTMP,MEDI + D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS + I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ + . W "MEDICATION MISSING ",! + . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! + Q + ;