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

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

added kill for Meds value array at beginning of GPLMEDS processing

File size: 3.7 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 I DEBUG ZWR MEDRSLT
35 S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))
36 S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
37 K @MEDTVMAP,@MEDTARYTMP
38 F J=1:3 Q:'$D(MEDRSLT(J)) D ; FOR EACH MEDICATION IN THE LIST
39 . I DEBUG W "J IS ",J,!
40 . S MEDVMAP=$NA(@MEDTVMAP@(J))
41 . K @MEDVMAP
42 . I DEBUG W "VMAP= ",MEDVMAP,!
43 . S MEDPTMP=MEDRSLT(J) ; PULL OUT MEDICATION FROM RPC RETURN ARRAY
44 . S @MEDVMAP@("MEDICATIONOBJECTID")="MED"_J ; UNIQUE OBJID FOR MEDS
45 . ; PROCESSING FOR MEDS GOES HERE
46 . S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
47 . S @MEDVMAP@("MEDICATIONDATETIMEAGE")=""
48 . S @MEDVMAP@("MEDICATIONDATETIMEAGEUNITS")=""
49 . S @MEDVMAP@("MEDTYPETEXT")="Medication"
50 . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
51 . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
52 . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
53 . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODEVALUE")=""
54 . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODINGINGSYSTEM")=""
55 . S @MEDVMAP@("MEDICATIONPRODUCTNAMECODEVERSION")=""
56 . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
57 . S @MEDVMAP@("MEDICATIONBRANDNAMECODEVALUE")=""
58 . S @MEDVMAP@("MEDICATIONBRANDNAMECODINGSYSTEM")=""
59 . S @MEDVMAP@("MEDICATIONBRANDNAMECODEVERSION")=""
60 . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
61 . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
62 . S @MEDVMAP@("MEDFORMTEXT")=""
63 . S @MEDVMAP@("MEDQUANTITYVALUE")=""
64 . S @MEDVMAP@("MEDQUANTITYUNIT")=""
65 . S @MEDVMAP@("MEDRFNO")=""
66 . S @MEDVMAP@("MEDICATIONDESCRIPTIONTEXT")=$P(MEDRSLT(J+1)," *",2)
67 . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=$P(MEDRSLT(J+2),"\ Sig: ",2)
68 . S @MEDVMAP@("MEDICATIONDIRECTIONDOSEVALUE")=""
69 . S @MEDVMAP@("MEDICATIONDIRECTIONROUTETEXT")=""
70 . S @MEDVMAP@("MEDICATIONDIRECTIONFREQUENCYVALUE")=""
71 . S MEDARYTMP=$NA(@MEDTARYTMP@(J))
72 . K @MEDARYTMP
73 . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
74 . I J=1 D ; FIRST ONE IS JUST A COPY
75 . . ; W "FIRST ONE",!
76 . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
77 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
78 . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
79 N MEDTMP,MEDI
80 D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
81 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
82 . W "MEDICATION MISSING ",!
83 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
84 Q
85 ;
Note: See TracBrowser for help on using the repository browser.