source: ccr/trunk/p/GPLMEDS.m@ 86

Last change on this file since 86 was 86, checked in by George Lilly, 16 years ago

the Variable "I" was being stepped on in the Meds processing.. newed it.
File size: 4.1 KB
Line 
1GPLMEDS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08 14:33
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 ;
23EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
24 ;
25 ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
26 ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
27 ;
28 N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
29 D ACTIVE^ORWPS(.MEDRSLT,DFN)
30 I '$D(MEDRSLT(1)) D ; NO MEDS FOR THIS PATIENT, EXIT
31 . W "ERROR RUNNINIG MEDICATIONS RPC",!
32 . S @MEDOUTXML@(0)=0
33 . Q
34 IF DEBUG ZWR MEDRSLT
35 S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))
36 S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
37 F J=1:3 Q:'$D(MEDRSLT(J)) D ; FOR EACH MEDICATION IN THE LIST
38 . W "J IS ",J,!
39 . S MEDVMAP=$NA(@MEDTVMAP@(J))
40 . K @MEDVMAP
41 . I DEBUG W "VMAP= ",VMAP,!
42 . S MEDPTMP=MEDRSLT(J) ; PULL OUT MEDICATION FROM RPC RETURN ARRAY
43 . S @MEDVMAP@("MEDICATIONOBJECTID")="MED"_J ; UNIQUE OBJID FOR MEDS
44 . ; PROCESSING FOR MEDS GOES HERE
45 . S @MEDVMAP@("MEDICATIONDATETIMETEXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
46 . S @MEDVMAP@("MEDICATIONDATETIMEAGE")=""
47 . S @MEDVMAP@("MEDICATIONDATETIMEAGEUNITS")=""
48 . S @MEDVMAP@("MEDICATIONTYPETEXT")="Medication"
49 . S @MEDVMAP@("MEDICATIONSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
50 . S @MEDVMAP@("MEDICATIONSOURCEACTORID")="ACTORSYSTEM_1"
51 . S @MEDVMAP@("MEDICATIONPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
52 . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODEVALUE")=""
53 . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODINGINGSYSTEM")=""
54 . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODEVERSION")=""
55 . S @MEDVMAP@("MEDICATIONBRANDNAMETEXT")=""
56 . S @MEDVMAP@("MEDICATIONBRANDNAMECODEVALUE")=""
57 . S @MEDVMAP@("MEDICATIONBRANDNAMECODINGSYSTEM")=""
58 . S @MEDVMAP@("MEDICATIONBRANDNAMECODEVERSION")=""
59 . S @MEDVMAP@("MEDICATIONSTRENGTHVALUE")=""
60 . S @MEDVMAP@("MEDICATIONSTRENGTHUNIT")=""
61 . S @MEDVMAP@("MEDICATIONFORMTEXT")=""
62 . S @MEDVMAP@("MEDICATIONDESCRIPTIONTEXT")=$P(MEDRSLT(J+1)," *",2)
63 . S @MEDVMAP@("MEDICATIONDIRECTIONDESCRIPTIONTEXT")=$P(MEDRSLT(J+2),"\ Sig: ",2)
64 . S @MEDVMAP@("MEDICATIONDIRECTIONDOSEVALUE")=""
65 . S @MEDVMAP@("MEDICATIONDIRECTIONROUTETEXT")=""
66 . S @MEDVMAP@("MEDICATIONDIRECTIONFREQUENCYVALUE")=""
67 . S MEDARYTMP=$NA(@MEDTARYTMP@(J))
68 . K @MEDARYTMP
69 . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
70 . I J=1 D ; FIRST ONE IS JUST A COPY
71 . . ; W "FIRST ONE",!
72 . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
73 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
74 . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
75 N MEDTMP,MEDI
76 D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
77 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
78 . W "MEDICATION MISSING ",!
79 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
80 Q
81 ;
Note: See TracBrowser for help on using the repository browser.