Changeset 1586 for ccr/trunk/p
- Timestamp:
- Oct 30, 2012, 1:11:02 PM (12 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 79 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CACTOR.m
r1544 r1586 1 C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 2 ;;1.2;C 0C;;May 11, 2012;Build 471 C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 ; 10/29/12 4:04pm 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ; This program is free software; you can redistribute it and/or modify 8 ; it under the terms of the GNU General Public License as published by 9 ; the Free Software Foundation; either version 2 of the License, or 10 ; (at your option) any later version. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 10 ; This program is distributed in the hope that it will be useful, 13 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ; GNU General Public License for more details. 16 ; 17 ; You should have received a copy of the GNU General Public License along 18 ; with this program; if not, write to the Free Software Foundation, Inc., 19 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 17 ; 21 18 ; PROCESS THE ACTORS SECTION OF THE CCR -
ccr/trunk/p/C0CALERT.m
r1544 r1586 1 C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 2 ;;1.2;C 0C;;May 11, 2012;Build 471 C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 ; 10/29/12 4:04pm 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota and others. 4 ;Licensed under the terms of the GNU General Public License.5 ;See attached copy of the License.6 4 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 16 14 ; 17 ; You should have received a copy of the GNU General Public License along18 ; with this program; if not, write to the Free Software Foundation, Inc.,19 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 20 18 ; 21 19 W "NO ENTRY FROM TOP",! … … 30 28 S GMRA="0^0^111" 31 29 D EN1^GMRADPT 32 I $G(GMRAL)'=1 D Q ; NO ALLERGIES FOUND THUS *QUIT*30 I $G(GMRAL)'=1 D Q ; NO ALLERGIES FOUND THUS *QUIT* 33 31 . S @ALTOUTXML@(0)=0 34 32 ; DEFINE MAPPING -
ccr/trunk/p/C0CBAT.m
r1544 r1586 1 1 C0CBAT ; CCDCCR/GPL - CCR Batch utilities; 4/21/09 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 19 18 ; 20 19 W "This is the CCR Batch Utility Library ",! … … 63 62 I $D(@C0CBB@(0)) D ; ERROR SHOULDN'T EXIST 64 63 . W "WORK AREA ERROR",! 65 . B64 . S $EC=",U1," 66 65 S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA 67 66 S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST … … 164 163 Q ZN 165 164 ; 166 U PDIEVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE165 UVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE 167 166 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO 168 167 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO … … 190 189 D CLEAN^DILF 191 190 D UPDATE^DIE("","C0CFDA","","ZERR") 192 I $D(ZERR) D ; 193 . W "ERROR",! 194 . ZWR ZERR 195 . B 191 I $D(ZERR) S $EC=",U1," 196 192 K C0CFDA 197 193 Q -
ccr/trunk/p/C0CCCD.m
r1544 r1586 1 1 C0CCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 17 ; 21 18 ; EXPORT A CCR 22 19 ; 23 20 EXPORT ; EXPORT ENTRY POINT FOR CCR 24 25 26 27 28 29 30 21 ; Select a patient. 22 S DIC=2,DIC(0)="AEMQ" D ^DIC 23 I Y<1 Q ; EXIT 24 S DFN=$P(Y,U,1) ; SET THE PATIENT 25 D XPAT(DFN,"","") ; EXPORT TO A FILE 26 Q 27 ; 31 28 XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 29 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR") 30 ; FN IS FILE NAME, DEFAULTS IF NULL 31 ; N CCDGLO 32 D CCDRPC(.CCDGLO,DFN,"CCD","","","") 33 S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1)) 34 S ONAM=FN 35 I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml" 36 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR")) 37 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET 38 . S @ODIRGLB="/home/glilly/CCROUT" 39 . ;S @ODIRGLB="/home/cedwards/" 40 . ;S @ODIRGLB="/opt/wv/p/" 41 S ODIR=DIR 42 I DIR="" S ODIR=@ODIRGLB 43 N ZY 44 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) 45 W $P(ZY,U,2) 46 Q 47 ; 51 48 CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT 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 49 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME 50 ; DFN IS PATIENT IEN 51 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 52 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 53 ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL 54 ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME 55 ; - NULL MEANS NOW 56 ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND 57 ; "TO" VARIABLES 58 ; IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN 59 I '$D(DEBUG) S DEBUG=0 60 N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD 61 I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD 62 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 63 I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD 64 E S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 65 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 66 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 67 S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL 68 I CCD D LOAD^C0CCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE 69 E D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 70 D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 71 N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES 72 S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT 73 S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD 74 S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT 75 S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO 76 S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP 77 S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP 78 ; 79 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 80 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 81 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body") 82 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors") 83 I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures") 84 I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),! 85 ; 86 I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES 87 ; MAPPING THE PATIENT PORTION OF THE CDA HEADER 88 S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient" 89 D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1") 90 D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT 91 I DEBUG D PARY^C0CXPATH("ACTT2") 92 D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX) 93 I DEBUG D PARY^C0CXPATH(CCDGLO) 94 K ACTT1 K ACCT2 95 ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER 96 ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION 97 D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG 98 D CP^C0CXPATH("ACTT2",CCDGLO) 99 ; 100 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 101 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 102 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 103 N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 104 F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 105 . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE 106 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 107 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 108 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 109 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 110 . S IXML="INXML" 111 . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION 112 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 113 . ; W OXML,! 114 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 115 . W "RUNNING ",CALL,! 116 . X CALL 117 . I @OXML@(0)'=0 D ; THERE IS A RESULT 118 . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH 119 . . I CCD D UNSHAVE("ITMP",OXML) 120 . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION 121 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 122 . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body") 123 . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),! 124 ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE 125 ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST 126 ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 127 ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2") 128 ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 129 N I,J,DONE S DONE=0 130 F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 131 . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS 132 . W "TRIMMED",J,! 133 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE 134 I CCD D ; TURN THE BODY INTO A CCD COMPONENT 135 . N I 136 . F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY 137 . . I @CCDGLO@(I)["<Body>" D ; REPLACE BODY MARKUP 138 . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ 139 . . I @CCDGLO@(I)["</Body>" D ; REPLACE BODY MARKUP 140 . . . S @CCDGLO@(I)="</structuredBody></component>" 141 S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD 142 S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE 143 Q 144 ; 148 145 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 149 150 151 152 153 154 155 156 146 ; TAB IS PASSED BY NAME 147 W "TAB= ",TAB,! 148 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS 149 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") 150 ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")") 151 I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 152 Q 153 ; 157 154 SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT 158 159 160 161 162 163 164 165 166 167 168 169 155 ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION 156 N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST 157 W SHXML,! 158 W @SHXML@(1),! 159 D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED 160 D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART 161 D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE 162 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST 163 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION 164 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY 165 Q 166 ; 170 167 UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE 171 172 173 174 175 176 177 178 179 180 181 182 168 ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML 169 N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST 170 W SHXML,! 171 W @SHXML@(1),! 172 D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE 173 D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST 174 D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP 175 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST 176 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION 177 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY 178 Q 179 ; 183 180 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 181 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) 182 ; K @VMAP 183 S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT") 184 I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 185 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 186 . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ??? 187 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM 188 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES 189 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES 190 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES 191 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 192 I IHDR'="" D ; HEADER VALUES ARE PROVIDED 193 . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 194 N CTMP 195 D MAP^C0CXPATH(CXML,VMAP,"CTMP") 196 D CP^C0CXPATH("CTMP",CXML) 197 Q 198 ; 202 199 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 200 ; AXML AND ACTRTN ARE PASSED BY NAME 201 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 202 ; P1= OBJECTID - ACTORPATIENT_2 203 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE 204 ;OR INSTITUTION 205 ; OR PERSON(IN PATIENT FILE IE NOK) 206 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 207 N I,J,K,L 208 K @ACTRTN ; CLEAR RETURN ARRAY 209 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 210 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE 211 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 212 . . W "<ActorID>=>",J,! 213 . . I J'="" S K(J)="" ; HASHING ACTOR 214 . . ; TO GET RID OF DUPLICATES 215 S I="" ; GOING TO $O THROUGH THE HASH 216 F J=0:0 D Q:$O(K(I))="" ; 217 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 218 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 219 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 220 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 221 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 222 Q 223 ; 227 224 TEST ; RUN ALL THE TEST CASES 228 229 230 225 D TESTALL^C0CUNIT("C0CCCR") 226 Q 227 ; 231 228 ZTEST(WHICH) ; RUN ONE SET OF TESTS 232 233 234 235 236 229 N ZTMP 230 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 231 D ZTEST^C0CUNIT(.ZTMP,WHICH) 232 Q 233 ; 237 234 TLIST ; LIST THE TESTS 238 239 240 241 242 235 N ZTMP 236 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 237 D TLIST^C0CUNIT(.ZTMP) 238 Q 239 ; 243 240 ;;><TEST> 244 241 ;;><PROBLEMS> -
ccr/trunk/p/C0CCCD1.m
r1544 r1586 1 1 C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 W "This is a CCD TEMPLATE with processing routines",! 22 W ! 23 Q 24 ; 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 18 ; 19 W "This is a CCD TEMPLATE with processing routines",! 20 W ! 21 Q 22 ; 25 23 ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array 26 27 28 29 30 31 32 33 34 35 36 37 38 39 24 ; ZARY IS PASSED BY NAME 25 ; BAT is a string identifying the section 26 ; LINE is a test which will evaluate to true or false 27 ; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST ' 28 ; . S @ZARY@(0)=0 ; initially there are no elements 29 ; . W "GOT HERE LOADING "_LINE,! 30 N CNT ; count of array elements 31 S CNT=@ZARY@(0) ; contains array count 32 S CNT=CNT+1 ; increment count 33 S @ZARY@(CNT)=LINE ; put the line in the array 34 ; S @ZARY@(BAT,CNT)="" ; index the test by battery 35 S @ZARY@(0)=CNT ; update the array counter 36 Q 37 ; 40 38 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 39 ; ZARY IS PASSED BY NAME 40 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") 41 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE 42 K @ZARY S @ZARY="" 43 S @ZARY@(0)=0 ; initialize array count 44 N LINE,LABEL,BODY 45 N INTEST S INTEST=0 ; switch for in the TEMPLATE section 46 N SECTION S SECTION="[anonymous]" ; NO section LABEL 47 ; 48 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D 49 . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section 50 . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section 51 . I INTEST D ; within the section 52 . . I LINE?." "1";><".E D ; sub-section name found 53 . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name 54 . . I LINE?." "1";;".E D ; line found 55 . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array 56 Q 57 ; 60 58 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME 61 62 63 64 59 D ZLOAD(ARY,"C0CCCD1") 60 ; ZWR @ARY 61 Q 62 ; 65 63 TRMCCD ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD 66 64 Q 67 65 MARKUP ;<MARKUP> 68 66 ;;<Body> -
ccr/trunk/p/C0CCCR.m
r1544 r1586 1 1 C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 17 ; 21 18 ; EXPORT A CCR … … 288 285 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","") 289 286 ;;>>?@C0C@(@C0C@(0))["</Alerts>" 290 291 -
ccr/trunk/p/C0CCCR0.m
r1544 r1586 1 1 C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License.5 ;See attached copy of the License.6 4 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 16 14 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 17 ; 21 18 W "This is a CCR TEMPLATE with processing routines",! -
ccr/trunk/p/C0CCMT.m
r1544 r1586 1 1 C0CCMT ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2010 George Lilly, University of Minnesota and others. 4 ;Licensed under the terms of the GNU General Public License.5 ;See attached copy of the License.6 4 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 16 14 ; 17 ; You should have received a copy of the GNU General Public License along18 ; with this program; if not, write to the Free Software Foundation, Inc.,19 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 20 18 ; 21 19 W "NO ENTRY FROM TOP",! -
ccr/trunk/p/C0CCPT.m
r1544 r1586 1 1 C0CCPT ;;BSL;RETURN CPT DATA; 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Sequence Managers Software GPL;;;;;Build 2 4 ;Copied into C0C namespace from SQMCPT with permission from 5 ;Brian Lord - and with our thanks. gpl 01/20/2010 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; (C) George Lilly 2010 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 6 18 ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES 7 19 ;DFN=PATIENT IEN … … 10 22 ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE 11 23 ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME 12 13 14 15 16 17 18 19 20 21 24 ;ALL INCLUSIVE IN THAT DIRECTION 25 ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN) 26 ;BUILD INTO NOTE(Y)="" 27 S U="^",X="" 28 F S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X="" D 29 . S Y="" 30 . F S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y="" D 31 .. S NOTE(Y)="" 32 ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE 33 ;GET DATE OF NOTE 22 34 ;RUT 3120109 Changing DATE in FILMAN's FORMAT 23 ; ;OHUM/RUT 3111228 Date Range for Notes24 35 ;OHUM/RUT 3111228 Date Range for Notes 36 ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X 25 37 N FLAGS1,FLAGS2 26 38 S FLAGS1=$P(^C0CPARM(1,2),"^",1) S STDT=$$HTOF^C0CVALID(FLAGS1) 27 39 S FLAGS2=$P(^C0CPARM(1,2),"^",2) S ENDDT=$$HTOF^C0CVALID(FLAGS2) 28 40 ;S STDT=^TMP("C0CCCR","TIULIMIT"),ENDDT=^TMP("C0CCCR","TIUSTART") 29 ;;OHUM/RUT41 ;OHUM/RUT 30 42 ;RUT 31 32 33 34 35 36 37 38 43 S Z="" 44 F S Z=$O(NOTE(Z)) Q:Z="" D 45 . S DT=$P(^TIU(8925,Z,0),U,7) 46 . I $G(STDT)]"" D 47 .. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED 48 . I $G(ENDDT)]"" D 49 .. I ENDDT<DT S NOTE(Z)="D" 50 . I NOTE(Z)="D" K NOTE(Z) 39 51 D VISIT 40 52 Q 41 53 VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT 42 54 S ILST=1,X0="",X12="",VISIT="",LST="",X811="" -
ccr/trunk/p/C0CDIC.m
r1544 r1586 1 1 C0CDIC ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2008 WorldVistA. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "This is the CCR Dictionary Utility Library ",! -
ccr/trunk/p/C0CDOM.m
r1544 r1586 1 C0CDOM ; GPL - DOM PROCESSING ROUTINES ;6/6/11 17:05 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2011 George Lilly. 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 Q 21 ; 22 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 1 C0CDOM ; GPL - DOM PROCESSING ROUTINES ;6/6/11 17:05 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2011 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 18 ; 19 Q 20 ; 21 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 23 22 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 24 23 ; THE XPATH ARRAY XPARY, PASSED BY NAME … … 82 81 Q 83 82 ; 84 PARSE(INXML,INDOC) 83 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 85 84 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 86 85 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML … … 88 87 Q $$EN^MXMLDOM(INXML,"W") 89 88 ; 90 ISMULT(ZOID) 89 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 91 90 N ZN 92 91 ;I $$TAG(ZOID)["entry" B … … 95 94 Q 0 96 95 ; 97 FIRST(ZOID) 96 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 98 97 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 99 98 ; 100 PARENT(ZOID) 99 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 101 100 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 102 101 ; 103 ATT(RTN,NODE) 102 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 104 103 S HANDLE=C0CDOCID 105 104 K @RTN … … 107 106 Q 108 107 ; 109 TAG(ZOID) 108 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 110 109 ;I ZOID=149 B ;GPLTEST 111 110 N X,Y … … 116 115 Q Y 117 116 ; 118 NXTSIB(ZOID) 117 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 119 118 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 120 119 ; 121 DATA(ZT,ZOID) 120 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 122 121 ;N ZT,ZN S ZT="" 123 122 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) … … 126 125 Q 127 126 ; 128 OUTXML(ZRTN,INID,NO1ST) 127 OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 129 128 ; 130 129 S C0CDOCID=INID … … 137 136 Q 138 137 ; 139 NDOUT(ZOID) 138 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 140 139 N ZI S ZI=$$FIRST(ZOID) 141 140 I ZI'=0 D ; THERE IS A CHILD -
ccr/trunk/p/C0CDPT.m
r1544 r1586 1 1 C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ; 4 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU 5 ; General Public License. 6 ; 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; 4 ; Copyright 2008 WorldVistA. 5 ; 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (at your option) any later version. 10 ; 7 11 ; This program is distributed in the hope that it will be useful, 8 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 9 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 10 ; GNU General Public License for more details.11 ; 12 ; You should have received a copy of the GNU General Public License along13 ; with this program; if not, write to the Free Software Foundation, Inc.,14 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.14 ; GNU Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 18 ; 15 19 ; 16 20 ; FAMILY Family Name -
ccr/trunk/p/C0CENC.m
r1544 r1586 1 1 C0CENC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2010 George Lilly, University of Minnesota and others. 4 ;Licensed under the terms of the GNU General Public License.5 ;See attached copy of the License.6 4 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 16 14 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 17 ; 21 18 W "NO ENTRY FROM TOP",! … … 155 152 ; CPT^CATEGORY^TEXT 156 153 N Z1,Z2,Z3,ZRTN 157 S Z1=$P(ISTR,U,1) 154 S Z1=$P(ISTR,U,1) 158 155 I Z1="" D ; 159 156 . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1) -
ccr/trunk/p/C0CENV.m
r1544 r1586 1 1 C0CENV ;WV/JMC - CCD/CCR Environment Check/Install Routine ; Aug 16, 2009 2 ;;1.2;C0C;;May 11, 2012;Build 47 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; 4 ; (C) John McCormack 2009 5 ; 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (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 Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 3 18 ; 4 19 ; -
ccr/trunk/p/C0CEVC.m
r1544 r1586 1 C0CEVC ; CCDCCR/GPL - SUPPORT FOR EWD VISTCOM PAGES ; 3/1/2010 2 ;;1.2;C0C;;May 11, 2012;Build 47 1 C0CEVC ; CCDCCR/GPL - SUPPORT FOR EWD VISTCOM PAGES ; 3/1/2010 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; 4 ; (C) Geroge Lilly 2010. 5 ; 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (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 Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 18 ; 3 19 gpltest2 ; experiment with sending a CCR to an ewd page 4 20 N ZI -
ccr/trunk/p/C0CEWD.m
r1544 r1586 1 1 C0CEWD ; CCDCCR/GPL - CCR EWD utilities; 1/6/11 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 5 3 ; 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. 4 ;Copyright 2011 George Lilly. 10 5 ; 11 ; This program is distributed in the hope that it will be useful,12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Seethe14 ; GNU General Public License for more details.6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (at your option) any later version. 15 10 ; 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. 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 Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 18 ; 20 19 Q -
ccr/trunk/p/C0CEWD1.m
r1544 r1586 1 1 C0CEWD1 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 5 3 ; 6 ; This program is free software;you can redistribute it and/or modify7 ; it under the terms of the GNU General Public License as published by8 ; the Free Software Foundation; either version 2 of the License, or9 ; (at your option) any later version.4 ; This program is free software: you can redistribute it and/or modify 5 ; it under the terms of the GNU Affero General Public License as 6 ; published by the Free Software Foundation, either version 3 of the 7 ; License, or (at your option) any later version. 10 8 ; 11 ; This program is distributed in the hope that it will be useful,12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ; GNUGeneral Public License for more details.9 ; This program is distributed in the hope that it will be useful, 10 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 11 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 ; GNU Affero General Public License for more details. 15 13 ; 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. 14 ; You should have received a copy of the GNU Affero General Public License 15 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 16 ; 20 17 Q -
ccr/trunk/p/C0CFM1.m
r1544 r1586 1 1 C0CFM1 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 5 4 ; 6 ; This program is free software;you can redistribute it and/or modify7 ; it under the terms of the GNU General Public License as published by8 ; the Free Software Foundation; either version 2 of the License, or9 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 10 9 ; 11 ; This program is distributed in the hope that it will be useful,12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 15 14 ; 16 ; You should have received a copy of the GNU General Public License along17 ; with this program; if not, write to the Free Software Foundation, Inc.,18 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 19 18 ; 20 19 W "This is the CCR FILEMAN Utility Library ",! … … 69 68 K ZERR 70 69 D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER 71 I $D(ZERR) B ;OOPS70 I $D(ZERR) S $EC=",U1," 72 71 K C0CFDA 73 72 S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,"")) -
ccr/trunk/p/C0CFM2.m
r1544 r1586 1 1 C0CFM2 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 19 18 ; 20 19 W "This is the CCR FILEMAN Utility Library ",! … … 149 148 D CLEAN^DILF 150 149 D UPDATE^DIE("","C0CFDA","","ZERR") 151 I $D(ZERR) D ; 152 . W "ERROR",! 153 . ZWR ZERR 154 . B 150 I $D(ZERR) S $EC=",U1," 155 151 K C0CFDA 156 152 Q … … 183 179 . . W ZCHK,! 184 180 . . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK 185 ZWR ^TMP("C0CCHK",ZPAT,*)181 ; ZWR ^TMP("C0CCHK",ZPAT,*) 186 182 Q 187 183 ; … … 224 220 Q 225 221 ; 226 PUTELSO LD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE222 PUTELSO(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 227 223 ; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE 228 224 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE … … 249 245 ;B 250 246 D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER 251 I $D(ZERR) B ;OOPS247 I $D(ZERR) S $EC=",U1," 252 248 K C0CFDA 253 249 S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,"")) 254 250 W "RECORD NUMBER: ",ZD0,! 255 ;B256 251 S ZCNT=0 257 252 S ZC0CI="" ; … … 271 266 D CLEAN^DILF 272 267 D UPDATE^DIE("","C0CFDA","","ZERR") 273 I $D(ZERR) D ; 274 . W "ERROR",! 275 . ZWR ZERR 276 . B 268 I $D(ZERR) S $EC=",U1," 277 269 K C0CFDA 278 270 Q -
ccr/trunk/p/C0CFM3.m
r1544 r1586 1 1 C0CFM3 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 19 18 ; 20 19 W "This is the CCR FILEMAN Utility Library ",! … … 135 134 D CLEAN^DILF 136 135 D UPDATE^DIE("","C0CFDA","","ZERR") 137 I $D(ZERR) D ; 138 . W "ERROR",! 139 . ZWR ZERR 140 . B 141 K C0CFDA 142 Q 143 ; 144 PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 136 I $D(ZERR) S $EC=",U1," 137 K C0CFDA 138 Q 139 ; 140 PUTELSO(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 145 141 ; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE 146 142 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE … … 167 163 ;B 168 164 D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER 169 I $D(ZERR) B ;OOPS165 I $D(ZERR) S $EC=",U1," 170 166 K C0CFDA 171 167 S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,"")) … … 189 185 D CLEAN^DILF 190 186 D UPDATE^DIE("","C0CFDA","","ZERR") 191 I $D(ZERR) D ; 192 . W "ERROR",! 193 . ZWR ZERR 194 . B 187 I $D(ZERR) S $EC=",U1," 195 188 K C0CFDA 196 189 Q … … 283 276 N ZG 284 277 S ZG="" 285 F S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG="" D ZWR ^C0CE4(ZG,*) 286 Q 287 ; 278 F S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG="" D 279 . ; ZWR ^C0CE4(ZG,*) 280 Q 281 ; -
ccr/trunk/p/C0CIM2.m
r1544 r1586 1 1 C0CIM2 ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2010 George Lilly, University of Minnesota and others. 4 ;Licensed under the terms of the GNU General Public License.5 ;See attached copy of the License.6 4 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 16 14 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 17 ; 21 18 W "NO ENTRY FROM TOP",! -
ccr/trunk/p/C0CIMMU.m
r1544 r1586 1 1 C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License.5 ;See attached copy of the License.6 4 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 16 14 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 21 17 ; 22 18 ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR -
ccr/trunk/p/C0CIN.m
r1544 r1586 1 1 C0CIN ; CCDCCR/GPL - CCR IMPORT utilities; 9/20/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 5 4 ; 6 ; This program is free software;you can redistribute it and/or modify7 ; it under the terms of the GNU General Public License as published by8 ; the Free Software Foundation; either version 2 of the License, or9 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 10 9 ; 11 ; This program is distributed in the hope that it will be useful,12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 15 14 ; 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. 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "This is the CCR Import Utility Library ",! … … 185 183 D CLEAN^DILF 186 184 D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR") 187 I $D(ZERR) D ; 188 . W "ERROR",! 189 . ZWR ZERR 190 . B 185 I $D(ZERR) S $EC=",U1," 191 186 K C0CFDA 192 187 Q -
ccr/trunk/p/C0CLA7DD.m
r1544 r1586 1 C0CLA7DD ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ; 1 C0CLA7DD ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009 ; 10/30/12 10:16am 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; (C) 2009 John McCormack 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 4 18 ; Tasked by C0C post-install routine C0CENV to create C0C cross-references on V LAB file. 5 19 ; 6 20 Q 7 21 ; … … 249 263 ; 250 264 ; 251 SENDXQA(MSG) 252 253 254 255 256 257 258 259 265 SENDXQA(MSG) ; Send alert for reindex status 266 ; 267 N XQA,XQAMSG 268 ; 269 S XQA(DUZ)="" 270 S XQAMSG=MSG 271 D SETUP^XQALERT 272 ; 273 Q -
ccr/trunk/p/C0CLA7Q.m
r1544 r1586 1 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009 2 ;;1.2;C0C;;May 11, 2012;Build 47 1 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009 ; 10/30/12 10:16am 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; 4 ; (C) 2009 John McCormack 5 ; 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (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 Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 3 18 ; 4 19 ; -
ccr/trunk/p/C0CLABS.m
r1544 r1586 1 1 C0CLABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08 ; 5/10/12 2:49pm 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 21 18 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 22 19 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR … … 64 61 I '$D(@C0CV@(0)) D Q ; NO VARS THERE 65 62 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR 66 I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS63 I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS 67 64 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) 68 65 K @RIMVARS … … 107 104 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result> 108 105 . ;I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT 109 . . ;D CP^C0CXPATH(C0CRTMP,"RTN") ;106 . ;. D CP^C0CXPATH(C0CRTMP,"RTN") ; 110 107 . ;E D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST 111 108 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results> -
ccr/trunk/p/C0CMAIL.m
r1544 r1586 1 C0CMAIL 2 V ;;1.2;C 0C;;May 11, 2012;Build 471 C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr 2 V ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2011 Chris Richardson, Richardson Computer Research 4 4 ; Modified 3110516@1818 5 5 ; rcr@rcresearch.us 6 ; Licensed under the terms of the GNU 7 ;General Public License See attached copy of the License. 8 ; 9 ;This program is free software; you can redistribute it and/or modify 10 ;it under the terms of the GNU General Public License as published by 11 ;the Free Software Foundation; either version 2 of the License, or 12 ;(at your option) any later version. 13 ; 14 ;This program is distributed in the hope that it will be useful, 15 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;GNU General Public License for more details. 18 ; 19 ;You should have received a copy of the GNU General Public License along 20 ;with this program; if not, write to the Free Software Foundation, Inc., 21 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 6 ; 7 ; This program is free software: you can redistribute it and/or modify 8 ; it under the terms of the GNU Affero General Public License as 9 ; published by the Free Software Foundation, either version 3 of the 10 ; License, or (at your option) any later version. 11 ; 12 ; This program is distributed in the hope that it will be useful, 13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ; GNU Affero General Public License for more details. 16 ; 17 ; You should have received a copy of the GNU Affero General Public License 18 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 22 19 ; 23 20 ; ------------------ -
ccr/trunk/p/C0CMAIL2.m
r1544 r1586 1 1 C0CMAIL2 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr ; 5/10/12 2:50pm 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2011 Chris Richardson, Richardson Computer Research 4 4 ; Modified 3110615@1040 5 5 ; rcr@rcresearch.us 6 ; Licensed under the terms of the GNU 7 ;General Public License See attached copy of the License. 8 ; 9 ;This program is free software; you can redistribute it and/or modify 10 ;it under the terms of the GNU General Public License as published by 11 ;the Free Software Foundation; either version 2 of the License, or 12 ;(at your option) any later version. 13 ; 14 ;This program is distributed in the hope that it will be useful, 15 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;GNU General Public License for more details. 18 ; 19 ;You should have received a copy of the GNU General Public License along 20 ;with this program; if not, write to the Free Software Foundation, Inc., 21 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 6 ; 7 ; This program is free software: you can redistribute it and/or modify 8 ; it under the terms of the GNU Affero General Public License as 9 ; published by the Free Software Foundation, either version 3 of the 10 ; License, or (at your option) any later version. 11 ; 12 ; This program is distributed in the hope that it will be useful, 13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ; GNU Affero General Public License for more details. 16 ; 17 ; You should have received a copy of the GNU Affero General Public License 18 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 22 19 ; 23 20 ; ------------------ -
ccr/trunk/p/C0CMAIL3.m
r1544 r1586 1 1 C0CMAIL3 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr ; 5/10/12 2:51pm 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2011 Chris Richardson, Richardson Computer Research 4 4 ; Modified 3110619@2038 5 5 ; rcr@rcresearch.us 6 ; Licensed under the terms of the GNU 7 ;General Public License See attached copy of the License. 8 ; 9 ;This program is free software; you can redistribute it and/or modify 10 ;it under the terms of the GNU General Public License as published by 11 ;the Free Software Foundation; either version 2 of the License, or 12 ;(at your option) any later version. 13 ; 14 ;This program is distributed in the hope that it will be useful, 15 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;GNU General Public License for more details. 18 ; 19 ;You should have received a copy of the GNU General Public License along 20 ;with this program; if not, write to the Free Software Foundation, Inc., 21 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 6 ; 7 ; This program is free software: you can redistribute it and/or modify 8 ; it under the terms of the GNU Affero General Public License as 9 ; published by the Free Software Foundation, either version 3 of the 10 ; License, or (at your option) any later version. 11 ; 12 ; This program is distributed in the hope that it will be useful, 13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ; GNU Affero General Public License for more details. 16 ; 17 ; You should have received a copy of the GNU Affero General Public License 18 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 22 19 ; 23 20 ; ------------------ -
ccr/trunk/p/C0CMCCD.m
r1544 r1586 1 C0CMCCD ; GPL - MXML based CCD utilities;12/04/09 17:05 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. 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. 1 C0CMCCD ; GPL - MXML based CCD utilities;12/04/09 17:05 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 Q … … 281 279 Q 282 280 ; 283 UPDIE 281 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 284 282 K ZERR 285 283 D CLEAN^DILF 286 284 D UPDATE^DIE("","C0CFDA","","ZERR") 287 I $D(ZERR) D ; 288 . W "ERROR",! 289 . ZWR ZERR 290 . B 285 I $D(ZERR) S $EC=",U1," 291 286 K C0CFDA 292 287 Q -
ccr/trunk/p/C0CMED.m
r1544 r1586 1 1 C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel. 4 ; Licensed under the terms of the GNU General Public License. 5 ; See attached copy of the License. 6 ; 7 ; This program is free software; you can redistribute it and/or modify 8 ; it under the terms of the GNU General Public License as published by 9 ; the Free Software Foundation; either version 2 of the License, or 10 ; (at your option) any later version. 11 ; 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 12 10 ; This program is distributed in the hope that it will be useful, 13 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ; GNU General Public License for more details.16 ; 17 ; You should have received a copy of the GNU General Public License along18 ; with this program; if not, write to the Free Software Foundation, Inc.,19 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 20 18 ; 21 19 ; --Revision History … … 53 51 I $$RPMS^C0CUTIL() D RPMS QUIT 54 52 I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT 55 RPMS 53 RPMS ; 56 54 ;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT 57 55 N MEDCOUNT S MEDCOUNT=0 … … 62 60 D EXTRACT^C0CMED6(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds 63 61 D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 64 I @HIST@(0)>0 D 62 I @HIST@(0)>0 D 65 63 . D CP^C0CXPATH(HIST,MEDOUTXML) 66 64 . W:$G(DEBUG) "HAS ACTIVE OP MEDS",! 67 I @NVA@(0)>0 D 68 . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA) 65 I @NVA@(0)>0 D 66 . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA) 69 67 . ;E D CP^C0CXPATH(NVA,MEDOUTXML) 70 68 . W:$G(DEBUG) "HAS NON-VA MEDS",! 71 69 Q 72 VISTA 70 VISTA ; 73 71 N MEDCOUNT S MEDCOUNT=0 74 72 K ^TMP($J,"MED") … … 88 86 D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL 89 87 D EXTRACT^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl 90 I @HIST@(0)>0 D 88 I @HIST@(0)>0 D 91 89 . D CP^C0CXPATH(HIST,MEDOUTXML) 92 90 . W:$G(DEBUG) "HAS ACTIVE OP MEDS",! 93 I @PEND@(0)>0 D 91 I @PEND@(0)>0 D 94 92 . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical 95 93 . E D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy 96 94 . W:$G(DEBUG) "HAS OP PENDING MEDS",! 97 I @NVA@(0)>0 D 98 . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA) 99 . E D CP^C0CXPATH(NVA,MEDOUTXML) 95 I @NVA@(0)>0 D 96 . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA) 97 . E D CP^C0CXPATH(NVA,MEDOUTXML) 100 98 . W:$G(DEBUG) "HAS NON-VA MEDS",! 101 I @IPUD@(0)>0 D 102 . I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD) 103 . E D CP^C0CXPATH(IPUD,MEDOUTXML) 99 I @IPUD@(0)>0 D 100 . I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD) 101 . E D CP^C0CXPATH(IPUD,MEDOUTXML) 104 102 . W:$G(DEBUG) "HAS INPATIENT MEDS",! 105 103 N ZI … … 112 110 K @IPUD 113 111 Q 114 -
ccr/trunk/p/C0CMED1.m
r1544 r1586 1 1 C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;;Last modified Sat Jan 10 21:42:27 PST 2009 4 ; Copyright 2009 WorldVistA. Licensed under the terms of the GNU 5 ; General Public License See attached copy of the License. 6 ; 7 ; This program is free software; you can redistribute it and/or modify 8 ; it under the terms of the GNU General Public License as published by 9 ; the Free Software Foundation; either version 2 of the License, or 10 ; (at your option) any later version. 4 ; Copyright 2009 WorldVistA. 5 ; 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (at your option) any later version. 11 10 ; 12 11 ; This program is distributed in the hope that it will be useful, 13 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ; GNU General Public License for more details. 16 ; 17 ; You should have received a copy of the GNU General Public License along 18 ; with this program; if not, write to the Free Software Foundation, Inc., 19 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 14 ; GNU Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 18 ; 21 19 W "NO ENTRY FROM TOP",! … … 58 56 ; If it is -1, we quit. 59 57 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 Q 60 ZWRITE:$G(DEBUG) MEDS58 ; ZWRITE:$G(DEBUG) MEDS 61 59 N RXIEN S RXIEN=0 62 60 F S RXIEN=$O(MEDS(RXIEN)) Q:$G(RXIEN)="" D ; FOR EACH MEDICATION IN THE LIST 63 61 . N MED M MED=MEDS(RXIEN) 64 62 . I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT 65 . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS63 . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS 66 64 . S MEDCOUNT=MEDCOUNT+1 67 65 . W:$G(DEBUG) "RXIEN IS ",RXIEN,! -
ccr/trunk/p/C0CMED2.m
r1544 r1586 1 1 C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;;Last Modified Sat Jan 10 21:41:14 PST 2009 4 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU 5 ; General Public License See attached copy of the License. 6 ; 7 ; This program is free software; you can redistribute it and/or modify 8 ; it under the terms of the GNU General Public License as published by 9 ; the Free Software Foundation; either version 2 of the License, or 10 ; (at your option) any later version. 4 ; Copyright 2008 WorldVistA. 5 ; 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (at your option) any later version. 11 10 ; 12 11 ; This program is distributed in the hope that it will be useful, 13 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ; GNU General Public License for more details. 16 ; 17 ; You should have received a copy of the GNU General Public License along 18 ; with this program; if not, write to the Free Software Foundation, Inc., 19 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 14 ; GNU Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 18 ; 21 19 W "NO ENTRY FROM TOP",! … … 48 46 ; If it is -1, we quit. 49 47 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT 50 ZWRITE:$G(DEBUG) MEDS48 ; ZWRITE:$G(DEBUG) MEDS 51 49 N RXIEN S RXIEN=0 52 50 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING -
ccr/trunk/p/C0CMED3.m
r1544 r1586 1 1 C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;;Last Modified: Sun Jan 11 05:45:03 UTC 2009 4 ; Copyright 2009 WorldVistA. Licensed under the terms of the GNU 5 ; General Public License See attached copy of the License. 6 ; 7 ; This program is free software; you can redistribute it and/or modify 8 ; it under the terms of the GNU General Public License as published by 9 ; the Free Software Foundation; either version 2 of the License, or 10 ; (at your option) any later version. 4 ; Copyright 2009 WorldVistA. 5 ; 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (at your option) any later version. 11 10 ; 12 11 ; This program is distributed in the hope that it will be useful, 13 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ; GNU General Public License for more details. 16 ; 17 ; You should have received a copy of the GNU General Public License along 18 ; with this program; if not, write to the Free Software Foundation, Inc., 19 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 14 ; GNU Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 18 ; 21 19 W "NO ENTRY FROM TOP",! … … 49 47 K NVA 50 48 ; 51 I DEBUG ZWRITE MEDS49 ; I DEBUG ZWRITE MEDS 52 50 N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array. 53 51 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE -
ccr/trunk/p/C0CMED4.m
r1544 r1586 1 1 C0CMED4 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:38pm 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 ; General Public License See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; Copyright 2008 WorldVistA. 5 4 ; 6 ; This program is free software ;you can redistribute it and/or modify7 ; it under the terms of the GNU General Public License as published by8 ; the Free Software Foundation; either version 2 of the License, or9 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 10 9 ; 11 10 ; This program is distributed in the hope that it will be useful, 12 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ; GNU General Public License for more details.13 ; GNU Affero General Public License for more details. 15 14 ; 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. 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "NO ENTRY FROM TOP",! … … 49 47 ; Otherwise, we go on... 50 48 M MEDS=^TMP($J,"UD") 51 I DEBUG ZWR MEDS52 S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) 49 ; I DEBUG ZWR MEDS 50 S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) 53 51 N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array 54 N I S I=0 52 N I S I=0 55 53 F S I=$O(MEDS("B",I)) Q:'I D ; For each medication in B index 56 54 . N MED M MED=MEDS(I) … … 61 59 . I DEBUG W "RXIEN IS ",RXIEN,! 62 60 . I DEBUG W "MAP= ",MAP,! 63 . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 61 . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 64 62 . S @MAP@("MEDISSUEDATETXT")="Order Date" 65 63 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT") … … 70 68 . S @MAP@("MEDTYPETEXT")="Medication" 71 69 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 72 . S @MAP@("MEDSTATUSTEXT")="ACTIVE" 70 . S @MAP@("MEDSTATUSTEXT")="ACTIVE" 73 71 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U) 74 72 . S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01) … … 114 112 . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 115 113 . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 116 114 . E S @MAP@("MEDQUANTITYUNIT")="" 117 115 . ; 118 116 . ; --- START OF DIRECTIONS --- … … 126 124 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")="" 127 125 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")="" 128 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")="" 129 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")="" 130 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")="" 126 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")="" 127 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")="" 128 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")="" 131 129 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")="" 132 130 . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")="" … … 143 141 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")="" 144 142 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")="" 145 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 143 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 146 144 . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")="" 147 145 . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")="" -
ccr/trunk/p/C0CMED6.m
r1544 r1586 1 1 C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09 2 ;;1.2;C0C;;May 11, 2012;Build 47 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; Copyright 2008 WorldVistA. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 10 9 ; 11 10 ; This program is distributed in the hope that it will be useful, 12 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 12 ; 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. 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "NO ENTRY FROM TOP",! … … 55 53 ; If MEDS1 is not defined, then no meds 56 54 I '$D(MEDS1) QUIT 57 I DEBUG ZWR MEDS1,MINXML55 ;I DEBUG ZWR MEDS1,MINXML 58 56 N MEDCNT S MEDCNT=0 ; Med Count 59 57 ; The next line is a super line. It goes through the array return … … 229 227 . . N INTERVAL S INTERVAL="" ; Default 230 228 . . ; If there are entries found, get it 231 . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 229 . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 232 230 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL 233 231 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute" … … 265 263 . ; -- 1. Med Patient Instructions 266 264 . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1") 267 . N MEDPTIN2,J S (MEDPTIN2,J)="" 265 . N MEDPTIN2,J S (MEDPTIN2,J)="" 268 266 . I $L(MEDPTIN1) F S J=$O(@MEDPTIN1@(J)) Q:J="" Q:$L(MEDPTIN2)>10000 S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" " 269 267 . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2 … … 312 310 N RXNORM,C0CZRXN,DIERR 313 311 D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR") 314 I $D(DIERR) D ^%ZTER BREAK312 I $D(DIERR) S $EC=",U1," 315 313 S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries 316 314 N I S I=0 … … 329 327 . . E S RXNORM=RXNORM(I) QUIT ; We found the right code 330 328 QUIT +$G(RXNORM) ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0 331 -
ccr/trunk/p/C0CMIME.m
r1544 r1586 1 1 C0CMIME ; CCDCCR/GPL - MIME manipulation utilities; 3/8/11 ; 5/16/11 2:32pm 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2008 George Lilly. 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2008 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 Q … … 45 43 Q 46 44 ; THIS ROUTINE WAS COPIED FROM LRSRVR4 AND THEN MODIFIED . THANKS JOHN 47 ENCODEO LD(IARY,LRNODE,LRSTR) ; Encode a string, keep remainder for next line45 ENCODEO(IARY,LRNODE,LRSTR) ; Encode a string, keep remainder for next line 48 46 ; Call with LRSTR by reference, Remainder returned in LRSTR 49 47 ; IARY IS PASSED BY NAME … … 70 68 S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE" 71 69 D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,,ZATTACH) 72 ZWR GR73 Q 74 ; 75 TESTMAI L2 ;70 ; ZWR GR 71 Q 72 ; 73 TESTMAI2 ; 76 74 ; TEST OF MAILSEND TO gpl.mdc-crew.net 77 75 N C0CGM … … 85 83 ;S ZTO("george@nhin.openforum.opensourcevista.net")="" 86 84 ;S ZTO("mish@nhin.openforum.opensourcevista.net")="" 87 S ZTO("brooks.richard@securemail.opensourcevista.net")="" 85 S ZTO("brooks.richard@securemail.opensourcevista.net")="" 88 86 ;S ZTO("LILLY.GEORGE@mdc-crew.net")="" 89 87 ;S ZTO("ncoal@live.com")="" … … 99 97 S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE" 100 98 D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH,"CCR.xml") 101 ZWR GR99 ; ZWR GR 102 100 Q 103 101 ; … … 203 201 Q 204 202 ; 205 MAILSEN D0(LRMSUBJ) ; Send extract back to requestor.203 MAILSEN0(LRMSUBJ) ; Send extract back to requestor. 206 204 ; 207 205 ;D TEST … … 251 249 Q 252 250 ; 253 MAILSEN D2(UDFN,ADDR) ; Send extract back to requestor.251 MAILSEN2(UDFN,ADDR) ; Send extract back to requestor. 254 252 ; 255 253 I +$G(UDFN)=0 S UDFN=2 ; -
ccr/trunk/p/C0CMXML.m
r1544 r1586 1 1 C0CMXML ; GPL - MXML based XPath utilities;10/13/09 17:05 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 Q … … 45 43 Q 46 44 ; 47 TEST3 45 TEST3 ; 48 46 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 49 47 K GARY,GTMP,GIDX … … 114 112 D END^C0CMXMLB ;END THE DOCUMENT 115 113 M ZCCR=^TMP("MXMLBLD",$J) 116 ZWR ZCCR114 ; ZWR ZCCR 117 115 Q 118 116 ; … … 137 135 ;D END^C0CMXMLB ;EOND THE DOCUMENT 138 136 ;M ZCCD=^TMP("MXMLBLD",$J) 139 ZWR ZCCD(1:30)137 ; ZWR ZCCD(1:30) 140 138 Q 141 139 ; … … 246 244 D CLEAN^DILF 247 245 D UPDATE^DIE("","C0CFDA","","ZERR") 248 I $D(ZERR) D ; 249 . W "ERROR",! 250 . ZWR ZERR 251 . B 246 I $D(ZERR) S $EC=",U1," 252 247 K C0CFDA 253 248 Q -
ccr/trunk/p/C0CMXMLB.m
r1544 r1586 1 1 C0CMXMLB ;;ISF/RWF - Tool to build XML ; 5/10/12 2:51pm 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 QUIT 4 ; 5 ; FOIA Routine - Public Domain 4 6 ; 5 7 ;DOC - The top level tag … … 10 12 S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0 11 13 I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1 12 I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) 14 I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) 13 15 D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">") 14 16 Q -
ccr/trunk/p/C0CMXP.m
r1544 r1586 1 1 C0CMXP ; GPL - MXML based XPath utilities;12/04/09 17:05 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 Q … … 167 165 S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT") 168 166 K @C0CXLOC 169 S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 167 S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 170 168 ;N GIDX,GIDX2,GARY,GARY2 171 169 I '$D(REDUX) S REDUX="" … … 284 282 D CLEAN^DILF 285 283 D UPDATE^DIE("","C0CFDA","","ZERR") 286 I $D(ZERR) D ; 287 . W "ERROR",! 288 . ZWR ZERR 289 . B 284 I $D(ZERR) S $EC=",U1," 290 285 K C0CFDA 291 286 Q -
ccr/trunk/p/C0CNHIN.m
r1544 r1586 1 C0CNHIN ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11 17:05 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2011 George Lilly. 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. 1 C0CNHIN ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11 17:05 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2011 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 Q … … 146 144 Q 147 145 ; 148 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) 146 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 149 147 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 150 148 ; THE XPATH ARRAY XPARY, PASSED BY NAME … … 205 203 Q 206 204 ; 207 PARSE(INXML,INDOC) 205 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 208 206 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 209 207 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML … … 211 209 Q $$EN^MXMLDOM(INXML,"W") 212 210 ; 213 ISMULT(ZOID) 211 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 214 212 N ZN 215 213 ;I $$TAG(ZOID)["entry" B … … 218 216 Q 0 219 217 ; 220 FIRST(ZOID) 218 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 221 219 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 222 220 ; 223 PARENT(ZOID) 221 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 224 222 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 225 223 ; 226 ATT(RTN,NODE) 224 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 227 225 S HANDLE=C0CDOCID 228 226 K @RTN … … 230 228 Q 231 229 ; 232 TAG(ZOID) 230 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 233 231 ;I ZOID=149 B ;GPLTEST 234 232 N X,Y … … 239 237 Q Y 240 238 ; 241 NXTSIB(ZOID) 239 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 242 240 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 243 241 ; 244 DATA(ZT,ZOID) 242 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 245 243 ;N ZT,ZN S ZT="" 246 244 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) … … 249 247 Q 250 248 ; 251 OUTXML(ZRTN,INID) 249 OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 252 250 ; 253 251 S C0CDOCID=INID … … 259 257 Q 260 258 ; 261 NDOUT(ZOID) 259 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 262 260 N ZI S ZI=$$FIRST(ZOID) 263 261 I ZI'=0 D ; THERE IS A CHILD -
ccr/trunk/p/C0CNMED2.m
r1544 r1586 1 1 C0CNMED2 ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009 ; 5/10/12 2:53pm 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel. 4 ; Licensed under the terms of the GNU General Public License. 5 ; See attached copy of the License. 6 ; 7 ; This program is free software; you can redistribute it and/or modify 8 ; it under the terms of the GNU General Public License as published by 9 ; the Free Software Foundation; either version 2 of the License, or 10 ; (at your option) any later version. 11 ; 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 12 10 ; This program is distributed in the hope that it will be useful, 13 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ; GNU General Public License for more details.16 ; 17 ; You should have received a copy of the GNU General Public License along18 ; with this program; if not, write to the Free Software Foundation, Inc.,19 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 20 18 ; 21 19 ; --Revision History -
ccr/trunk/p/C0CNMED4.m
r1544 r1586 1 1 C0CNMED4 ; WV/CCDCCR/SMH/gpl - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:54pm 2 ;;1.2;C0C;;May 11, 2012;Build 47 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; Copyright 2008 WorldVistA. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 10 9 ; 11 10 ; This program is distributed in the hope that it will be useful, 12 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 12 ; 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. 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "NO ENTRY FROM TOP",! … … 58 56 IF ZCOUNT=0 Q ; no inpatient meds 59 57 ;M MEDS=^TMP($J,"UD") 60 I DEBUG ZWR MEDS61 S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 58 ;I DEBUG ZWR MEDS 59 S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 62 60 ;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array 63 61 S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") ;SETTING FLAG 64 N I S I=0 62 N I S I=0 65 63 F S I=$O(MEDS("med",I)) Q:'I D ; For each medication 66 64 . ;OHUM/RUT 3120507 ;STATUS VALIDATION FOR INPATIENT 67 68 69 70 71 72 65 . I ($P(C0CMFLAG,"^",1)'=1) D 66 . . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D 67 . . . K MEDS("med",I) Q 68 . . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D 69 . . . K MEDS("med",I) Q 70 . ;OHUM/RUT 73 71 . N MED M MED=MEDS("med",I) 74 72 . I $G(MED("vaType@value"))'="I" Q ; not inpatient … … 80 78 . I DEBUG W "RXIEN IS ",RXIEN,! 81 79 . I DEBUG W "MAP= ",MAP,! 82 . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 80 . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 83 81 . S @MAP@("MEDISSUEDATETXT")="Order Date" 84 82 . ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT") … … 174 172 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")="" 175 173 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")="" 176 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")="" 177 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")="" 178 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")="" 174 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")="" 175 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")="" 176 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")="" 179 177 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")="" 180 178 . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")="" … … 191 189 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")="" 192 190 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")="" 193 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 191 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 194 192 . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")="" 195 193 . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")="" -
ccr/trunk/p/C0CORSLT.m
r1544 r1586 1 1 C0CORSLT ; CCDCCR/GPL - CCR/CCD PROCESSING ADDITIONAL RESULTS ; 06/27/11 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2011 George Lilly. 4 ;Licensed under the terms of the GNU General Public License.5 ;See attached copy of the License.6 4 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 16 14 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 17 ; 21 18 W "NO ENTRY FROM TOP",! -
ccr/trunk/p/C0COVREL.m
r1544 r1586 1 1 C0COVREL ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB 4 N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP 5 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 6 I '$D(C0CQT) S C0CQT=0 7 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT 8 I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE 9 I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION 10 I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE 11 S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE 12 S C0CHB=$NA(^TMP("HLS",$J)) 13 S C0CI="" 14 S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT 15 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG 16 . K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES 17 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1) 18 . D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT) 19 . M XV=C0CVAR ; 20 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION 21 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT 22 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT 23 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS 24 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI 25 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR 26 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1) 27 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT 28 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 29 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 30 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS 31 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION 32 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX 33 . . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT 34 . . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC 35 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE 36 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC 37 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT 38 . . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC 39 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE 40 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC 41 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT 42 . . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT 43 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE 44 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME 45 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT 46 . . E D ; NO SECONDARY, USE PRIMARY 47 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE 48 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME 49 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT 50 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ; 51 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG 52 . . S C0CZG=XV("RESULTTESTVALUE") 53 . . S XV("RESULTTESTVALUE")=C0CZG 54 . I C0CTYP="OBX" D ; PROCESS TEST RESULTS 55 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION 56 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS 57 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT 58 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT 59 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX 60 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE 61 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER 62 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2 63 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID") 64 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT 65 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 66 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 67 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES 68 . I 'C0CQT D ; 69 . . W C0CI," ",C0CTYP,! 70 Q 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; (C) ELN 2012 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 18 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB 19 N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP 20 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 21 I '$D(C0CQT) S C0CQT=0 22 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT 23 I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE 24 I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION 25 I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE 26 S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE 27 S C0CHB=$NA(^TMP("HLS",$J)) 28 S C0CI="" 29 S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT 30 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG 31 . K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES 32 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1) 33 . D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT) 34 . M XV=C0CVAR ; 35 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION 36 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT 37 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT 38 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS 39 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI 40 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR 41 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1) 42 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT 43 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 44 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 45 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS 46 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION 47 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX 48 . . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT 49 . . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC 50 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE 51 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC 52 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT 53 . . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC 54 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE 55 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC 56 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT 57 . . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT 58 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE 59 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME 60 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT 61 . . E D ; NO SECONDARY, USE PRIMARY 62 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE 63 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME 64 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT 65 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ; 66 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG 67 . . S C0CZG=XV("RESULTTESTVALUE") 68 . . S XV("RESULTTESTVALUE")=C0CZG 69 . I C0CTYP="OBX" D ; PROCESS TEST RESULTS 70 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION 71 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS 72 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT 73 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT 74 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX 75 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE 76 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER 77 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2 78 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID") 79 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT 80 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 81 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 82 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES 83 . I 'C0CQT D ; 84 . . W C0CI," ",C0CTYP,! 85 Q -
ccr/trunk/p/C0COVRES.m
r1544 r1586 1 1 C0COVRES ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ; 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; (C) ELN 2012 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 4 18 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 19 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR 20 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME 21 ; MIXML IS THE TEMPLATE TO USE 22 ; MOXML IS THE OUTPUT XML ARRAY 23 ; DFN IS THE PATIENT RECORD NUMBER 24 N C0COXML,C0CO,C0CV,C0CIXML 25 I '$D(MIVAR) S C0CV="" ;DEFAULT 26 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY 27 I '$D(MIXML) S C0CIXML="" ;DEFAULT 28 E S C0CIXML=MIXML ;PASSED INPUT XML 29 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK 30 I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT 31 E S C0CO=MOXML 32 M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT 33 Q 20 34 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 21 22 23 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 35 ; RTN IS PASSED BY REFERENCE 36 N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES 37 N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE 38 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING 39 I RMIXML="" D ; INPUT XML NOT PASSED 40 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE 41 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R") 42 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE 43 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE 44 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED 45 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION 46 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS 47 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE 48 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ 49 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE 50 D EXTRACT("C0CT",DFN,) ; LAB EXTRACT 51 D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT 52 ;OHUM/RUT 3111221 53 ;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT 54 I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT 55 ;OHUM/RUT 56 I '$D(@C0CV@(0)) D Q ; NO VARS THERE 57 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR 58 ; NO RESULTS 59 I @C0CV@(0)=0 S RTN(0)=0 Q 60 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) 61 K @RIMVARS 62 ;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH 63 N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP 64 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR) 65 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT 66 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA 67 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END 68 ; TO IMPROVE PERFORMANCE 69 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results> 70 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES 71 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES 72 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST 73 . S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE 74 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA 75 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test> 76 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST 77 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS 78 . . K C0CTO ; CLEAR OUTPUT VARIABLE 79 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT 80 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS 81 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS 82 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ; 83 . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP 84 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test> 85 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test> 86 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML 87 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST 88 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result> 89 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results> 90 D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML 91 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE 92 Q 79 93 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 94 ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 95 N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG 96 S C0CNSSN=0 97 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 98 D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT 99 I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT 100 . S @C0CLB@(0)=0 101 ;K @C0CLB ; CLEAR OUT OLD VARS IF ANY 102 N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG 103 S C0CQT=1 ; SURPRESS LISTING 104 D LIST^C0COVREL ; EXTRACT THE VARIABLES 105 S C0CQT=QTSAV ; RESET SILENT FLAG 106 K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT 107 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS 108 Q -
ccr/trunk/p/C0COVREU.m
r1544 r1586 1 1 C0COVREU ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ; 4 ; 5 GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT 6 N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT 7 ; SET UP FOR LAB API CALL 8 S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT 9 I C0CPTID="" D Q ; NO SSN, COMPLAIN AND QUIT 10 . W "LAB LOOKUP FAILED, NO SSN",! 11 . S C0CNSSN=1 ; SET NO SSN FLAG 12 S C0CSPC="*" ; LOOKING FOR ALL LABS 13 ;I $D(^TMP("C0CCCR","RPMS")) D ; RUNNING RPMS 14 ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME 15 ;E D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING 16 ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY 17 S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM 18 S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM 19 D DT^DILF(,C0CLLMT,.C0CSDT) ; 20 W "LAB LIMIT: ",C0CLLMT,! 21 D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM 22 S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP 23 Q 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 18 ; 19 GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT 20 N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT 21 ; SET UP FOR LAB API CALL 22 S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT 23 I C0CPTID="" D Q ; NO SSN, COMPLAIN AND QUIT 24 . W "LAB LOOKUP FAILED, NO SSN",! 25 . S C0CNSSN=1 ; SET NO SSN FLAG 26 S C0CSPC="*" ; LOOKING FOR ALL LABS 27 ;I $D(^TMP("C0CCCR","RPMS")) D ; RUNNING RPMS 28 ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME 29 ;E D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING 30 ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY 31 S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM 32 S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM 33 D DT^DILF(,C0CLLMT,.C0CSDT) ; 34 W "LAB LIMIT: ",C0CLLMT,! 35 D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM 36 S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP 37 Q 24 38 LTYP(OSEG,OTYP,OVARA,OC0CQT) ; 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 39 N OI,OI2,OTAB,OTI,OV,OVAR 40 S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE 41 I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT 42 E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG 43 I 1 D ; FOR HL7 SEGMENT TYPE 44 . S OI="" ; INDEX INTO FIELDS IN SEG 45 . F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT 46 . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX 47 . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED 48 . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE 49 . . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE 50 . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX 51 . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE 52 . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE 53 . . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE 54 . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,! 55 Q 42 56 LOBX ; 43 Q 44 ; 57 Q 45 58 OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING) 46 47 48 49 50 51 59 N GA,GF,GD 60 S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1)) 61 S GF="RPMS_CCR_"_DFN_"_"_DT_".xml" 62 S GD=^TMP("C0CCCR","ODIR") 63 W $$OUTPUT^C0CXPATH(GA,GF,GD) 64 Q 52 65 SETTBL ; 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 178 66 K X ; CLEAR X 67 S X("PID","PID1")="1^00104^Set ID - Patient ID" 68 S X("PID","PID2")="2^00105^Patient ID (External ID)" 69 S X("PID","PID3")="3^00106^Patient ID (Internal ID)" 70 S X("PID","PID4")="4^00107^Alternate Patient ID" 71 S X("PID","PID5")="5^00108^Patient's Name" 72 S X("PID","PID6")="6^00109^Mother's Maiden Name" 73 S X("PID","PID7")="7^00110^Date of Birth" 74 S X("PID","PID8")="8^00111^Sex" 75 S X("PID","PID9")="9^00112^Patient Alias" 76 S X("PID","PID10")="10^00113^Race" 77 S X("PID","PID11")="11^00114^Patient Address" 78 S X("PID","PID12")="12^00115^County Code" 79 S X("PID","PID13")="13^00116^Phone Number - Home" 80 S X("PID","PID14")="14^00117^Phone Number - Business" 81 S X("PID","PID15")="15^00118^Language - Patient" 82 S X("PID","PID16")="16^00119^Marital Status" 83 S X("PID","PID17")="17^00120^Religion" 84 S X("PID","PID18")="18^00121^Patient Account Number" 85 S X("PID","PID19")="19^00122^SSN Number - Patient" 86 S X("PID","PID20")="20^00123^Drivers License - Patient" 87 S X("PID","PID21")="21^00124^Mother's Identifier" 88 S X("PID","PID22")="22^00125^Ethnic Group" 89 S X("PID","PID23")="23^00126^Birth Place" 90 S X("PID","PID24")="24^00127^Multiple Birth Indicator" 91 S X("PID","PID25")="25^00128^Birth Order" 92 S X("PID","PID26")="26^00129^Citizenship" 93 S X("PID","PID27")="27^00130^Veteran.s Military Status" 94 S X("PID","PID28")="28^00739^Nationality" 95 S X("PID","PID29")="29^00740^Patient Death Date/Time" 96 S X("PID","PID30")="30^00741^Patient Death Indicator" 97 S X("NTE","NTE1")="1^00573^Set ID - NTE" 98 S X("NTE","NTE2")="2^00574^Source of Comment" 99 S X("NTE","NTE3")="3^00575^Comment" 100 S X("ORC","ORC1")="1^00215^Order Control" 101 S X("ORC","ORC2")="2^00216^Placer Order Number" 102 S X("ORC","ORC3")="3^00217^Filler Order Number" 103 S X("ORC","ORC4")="4^00218^Placer Order Number" 104 S X("ORC","ORC5")="5^00219^Order Status" 105 S X("ORC","ORC6")="6^00220^Response Flag" 106 S X("ORC","ORC7")="7^00221^Quantity/Timing" 107 S X("ORC","ORC8")="8^00222^Parent" 108 S X("ORC","ORC9")="9^00223^Date/Time of Transaction" 109 S X("ORC","ORC10")="10^00224^Entered By" 110 S X("ORC","ORC11")="11^00225^Verified By" 111 S X("ORC","ORC12")="12^00226^Ordering Provider" 112 S X("ORC","ORC13")="13^00227^Enterer's Location" 113 S X("ORC","ORC14")="14^00228^Call Back Phone Number" 114 S X("ORC","ORC15")="15^00229^Order Effective Date/Time" 115 S X("ORC","ORC16")="16^00230^Order Control Code Reason" 116 S X("ORC","ORC17")="17^00231^Entering Organization" 117 S X("ORC","ORC18")="18^00232^Entering Device" 118 S X("ORC","ORC19")="19^00233^Action By" 119 S X("OBR","OBR1")="1^00237^Set ID - Observation Request" 120 S X("OBR","OBR2")="2^00216^Placer Order Number" 121 S X("OBR","OBR3")="3^00217^Filler Order Number" 122 S X("OBR","OBR4")="4^00238^Universal Service ID" 123 S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE" 124 S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT" 125 S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM" 126 S X("OBR","OBR5")="5^00239^Priority" 127 S X("OBR","OBR6")="6^00240^Requested Date/Time" 128 S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME" 129 S X("OBR","OBR8")="8^00242^Observation End Date/Time" 130 S X("OBR","OBR9")="9^00243^Collection Volume" 131 S X("OBR","OBR10")="10^00244^Collector Identifier" 132 S X("OBR","OBR11")="11^00245^Specimen Action Code" 133 S X("OBR","OBR12")="12^00246^Danger Code" 134 S X("OBR","OBR13")="13^00247^Relevant Clinical Info." 135 S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time" 136 S X("OBR","OBR15")="15^00249^Specimen Source" 137 S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID" 138 S X("OBR","OBR17")="17^00250^Order Callback Phone Number" 139 S X("OBR","OBR18")="18^00251^Placers Field 1" 140 S X("OBR","OBR19")="19^00252^Placers Field 2" 141 S X("OBR","OBR20")="20^00253^Filler Field 1" 142 S X("OBR","OBR21")="21^00254^Filler Field 2" 143 S X("OBR","OBR22")="22^00255^Results Rpt./Status Change" 144 S X("OBR","OBR23")="23^00256^Charge to Practice" 145 S X("OBR","OBR24")="24^00257^Diagnostic Service Sect" 146 S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS" 147 S X("OBR","OBR26")="26^00259^Parent Result" 148 S X("OBR","OBR27")="27^00221^Quantity/Timing" 149 S X("OBR","OBR28")="28^00260^Result Copies to" 150 S X("OBR","OBR29")="29^00261^Parent Number" 151 S X("OBR","OBR30")="30^00262^Transportation Mode" 152 S X("OBR","OBR31")="31^00263^Reason for Study" 153 S X("OBR","OBR32")="32^00264^Principal Result Interpreter" 154 S X("OBR","OBR33")="33^00265^Assistant Result Interpreter" 155 S X("OBR","OBR34")="34^00266^Technician" 156 S X("OBR","OBR35")="35^00267^Transcriptionist" 157 S X("OBR","OBR36")="36^00268^Scheduled Date/Time" 158 S X("OBR","OBR37")="37^01028^Number of Sample Containers" 159 S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample" 160 S X("OBR","OBR39")="39^01030^Collector.s Comment" 161 S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility" 162 S X("OBR","OBR41")="41^01032^Transport Arranged" 163 S X("OBR","OBR42")="42^01033^Escort Required" 164 S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment" 165 S X("OBX","OBX1")="1^00559^Set ID - OBX" 166 S X("OBX","OBX2")="2^00676^Value Type" 167 S X("OBX","OBX3")="3^00560^Observation Identifier" 168 S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1" 169 S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2" 170 S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3" 171 S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4" 172 S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5" 173 S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6" 174 S X("OBX","OBX4")="4^00769^Observation Sub-Id" 175 S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE" 176 S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS" 177 S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT" 178 S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG" 179 S X("OBX","OBX9")="9^00639^Probability" 180 S X("OBX","OBX10")="10^00565^Nature of Abnormal Test" 181 S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT" 182 S X("OBX","OBX12")="12^00567^Date Last Normal Value" 183 S X("OBX","OBX13")="13^00581^User Defined Access Checks" 184 S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME" 185 S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID" 186 S X("OBX","OBX16")="16^00584^Responsible Observer" 187 S X("OBX","OBX17")="17^00936^Observation Method" 188 K ^TMP("C0CCCR","LABTBL") 189 M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL 190 S ^TMP("C0CCCR","LABTBL",0)="V3" 191 Q -
ccr/trunk/p/C0CPARMS.m
r1544 r1586 1 1 C0CPARMS ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09 ; 6/15/12 3:46pm 2 ;;1.2;C0C;;May 11, 2012;Build 49 3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2008 WorldVistA. 5 4 ; 6 ; This program is free software;you can redistribute it and/or modify7 ; it under the terms of the GNU General Public License as published by8 ; the Free Software Foundation; either version 2 of the License, or9 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 10 9 ; 11 ; This program is distributed in the hope that it will be useful,12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 15 14 ; 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. 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS -
ccr/trunk/p/C0CPROBS.m
r1544 r1586 1 1 C0CPROBS ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License.5 ;See attached copy of the License.6 4 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 16 14 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 21 17 ; 22 18 ; PROCESS THE PROBLEMS SECTION OF THE CCR … … 92 88 ; GENERATE THE NARITIVE HTML FOR THE CCD 93 89 I CCD D CCD ; IF THIS IS FOR A CCD 94 D MISS INGVARS90 D MISSVARS 95 91 Q 96 92 ; … … 149 145 ; GENERATE THE NARITIVE HTML FOR THE CCD 150 146 I CCD D CCD ; IF THIS IS FOR A CCD 151 D MISS INGVARS147 D MISSVARS 152 148 Q 153 CCD 149 CCD ; 154 150 N HTMP,HOUT,HTMLO,C0CPROBI,ZX 155 151 F C0CPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM … … 175 171 D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION 176 172 Q 177 MISS INGVARS173 MISSVARS ; Missing Variables 178 174 N PROBSTMP,I 179 175 D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS -
ccr/trunk/p/C0CPROC.m
r1544 r1586 1 1 C0CPROC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2010 George Lilly, University of Minnesota and others. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 6 3 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.4 ; This program is free software: you can redistribute it and/or modify 5 ; it under the terms of the GNU Affero General Public License as 6 ; published by the Free Software Foundation, either version 3 of the 7 ; License, or (at your option) any later version. 11 8 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.9 ; This program is distributed in the hope that it will be useful, 10 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 11 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 ; GNU Affero General Public License for more details. 16 13 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 14 ; You should have received a copy of the GNU Affero General Public License 15 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 16 ; 21 17 W "NO ENTRY FROM TOP",! … … 112 108 ; CPT^CATEGORY^TEXT 113 109 N Z1,Z2,Z3,ZRTN 114 S Z1=$P(ISTR,U,1) 110 S Z1=$P(ISTR,U,1) 115 111 I Z1="" D ; 116 112 . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1) -
ccr/trunk/p/C0CPXRM.m
r1544 r1586 1 1 C0CPXRM ; 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 DOIT ; 4 S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*)5 S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*)6 S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*)7 S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*)8 S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*)9 S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*)10 S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*)11 S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*)12 S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*)13 S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*)14 S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*)15 S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*)16 S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*)17 S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*)18 S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*)19 S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*)20 S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*)21 S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*)22 S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*)23 S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*)24 S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*)25 S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*)26 S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*)27 S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*)28 S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*)29 S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*)30 S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*)31 S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*)32 S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*)33 S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*)34 S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*)35 S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*)36 S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*)37 S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*)38 S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*)39 S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*)40 S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*)41 S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*)42 S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*)43 S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*)44 S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*)45 S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*)46 S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*)47 S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*)48 S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*)49 S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*)50 S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*)51 S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*)52 S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*)53 S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*)54 S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*)55 S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*)56 S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*)57 S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*)58 S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*)59 S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*)60 S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*)61 S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*)62 S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*)63 S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*)64 S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*)65 S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*)66 S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*)67 S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*)68 S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*)69 S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*)70 S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*)71 S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*)72 S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*)73 Q4 ; S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*) 5 ; S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*) 6 ; S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*) 7 ; S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*) 8 ; S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*) 9 ; S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*) 10 ; S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*) 11 ; S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*) 12 ; S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*) 13 ; S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*) 14 ; S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*) 15 ; S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*) 16 ; S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*) 17 ; S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*) 18 ; S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*) 19 ; S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*) 20 ; S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*) 21 ; S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*) 22 ; S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*) 23 ; S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*) 24 ; S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*) 25 ; S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*) 26 ; S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*) 27 ; S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*) 28 ; S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*) 29 ; S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*) 30 ; S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*) 31 ; S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*) 32 ; S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*) 33 ; S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*) 34 ; S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*) 35 ; S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*) 36 ; S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*) 37 ; S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*) 38 ; S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*) 39 ; S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*) 40 ; S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*) 41 ; S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*) 42 ; S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*) 43 ; S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*) 44 ; S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*) 45 ; S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*) 46 ; S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*) 47 ; S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*) 48 ; S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*) 49 ; S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*) 50 ; S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*) 51 ; S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*) 52 ; S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*) 53 ; S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*) 54 ; S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*) 55 ; S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*) 56 ; S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*) 57 ; S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*) 58 ; S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*) 59 ; S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*) 60 ; S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*) 61 ; S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*) 62 ; S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*) 63 ; S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*) 64 ; S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*) 65 ; S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*) 66 ; S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*) 67 ; S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*) 68 ; S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*) 69 ; S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*) 70 ; S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*) 71 ; S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*) 72 ; S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*) 73 ; Q 74 74 ; -
ccr/trunk/p/C0CQRY1.m
r1544 r1586 1 1 LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99 13:48 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ; 4 4 Q -
ccr/trunk/p/C0CQRY2.m
r1544 r1586 1 LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09 2 ;;1.2;C 0C;;May 11, 2012;Build 471 LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09 ; 10/30/12 10:16am 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ; JMC - mods to check for IHS V LAB file 4 ; 5 ; (C) John McCormack 2009 6 ; 7 ; This program is free software: you can redistribute it and/or modify 8 ; it under the terms of the GNU Affero General Public License as 9 ; published by the Free Software Foundation, either version 3 of the 10 ; License, or (at your option) any later version. 11 ; 12 ; This program is distributed in the hope that it will be useful, 13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ; GNU Affero General Public License for more details. 16 ; 17 ; You should have received a copy of the GNU Affero General Public License 18 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 ; 4 20 ; 5 21 Q -
ccr/trunk/p/C0CRAHL7.m
r1544 r1586 1 1 C0CRAHL7 ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 25/10/2010 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;; 4 Q 5 ;LENGTH OF SEGMENTS COMPROMISED 6 GHL7 ; Loop through ^RADPT with RADFN 7 ; Get Case Number and Reprot Information 8 ; Extract RAD Report as HL7 Message 9 ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ) 10 ; 11 D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT) 12 D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM 13 S C0CCNT=0 14 F S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT) D 15 . S C0CRAIDT=0 16 . F S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0 D 17 . . S C0CRANO=0 18 . . F S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0 D 19 . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0)) 20 . . . Q:C0CRAXAM(0)="" 21 . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT 22 . . . Q:RARPT=""!(RARPT=0) 23 . . . ;Quit if no report information present 24 . . . D SETHL7 25 . . . S C0CSBCNT=0 26 . . . F S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT="" D 27 . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT)) 28 . . . . S C0CCNT=C0CCNT+1 29 ; 30 K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT 31 K C0CRAXAM,C0CCNT,C0CRAEDT 32 Q 33 ; 34 SETHL7 ;SETHL7 SEGMENTS 35 N RASET,RACN0 36 S RASET=0 37 S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) 38 I +$P(RACN0,U,25)=2 D Q ; printset 39 . ; loop through all cases in set and create message 40 . S RASET=1 41 . N RACNI,RAII S RAII=0 42 . F S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0 D 43 . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2 44 . . S RACNI=RAII 45 . . D NEW 46 NEW ; new variables 47 ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global 48 N DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0,VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,DFN 49 N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM 50 S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT) 51 S (HLECH,HL("ECH"))="^~\&" 52 S (HLFS,HL("FS"))="|" 53 S (HLQ,HL("Q"))="""" 54 S DFN=RADFN D DEM^VADPT 55 I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT 56 S RAN=0 57 S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3)) 58 D SETUP,PID,OBR,OBXRPT 59 EXIT ;EXIT FROM NEW 60 K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI 61 Q 62 ; 63 OBR ;Compile 'OBR' Segment 64 S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP" 65 S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP" 66 ; Replace above with following when Imaging can cope with ESC chars 67 ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP" 68 ; Have to use LOCAL code if Broad Procedure - no CPT code 69 I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL" 70 S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_C0COBRFR_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS 71 S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01) 72 S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"") 73 S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown") 74 ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name 75 N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0)) 76 S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0)) 77 S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^") 78 S $P(X1,HLFS,21)=$P(X1,HLFS,21) 79 ; Replace above with following when Imaging can cope with ESC chars 80 ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21)) 81 ; 82 S OBR36=9999999.9999-RADTI 83 S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36) 84 ; 85 S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7)) 86 S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R") 87 ;Principal Result Interpreter = Verifying Physician 88 S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D 89 .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']"" 90 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 91 .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y 92 ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident 93 S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D 94 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']"" 95 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 96 .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y 97 I $P(RACN0,"^",12) D 98 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']"" 99 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 100 .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y 101 ;Technician = Technologist 102 S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D 103 .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q 104 .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q 105 .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']"" 106 .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q 107 .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y 108 ;Transcriptionist 109 S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D 110 .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q 111 .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q 112 .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y 113 ; 114 S RAN=RAN+1 115 I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q 116 S HLA("HLS",RAN)=X1 117 Q 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; 4 ; (C) ELN 2010. 5 ; 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (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 Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 18 ; 19 ; 20 Q 21 ;LENGTH OF SEGMENTS COMPROMISED 22 GHL7 ; Loop through ^RADPT with RADFN 23 ; Get Case Number and Reprot Information 24 ; Extract RAD Report as HL7 Message 25 ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ) 26 ; 27 D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT) 28 D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM 29 S C0CCNT=0 30 F S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT) D 31 . S C0CRAIDT=0 32 . F S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0 D 33 . . S C0CRANO=0 34 . . F S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0 D 35 . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0)) 36 . . . Q:C0CRAXAM(0)="" 37 . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT 38 . . . Q:RARPT=""!(RARPT=0) 39 . . . ;Quit if no report information present 40 . . . D SETHL7 41 . . . S C0CSBCNT=0 42 . . . F S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT="" D 43 . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT)) 44 . . . . S C0CCNT=C0CCNT+1 45 ; 46 K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT 47 K C0CRAXAM,C0CCNT,C0CRAEDT 48 Q 49 ; 50 SETHL7 ;SETHL7 SEGMENTS 51 N RASET,RACN0 52 S RASET=0 53 S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) 54 I +$P(RACN0,U,25)=2 D Q ; printset 55 . ; loop through all cases in set and create message 56 . S RASET=1 57 . N RACNI,RAII S RAII=0 58 . F S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0 D 59 . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2 60 . . S RACNI=RAII 61 . . D NEW 62 NEW ; new variables 63 ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global 64 N DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0,VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,DFN 65 N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM 66 S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT) 67 S (HLECH,HL("ECH"))="^~\&" 68 S (HLFS,HL("FS"))="|" 69 S (HLQ,HL("Q"))="""" 70 S DFN=RADFN D DEM^VADPT 71 I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT 72 S RAN=0 73 S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3)) 74 D SETUP,PID,OBR,OBXRPT 75 EXIT ;EXIT FROM NEW 76 K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI 77 Q 78 ; 79 OBR ;Compile 'OBR' Segment 80 S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP" 81 S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP" 82 ; Replace above with following when Imaging can cope with ESC chars 83 ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP" 84 ; Have to use LOCAL code if Broad Procedure - no CPT code 85 I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL" 86 S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_C0COBRFR_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS 87 S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01) 88 S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"") 89 S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown") 90 ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name 91 N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0)) 92 S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0)) 93 S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^") 94 S $P(X1,HLFS,21)=$P(X1,HLFS,21) 95 ; Replace above with following when Imaging can cope with ESC chars 96 ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21)) 97 ; 98 S OBR36=9999999.9999-RADTI 99 S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36) 100 ; 101 S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7)) 102 S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R") 103 ;Principal Result Interpreter = Verifying Physician 104 S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D 105 .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']"" 106 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 107 .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y 108 ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident 109 S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D 110 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']"" 111 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 112 .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y 113 I $P(RACN0,"^",12) D 114 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']"" 115 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 116 .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y 117 ;Technician = Technologist 118 S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D 119 .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q 120 .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q 121 .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']"" 122 .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q 123 .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y 124 ;Transcriptionist 125 S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D 126 .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q 127 .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q 128 .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y 129 ; 130 S RAN=RAN+1 131 I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q 132 S HLA("HLS",RAN)=X1 133 Q 118 134 OBXRPT ;Compile 'OBX' Segment for Radiology Report Text 119 120 121 122 123 124 PID 125 126 127 128 129 SETUP 130 131 132 133 134 135 136 135 N RATX 136 I '$O(^RARPT(RARPT,"R",0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_"None Entered" D OBX11^RAHLRU Q 137 S RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI I $D(^(RAI,0)) S RATX=RATX_^(0) 138 S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU 139 Q 140 PID ;Compile 'PID' Segment 141 ; 142 S X1="",X1="PID"_HLFS_HLFS_$G(VA("PID"))_HLFS_Y_HLFS_HLFS S X=VADM(1),Y=$$HLNAME^HLFNC(X) S X1=X1_Y_HLFS_HLFS 143 S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O")) S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1 144 Q 145 SETUP ; Setup basic examination information 146 S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) 147 S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0) 148 S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1) 149 S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9) 150 S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT) 151 S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN) 152 Q -
ccr/trunk/p/C0CRARPT.m
r1544 r1586 1 C0CRARPT ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 4 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR 5 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME 6 ; MIXML IS THE TEMPLATE TO USE 7 ; MOXML IS THE OUTPUT XML ARRAY 8 ; DFN IS THE PATIENT RECORD NUMBER 9 N C0COXML,C0CO,C0CV,C0CIXML 10 I '$D(MIVAR) S C0CV="" ;DEFAULT 11 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY 12 I '$D(MIXML) S C0CIXML="" ;DEFAULT 13 E S C0CIXML=MIXML ;PASSED INPUT XML 14 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK 15 I '$D(MOXML) D Q 16 . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT 17 . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT 18 E D 19 . N C0COOXML 20 . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) 21 . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML") 22 . S C0COCNT=$O(C0CRSXML(""),-1) 23 . S C0CRES=0 24 . F S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES="" D 25 . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>") 26 . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES)) 27 . . S C0COCNT=C0COCNT+1 28 . S C0CRSXML(C0COCNT)="</Results>" 29 . S C0CRSXML(0)=C0COCNT 30 . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 31 . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body") 32 S C0CO=MOXML,@C0CO@(0)=0 33 K C0CRSXML,C0COCNT,C0COXML,C0CRES 34 Q 35 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 36 ; RTN IS PASSED BY REFERENCE 37 N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES 38 N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE 39 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING 40 I RMIXML="" D ; INPUT XML NOT PASSED 41 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE 42 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R") 43 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE 44 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE 45 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED 46 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION 47 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS 48 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE 49 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ 50 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE 51 D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT 52 I '$D(@C0CV@(0)) D Q ; NO VARS THERE 53 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR 54 ; NO RESULTS 55 I @C0CV@(0)=0 S RTN(0)=0 Q 56 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) 57 K @RIMVARS 58 M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH 59 N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP 60 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR) 61 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT 62 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA 63 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END 64 ; TO IMPROVE PERFORMANCE 65 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results> 66 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES 67 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES 68 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST 69 . S C0CMAP=$NA(@C0CV@(C0CI)) ; 70 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA 71 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test> 72 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST 73 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS 74 . . K C0CTO ; CLEAR OUTPUT VARIABLE 75 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT 76 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS 77 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS 78 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ; 79 . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP 80 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test> 81 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test> 82 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML 83 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST 84 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result> 85 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results> 86 D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML 87 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE 88 Q 89 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL 90 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS 91 S RADFN=DFN 92 D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT 93 ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY 94 N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG 95 S C0CQT=1 ; SURPRESS LISTING 96 D LIST ; EXTRACT THE VARIABLES 97 ;S C0CQT=QTSAV ; RESET SILENT FLAG 98 K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT 99 K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN 100 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS 101 Q 102 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB 103 N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP 104 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 105 I '$D(C0CQT) S C0CQT=0 106 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT 107 I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D 108 . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE 109 . K ^TMP("C0CCCR","RATBL") 110 . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL") 111 I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE 112 S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE 113 S C0CHB=$NA(^TMP("HLS",$J)) 114 S C0CI="" 115 S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT 116 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG 117 . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES 118 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1) 119 . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT) 120 . M XV=C0CVAR ; 121 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION 122 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT 123 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT 124 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS 125 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI 126 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR 127 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1) 128 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT 129 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 130 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 131 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS 132 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION 133 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3 134 . . ; RESULTTESTCODEVALUE 135 . . ; RESULTTESTDESCRIPTIONTEXT 136 . . I C0CVAR("C3")="C4" D ; PRIMARY CODE "CPT" 137 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE 138 . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT 139 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT 140 . . E I C0CVAR("C6")'="" D ; NO CPT CODES, USE SECONDARY IF PRESENT 141 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE 142 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME 143 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT 144 . . E D ; NO SECONDARY, USE PRIMARY 145 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE 146 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME 147 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT 148 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ; 149 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG 150 . . S C0CZG=XV("RESULTTESTVALUE") 151 . . S XV("RESULTTESTVALUE")=C0CZG 152 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION 153 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS 154 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT 155 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT 156 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX 157 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE 158 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER 159 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2 160 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID") 161 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT 162 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 163 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 164 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES 165 K XV,C0CZG,C0CX1,C0CX2,C0CVAR 166 Q 1 C0CRARPT ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; 4 ; (C) ELN 2010 5 ; 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (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 Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 18 ; 19 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 20 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR 21 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME 22 ; MIXML IS THE TEMPLATE TO USE 23 ; MOXML IS THE OUTPUT XML ARRAY 24 ; DFN IS THE PATIENT RECORD NUMBER 25 N C0COXML,C0CO,C0CV,C0CIXML 26 I '$D(MIVAR) S C0CV="" ;DEFAULT 27 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY 28 I '$D(MIXML) S C0CIXML="" ;DEFAULT 29 E S C0CIXML=MIXML ;PASSED INPUT XML 30 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK 31 I '$D(MOXML) D Q 32 . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT 33 . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT 34 E D 35 . N C0COOXML 36 . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) 37 . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML") 38 . S C0COCNT=$O(C0CRSXML(""),-1) 39 . S C0CRES=0 40 . F S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES="" D 41 . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>") 42 . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES)) 43 . . S C0COCNT=C0COCNT+1 44 . S C0CRSXML(C0COCNT)="</Results>" 45 . S C0CRSXML(0)=C0COCNT 46 . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 47 . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body") 48 S C0CO=MOXML,@C0CO@(0)=0 49 K C0CRSXML,C0COCNT,C0COXML,C0CRES 50 Q 51 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 52 ; RTN IS PASSED BY REFERENCE 53 N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES 54 N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE 55 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING 56 I RMIXML="" D ; INPUT XML NOT PASSED 57 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE 58 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R") 59 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE 60 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE 61 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED 62 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION 63 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS 64 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE 65 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ 66 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE 67 D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT 68 I '$D(@C0CV@(0)) D Q ; NO VARS THERE 69 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR 70 ; NO RESULTS 71 I @C0CV@(0)=0 S RTN(0)=0 Q 72 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) 73 K @RIMVARS 74 M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH 75 N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP 76 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR) 77 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT 78 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA 79 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END 80 ; TO IMPROVE PERFORMANCE 81 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results> 82 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES 83 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES 84 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST 85 . S C0CMAP=$NA(@C0CV@(C0CI)) ; 86 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA 87 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test> 88 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST 89 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS 90 . . K C0CTO ; CLEAR OUTPUT VARIABLE 91 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT 92 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS 93 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS 94 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ; 95 . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP 96 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test> 97 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test> 98 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML 99 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST 100 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result> 101 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results> 102 D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML 103 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE 104 Q 105 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL 106 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS 107 S RADFN=DFN 108 D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT 109 ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY 110 N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG 111 S C0CQT=1 ; SURPRESS LISTING 112 D LIST ; EXTRACT THE VARIABLES 113 ;S C0CQT=QTSAV ; RESET SILENT FLAG 114 K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT 115 K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN 116 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS 117 Q 118 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB 119 N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP 120 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 121 I '$D(C0CQT) S C0CQT=0 122 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT 123 I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D 124 . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE 125 . K ^TMP("C0CCCR","RATBL") 126 . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL") 127 I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE 128 S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE 129 S C0CHB=$NA(^TMP("HLS",$J)) 130 S C0CI="" 131 S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT 132 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG 133 . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES 134 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1) 135 . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT) 136 . M XV=C0CVAR ; 137 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION 138 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT 139 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT 140 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS 141 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI 142 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR 143 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1) 144 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT 145 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 146 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 147 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS 148 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION 149 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3 150 . . ; RESULTTESTCODEVALUE 151 . . ; RESULTTESTDESCRIPTIONTEXT 152 . . I C0CVAR("C3")="C4" D ; PRIMARY CODE "CPT" 153 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE 154 . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT 155 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT 156 . . E I C0CVAR("C6")'="" D ; NO CPT CODES, USE SECONDARY IF PRESENT 157 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE 158 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME 159 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT 160 . . E D ; NO SECONDARY, USE PRIMARY 161 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE 162 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME 163 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT 164 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ; 165 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG 166 . . S C0CZG=XV("RESULTTESTVALUE") 167 . . S XV("RESULTTESTVALUE")=C0CZG 168 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION 169 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS 170 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT 171 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT 172 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX 173 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE 174 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER 175 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2 176 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID") 177 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT 178 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 179 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 180 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES 181 K XV,C0CZG,C0CX1,C0CX2,C0CVAR 182 Q -
ccr/trunk/p/C0CRIMA.m
r1544 r1586 1 1 C0CRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 17 ; 21 18 ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE … … 100 97 . W "CATEGORY NAME: ",CATNAME,! 101 98 . ; 102 . F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT99 . F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT 103 100 . ; PTST TESTS TO SEE IF PATIENT WAS MERGED 104 101 . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT … … 386 383 I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES 387 384 S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES 388 I '$D(@ZVBASE@(DFN,ISEC,0)) D Q ; NO VARIABLES IN SECTION385 I '$D(@ZVBASE@(DFN,ISEC,0)) D Q ; NO VARIABLES IN SECTION 389 386 . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,! 390 387 N ZZI,ZZS … … 420 417 N ZNC ; ZNC IS NUMBER OF CATEGORIES 421 418 S ZNC=@ZCBASE@(0) 422 I ZNC=0 Q ; NO CATEGORIES TO SEARCH419 I ZNC=0 Q ; NO CATEGORIES TO SEARCH 423 420 N ZAP ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE 424 421 S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR) -
ccr/trunk/p/C0CRNF.m
r1544 r1586 1 1 C0CRNF ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "This is the Reference Name Format (RNF) Utility Library ",! … … 29 27 S C0CFI=0 S C0CFJ=C0CF 30 28 K @C0CFRTN ; CLEAR THE RETURN ARRAY 31 F Q:C0CFJ'[C0CF D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE29 F Q:C0CFJ'[C0CF D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE 32 30 . ;W "1: "_C0CFJ," ",C0CFI,! 33 31 . F S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0 D ; EVERY FIELD … … 53 51 S G1("THREE")=3 54 52 D RNF1TO2("GPL","G1") 55 ZWR GPL53 ; ZWR GPL 56 54 Q 57 55 ; -
ccr/trunk/p/C0CRNFRP.m
r1544 r1586 1 1 C0CRNFRP ; CCDCCR/GPL - Reference Name Format (RNF) RPCs; 12/9/09 ; 5/10/12 2:56pm 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "This is the Reference Name Format (RNF) RPC Library ",! -
ccr/trunk/p/C0CRPMS.m
r1544 r1586 1 1 C0CRPMS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR RPMS ;1/14/09 14:33 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2008 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 5 3 ; 6 ; This program is free software;you can redistribute it and/or modify7 ; it under the terms of the GNU General Public License as published by8 ; the Free Software Foundation; either version 2 of the License, or9 ; (at your option) any later version.4 ; This program is free software: you can redistribute it and/or modify 5 ; it under the terms of the GNU Affero General Public License as 6 ; published by the Free Software Foundation, either version 3 of the 7 ; License, or (at your option) any later version. 10 8 ; 11 ; This program is distributed in the hope that it will be useful,12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ; GNUGeneral Public License for more details.9 ; This program is distributed in the hope that it will be useful, 10 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 11 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 ; GNU Affero General Public License for more details. 15 13 ; 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. 14 ; You should have received a copy of the GNU Affero General Public License 15 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 16 ; 20 17 W "NO ENTRY FROM TOP",! … … 27 24 VTYPES ; 28 25 D GETN2^C0CRNF("G1",9999999.07) 29 ZWR G126 ; ZWR G1 30 27 Q 31 28 ; … … 92 89 . W "PAT: ",C0CG,! 93 90 . D GETNV^C0CRPMS(C0CG) 94 . K X R X 91 . K X R X:DTIME 95 92 . I X="Q" S C0CQ=1 ; QUIT IF Q 96 93 Q -
ccr/trunk/p/C0CRXN.m
r1544 r1586 1 1 C0CRXN ; CCDCCR/GPL - CCR RXN utilities; 12/6/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "This is the CCR RXNORM Utility Library ",! … … 53 51 . . ;D SETFDA("VUID",$$ZVALUE("VUID")) 54 52 . E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT")) 55 . .;ZWR C0CA53 . ;ZWR C0CA 56 54 . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL") 57 55 . I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND … … 74 72 . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD 75 73 . D UPDATE^DIE("","C0CFDA") 76 . I $D(^TMP("DIERR",$J)) U $P BREAK74 . I $D(^TMP("DIERR",$J)) S $EC=",U1," 77 75 W "HAS RXN=",HASRXN,! 78 76 W "NO RXN=",NORXN,! … … 150 148 . S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD 151 149 . D UPDATE^DIE("","C0CFDA") 152 . I $D(^TMP("DIERR",$J)) U $P BREAK150 . I $D(^TMP("DIERR",$J)) S $EC=",U1," 153 151 W "VA MAPPING VUID COUNT: ",VAVCNT,! 154 152 W "VA MAPPING MISSING: ",VANO,! … … 216 214 Q 217 215 ; 216 D 218 217 . I $$ZVALUE("MEDIATION CODE")="" D 219 218 . . S NORXN=NORXN+1 ; … … 225 224 . . ;D SETFDA("VUID",$$ZVALUE("VUID")) 226 225 . E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT")) 227 . .;ZWR C0CA226 . ;ZWR C0CA 228 227 . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL") 229 228 . I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND … … 245 244 . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD 246 245 . D UPDATE^DIE("","C0CFDA") 247 . I $D(^TMP("DIERR",$J)) U $P BREAK246 . I $D(^TMP("DIERR",$J)) S $EC=",U1," 248 247 W "HAS RXN=",HASRXN,! 249 248 W "NO RXN=",NORXN,! -
ccr/trunk/p/C0CRXNRD.m
r1544 r1586 1 1 C0CRXNRD ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; Copyright Sam Habiel 2008. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 3 18 W "No entry from top" Q 4 IMPORT(PATH) 19 IMPORT(PATH) ; Main entry point 5 20 I PATH="" QUIT 6 21 D READSRC(PATH),READCON(PATH),READNDC(PATH) … … 21 36 U IO 22 37 N I 23 F I=1:1 R LINE Q:$$STATUS^%ZISH38 F I=1:1 R LINE:0 Q:$$STATUS^%ZISH 24 39 D CLOSE^%ZISH("FILE") 25 40 Q I-1 … … 37 52 F C0CCOUNT=1:1 D Q:$$STATUS^%ZISH 38 53 . U IO 39 . N LINE R LINE 54 . N LINE R LINE:0 40 55 . IF $$STATUS^%ZISH QUIT 41 56 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 … … 82 97 F C0CCOUNT=1:1 Q:$$STATUS^%ZISH D 83 98 . U IO 84 . N LINE R LINE 99 . N LINE R LINE:0 85 100 . IF $$STATUS^%ZISH QUIT 86 101 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 … … 106 121 F I=1:1 Q:$$STATUS^%ZISH D 107 122 . U IO 108 . N LINE R LINE 123 . N LINE R LINE:0 109 124 . IF $$STATUS^%ZISH QUIT 110 125 . U $P W I,! U IO ; Write I to the screen, then go back to reading the file … … 141 156 EX3 D CLOSE^%ZISH("FILE") 142 157 Q 143 -
ccr/trunk/p/C0CSNOA.m
r1544 r1586 1 1 C0CSNOA ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License.5 ;See attached copy of the License.6 4 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 16 14 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 ; THESE ROUTINES ANALYZE THE POTENTIAL RETRIEVAL OF SNOMED CT CODES 22 ; FOR PATIENT DRUG ALLERGIES FOR INCLUSION IN THE CCR OR CCD 23 ; USING THE VISTA LEXICON ^LEX 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 24 17 ; 25 18 ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 .I $D(SNORTN) ZWR SNORTN47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 19 ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD 20 ; TO RESUME AT NEXT DRUG, USE BEGIEN="" 21 ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST 22 ; 23 N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR 24 N CCRGLO 25 D ASETUP ; SET UP VARIABLES AND GLOBALS 26 D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE 27 I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME 28 S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN 29 S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD 30 I SNOIEN="" S SNOIEN=RESUME 31 I +SNOIEN=0 D Q ; AT THE END OF THE ALLERGY LIST 32 . W "END OF DRUG LIST, CALL RESET^C0CSNOA",! 33 F SNOI=1:1:IENCNT D Q:+SNOIEN=0 ; FOR IENCNT NUMBER OF PATIENTS OR END 34 . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR 35 . W SNOIEN,@GMRBASE@(SNOIEN,0),! 36 . N SNORTN,TTERM ; RETURN ARRAY 37 . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY" 38 . D TEXTRPC(.SNORTN,TTERM) 39 . ; I $D(SNORTN) ZWR SNORTN 40 . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS 41 . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0) 42 . ; 43 . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP 44 . ; 45 . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS 46 . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG 47 . ; 48 . N CATNAME,CATTBL 49 . S CATNAME="" 50 . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY 51 . ; W "CATEGORY NAME: ",CATNAME,! 52 . ; 53 . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD 54 . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN 55 ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL")) 56 Q 57 ; 65 58 TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN 66 59 ; … … 71 64 ; 72 65 ASETUP ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL 73 74 75 76 77 78 79 66 I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO")) 67 I '$D(@SNOBASE) S @SNOBASE="" 68 I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82)) 69 I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE 70 S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES 71 Q 72 ; 80 73 AINIT ; INITIALIZE ATTRIBUTE TABLE 81 82 83 84 85 86 87 88 74 I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS 75 K @SNOTBL 76 D APUSH^C0CRIMA(SNOTBL,"CODE") 77 D APUSH^C0CRIMA(SNOTBL,"NOCODE") 78 D APUSH^C0CRIMA(SNOTBL,"MULTICODE") 79 D APUSH^C0CRIMA(SNOTBL,"SUBMULTI") 80 D APUSH^C0CRIMA(SNOTBL,"DONE") 81 Q 89 82 APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL 90 91 92 93 94 95 96 97 98 99 83 ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING 84 ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES 85 ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL)) 86 I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING 87 N USETBL 88 I '$D(@SNOBASE@("TABLES",PTBL)) D Q ; NO TABLE 89 . W "ERROR NO SUCH TABLE",! 90 S USETBL=@SNOBASE@("TABLES",PTBL) 91 S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL 92 Q 100 93 SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 94 N SBASE,SATTR 95 S SBASE=$NA(@SNOBASE@("VARS",SDFN)) 96 D APOST("SATTR","SNOTBL","DONE") 97 I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE") 98 I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE") 99 Q SATTR ; C0C 100 I $D(@SBASE@("PROBLEMS",1)) D ; 101 . D APOST("SATTR","SNOTBL","PROBLEMS") 102 . ; W "POSTING PROBLEMS",! 103 I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS") 104 I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES 105 . D APOST("SATTR","SNOTBL","MEDS") 106 . N ZR,ZI 107 . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES 108 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN 109 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS 110 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES 111 . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES 112 D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED 113 ; W "ATTRIBUTES: ",SATTR,! 114 Q SATTR 115 ; 123 116 RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES 124 125 126 127 117 K ^TMP("C0CSNO","RESUME") 118 K ^TMP("C0CSNO") 119 Q 120 ; 128 121 CLIST ; LIST THE CATEGORIES 129 130 131 132 133 134 135 136 137 138 139 140 141 122 ; 123 I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS 124 N CLBASE,CLNUM,ZI,CLIDX 125 S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS")) 126 S CLNUM=@CLBASE@(0) 127 F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES 128 . S CLIDX=@CLBASE@(ZI) 129 . W "(",$P(@CLBASE@(CLIDX),"^",1) 130 . W ":",$P(@CLBASE@(CLIDX),"^",2),") " 131 . W CLIDX,! 132 ; D PARY^C0CXPATH(CLBASE) 133 Q 134 ; 142 135 CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES 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 136 ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT 137 ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE 138 ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME 139 ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES, 140 ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X" 141 ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES 142 ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY 143 ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING 144 ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY 145 ; NUMBER IE CTBL_X(CDFN)="" 146 ; 147 ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST 148 S CCTBL=$NA(@CBASE@(CTBL,"CATS")) 149 ; W "CBASE: ",CCTBL,! 150 ; 151 I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY 152 . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY 153 . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY 154 . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT 155 . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY 156 . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME 157 . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0 158 ; 159 S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY 160 S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT 161 S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK 162 ; 163 S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED 164 ; 165 S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT 166 ; W "IENS BASE: ",CPATLIST,! 167 S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST 168 ; 169 Q 170 ; 178 171 REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE 179 172 ; … … 183 176 S SAVBASE=$NA(^TMP("C0CSAV","VARS")) 184 177 S SNOI="" 185 F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST178 F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST 186 179 . S SNOI=$O(@SAVBASE@(SNOI)) 187 180 . S SNOJ=@SAVBASE@(SNOI) -
ccr/trunk/p/C0CSOAP.m
r1544 r1586 1 1 C0CSOAP ; CCDCCR/GPL - SOAP WEB SERVICE utilities; 8/25/09 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2008 George Lilly. 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2008 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "This is an SOAP utility library",! -
ccr/trunk/p/C0CSQMB.m
r1544 r1586 1 1 C0CSQMB ; SQMCCR/ELN - BATCH PROGRAM ;16/11/2010 2 ;;1.2;C0C;;May 11, 2012;Build 47 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; (C) 2010 ELN 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 3 17 ; 4 18 EN ;Traverse the DPT global and export CCR xml for each DFN -
ccr/trunk/p/C0CSUB1.m
r1544 r1586 1 1 C0CSUB1 ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 5 4 ; 6 ; This program is free software;you can redistribute it and/or modify7 ; it under the terms of the GNU General Public License as published by8 ; the Free Software Foundation; either version 2 of the License, or9 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 10 9 ; 11 ; This program is distributed in the hope that it will be useful,12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 15 14 ; 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. 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "This is the CCR SUBSCRIPTIONN Utility Library ",! … … 29 27 S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS 30 28 S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT 31 K C0CFDA 29 K C0CFDA 32 30 S C0CALL=$G(@C0CCHK@(DFN,"ALL")) 33 31 I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL 34 E Q ; NO CHECKSUMS FOR THISPATIENT32 E Q ; NO CHECKSUMS FOR THISPATIENT 35 33 D UPDIE 36 34 N C0CJ S C0CJ="" 37 35 F S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ="" D ; FOR EACH DOMAIN 38 . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,"")) 36 . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,"")) 39 37 . W C0CJ," ",C0CD,! 40 38 . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD … … 70 68 D CLEAN^DILF 71 69 D UPDATE^DIE("","C0CFDA","","ZERR") 72 I $D(ZERR) D ; 73 . W "ERROR",! 74 . ZWR ZERR 75 . B 70 I $D(ZERR) S $EC=",U1," 76 71 K C0CFDA 77 72 Q -
ccr/trunk/p/C0CSYS.m
r1544 r1586 1 1 C0CSYS ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008 2 ;;1.2;C0C;;May 11, 2012;Build 47 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 ; 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; Copyright 2008 WorldVistA. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 11 10 ; This program is distributed in the hope that it will be useful, 12 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 12 ; 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. 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "Enter at appropriate points." Q -
ccr/trunk/p/C0CTIU.m
r1544 r1586 1 1 C0CTIU ; C0C/ELN - PROCESSING FOR TIU NOTES ; 19/10/2010 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ; 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; (C) ELN 2010 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 4 17 ; 5 18 ;ELN - Modified Routine of C0CLABS -
ccr/trunk/p/C0CTIU1.m
r1544 r1586 1 1 C0CTIU1 ; C0C/ELN - PROCESSING FOR TIU NOTES Contd. ; 19/10/2010 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;ELN UTILITY PROGRAM TO SUPPORT C0CTIU 4 ; (C) ELN 2010. 5 ; 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (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 Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 18 ; 4 19 C0CDATE(EDTE) ; Converts external date to internal date format 5 20 ; INPUT : EXTERNAL DATE (TIME IS OPTIONAL) -
ccr/trunk/p/C0CUNIT.m
r1544 r1586 1 1 C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2008 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2008 George Lilly. 5 4 ; 6 ; This program is free software;you can redistribute it and/or modify7 ; it under the terms of the GNU General Public License as published by8 ; the Free Software Foundation; either version 2 of the License, or9 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 10 9 ; 11 ; This program is distributed in the hope that it will be useful,12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 15 14 ; 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. 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 21 22 23 18 W "This is a unit testing library",! 19 W ! 20 Q 21 ; 24 22 ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 23 ; ZARY IS PASSED BY REFERENCE 24 ; BAT is a string identifying the test battery 25 ; TST is a test which will evaluate to true or false 26 ; I '$G(ZARY) D 27 ; . S ZARY(0)=0 ; initially there are no elements 28 ; W "GOT HERE LOADING "_TST,! 29 N CNT ; count of array elements 30 S CNT=ZARY(0) ; contains array count 31 S CNT=CNT+1 ; increment count 32 S ZARY(CNT)=TST ; put the test in the array 33 I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY 34 . N II,TN ; TEMP FOR ENDING TEST IN BATTERY 35 . S II=$P(ZARY(BAT),"^",2) 36 . S $P(ZARY(BAT),"^",2)=II+1 37 I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY 38 . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY 39 . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX 40 . ; S TN=$NA(ZARY("TESTS")) 41 . ; D PUSH^C0CXPATH(TN,BAT) 42 S ZARY(0)=CNT ; update the array counter 43 Q 44 ; 47 45 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 46 ; ZARY IS PASSED BY NAME 47 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") 48 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE 49 K @ZARY 50 S @ZARY@(0)=0 ; initialize array count 51 N LINE,LABEL,BODY 52 N INTEST S INTEST=0 ; switch for in the test case section 53 N SECTION S SECTION="[anonymous]" ; test case section 54 ; 55 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D 56 . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section 57 . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section 58 . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section 59 . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section 60 . I INTEST D ; within the testing section 61 . . I LINE?." "1";;><".E D ; section name found 62 . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name 63 . . I LINE?." "1";;>>".E D ; test case found 64 . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array 65 S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL 66 Q 67 ; 70 68 ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST 71 72 73 74 75 76 77 78 79 80 81 I '$D(ZARY(WHICH)) D Q; TEST SECTION DOESN'T EXIST82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 69 N ZI,ZX,ZR,ZP 70 S DEBUG=0 71 ; I WHICH="ALL" D Q ; RUN ALL THE TESTS 72 ; . W "DOING ALL",! 73 ; . N J,NT 74 ; . S NT=$NA(ZARY("TESTS")) 75 ; . W NT,@NT@(0),! 76 ; . F J=1:1:@NT@(0) D ; 77 ; . . W @NT@(J),! 78 ; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J)) 79 I '$D(ZARY(WHICH)) D Q ; TEST SECTION DOESN'T EXIST 80 . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,! 81 N FIRST,LAST 82 S FIRST=$P(ZARY(WHICH),"^",1) 83 S LAST=$P(ZARY(WHICH),"^",2) 84 F ZI=FIRST:1:LAST D 85 . I ZARY(ZI)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT 86 . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI))) 87 . . ; W ZP,! 88 . . S ZX=ZP 89 . . W "RUNNING: "_ZP 90 . . X ZX 91 . . W "..SUCCESS: ",WHICH,! 92 . I ZARY(ZI)?1"?"1.E D ; THIS IS A TEST 93 . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI))) 94 . . S ZX="S ZR="_ZP 95 . . W "TRYING: "_ZP 96 . . X ZX 97 . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),! 98 . . I '$D(TPASSED) D ; NOT INITIALIZED YET 99 . . . S TPASSED=0 S TFAILED=0 100 . . I ZR S TPASSED=TPASSED+1 101 . . I 'ZR S TFAILED=TFAILED+1 102 Q 103 ; 106 104 TEST ; RUN ALL THE TEST CASES 107 108 109 110 111 112 113 114 115 116 105 N ZTMP 106 D ZLOAD(.ZTMP) 107 D ZTEST(.ZTMP,"ALL") 108 W "PASSED: ",TPASSED,! 109 W "FAILED: ",TFAILED,! 110 W ! 111 W "THE TESTS!",! 112 ; I DEBUG ZWR ZTMP 113 Q 114 ; 117 115 GTSTS(GTZARY,RTN) ; return an array of test names 118 119 120 121 122 123 116 N I,J S I="" S I=$O(GTZARY("TESTS",I)) 117 F J=0:0 Q:I="" D 118 . D PUSH^C0CXPATH(RTN,I) 119 . S I=$O(GTZARY("TESTS",I)) 120 Q 121 ; 124 122 TESTALL(RNM) ; RUN ALL THE TESTS 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 123 N ZI,J,TZTMP,TSTS,TOTP,TOTF 124 S TOTP=0 S TOTF=0 125 D ZLOAD^C0CUNIT("TZTMP",RNM) 126 D GTSTS(.TZTMP,"TSTS") 127 F ZI=1:1:TSTS(0) D ; 128 . S TPASSED=0 S TFAILED=0 129 . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI)) 130 . S TOTP=TOTP+TPASSED 131 . S TOTF=TOTF+TFAILED 132 . S $P(TSTS(ZI),"^",2)=TPASSED 133 . S $P(TSTS(ZI),"^",3)=TFAILED 134 F ZI=1:1:TSTS(0) D ; 135 . W "TEST=> ",$P(TSTS(ZI),"^",1) 136 . W " PASSED=>",$P(TSTS(ZI),"^",2) 137 . W " FAILED=>",$P(TSTS(ZI),"^",3),! 138 W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,! 139 Q 140 ; 143 141 TLIST(ZARY) ; LIST ALL THE TESTS 144 145 146 147 148 149 150 151 152 153 154 155 156 157 MEDS 142 ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES 143 ; ZARY IS PASSED BY REFERENCE 144 N I,J,K S I="" S I=$O(ZARY("TESTS",I)) 145 S K=1 146 F J=0:0 Q:I="" D 147 . ; W "I IS NOW=",I,! 148 . W I," " 149 . S I=$O(ZARY("TESTS",I)) 150 . S K=K+1 I K=6 D 151 . . W ! 152 . . S K=1 153 Q 154 ; 155 MEDS ; 158 156 N DEBUG S DEBUG=0 159 157 N DFN S DFN=5685 … … 172 170 D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml") 173 171 Q 174 PAT 172 PAT ; 175 173 D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory 176 174 N X,Y -
ccr/trunk/p/C0CUTIL.m
r1544 r1586 1 1 C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008-2009 Sam Habiel & George Lilly. 4 ;Licensed under the terms of the GNU5 ;General Public License See attached copy of the License.6 4 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 16 14 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 17 ; 21 18 W "No Entry at Top!" … … 23 20 ; 24 21 UUID() ; thanks to Wally for this. 25 N R,I,J,N26 S N="",R="" F S N=N_$R(100000) Q:$L(N)>6427 F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1))28 22 N R,I,J,N 23 S N="",R="" F S N=N_$R(100000) Q:$L(N)>64 24 F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1)) 25 Q $E(R,1,8)_"-"_$E(R,9,12)_"-4"_$E(R,14,16)_"-"_$E("89ab",$E(N,17)#4+1)_$E(R,18,20)_"-"_$E(R,21,32) 29 26 ; 30 27 OLDUUID() ; GENERATE A RANDOM UUID (Version 4) … … 40 37 ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC 41 38 ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters) 42 N UTC,Y,M,D,H,MM,S,OFF 39 N UTC,Y,M,D,H,MM,S,OFF,OFFS,OFF0,OFF1,OFF2 43 40 S Y=1700+$E(DATE,1,3) 44 41 S M=$E(DATE,4,5) … … 173 170 OV() ; Are we running on OpenVista? 174 171 Q $G(DUZ("AG"))="O" ; Code for OpenVista 175 -
ccr/trunk/p/C0CVA200.m
r1544 r1586 1 1 C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2008 Sam Habiel. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2008 Sam Habiel. 5 4 ; 6 ; This program is free software;you can redistribute it and/or modify7 ; it under the terms of the GNU General Public License as published by8 ; the Free Software Foundation; either version 2 of the License, or9 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 10 9 ; 11 ; This program is distributed in the hope that it will be useful,12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 15 14 ; 16 ; You should have received a copy of the GNU General Public License along17 ; with this program; if not, write to the Free Software Foundation, Inc.,18 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 19 18 Q 20 19 ; This routine uses Kernel APIs and Direct Global Access to get -
ccr/trunk/p/C0CVALID.m
r1544 r1586 1 1 C0CVALID ; C0C/OHUM/RUT - PROCESSING FOR DATE LIMITS, NOTES ; 22/12/2011 2 ;;1.2;C0C;;May 11, 2012;Build 47;Build 2 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50;Build 2 3 ; (C) RUT 2011. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 3 18 S ^TMP("C0CCCR","LABLIMIT")="",^TMP("C0CCCR","VITLIMIT")="",^TMP("C0CCCR","MEDLIMIT")="",^TMP("C0CCCR","TIULIMIT")="" 4 19 S %DT="AEX",%DT("A")="LAB Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","LABLIMIT")=Y -
ccr/trunk/p/C0CVIT2.m
r1544 r1586 1 1 C0CVIT2 ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ;Copyright 2008,2009 George Lilly, University of Minnesota and others. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 17 ; 21 18 W "NO ENTRY FROM TOP",! … … 66 63 I '$D(VIT) S @VITOUT@(0)=0 K VIT Q ; RETURN NOT FOUND, KILL ARRAY AND QUIT 67 64 I $P(VIT(1),U,2)="No vitals found." D Q ; signal no vitals and quit 68 . I $D(VITOUT) S @VITOUT@(0)=0 65 . I $D(VITOUT) S @VITOUT@(0)=0 69 66 . K VIT 70 67 ; … … 168 165 Q 169 166 ; 170 HEIGHT 167 HEIGHT ; 171 168 I DEBUG W "IN VITAL: HEIGHT",! 172 169 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID … … 185 182 Q 186 183 ; 187 WEIGHT 184 WEIGHT ; 188 185 I DEBUG W "IN VITAL: WEIGHT",! 189 186 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 202 199 Q 203 200 ; 204 BP 201 BP ; 205 202 I DEBUG W "IN VITAL: BLOOD PRESSURE",! 206 203 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 219 216 Q 220 217 ; 221 TMP 218 TMP ; 222 219 I DEBUG W "IN VITAL: TEMPERATURE",! 223 220 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 236 233 Q 237 234 ; 238 RESP 235 RESP ; 239 236 I DEBUG W "IN VITAL: RESPIRATION",! 240 237 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 253 250 Q 254 251 ; 255 PULSE 252 PULSE ; 256 253 I DEBUG W "IN VITAL: PULSE",! 257 254 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 270 267 Q 271 268 ; 272 PAIN 269 PAIN ; 273 270 I DEBUG W "IN VITAL: PAIN",! 274 271 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 287 284 Q 288 285 ; 289 OTHER 286 OTHER ; 290 287 I DEBUG W "IN VITAL: OTHER",! 291 288 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 305 302 ; 306 303 ;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE) 307 HEIGHT1(DT,ACTOR,VALUE,UNIT) 304 HEIGHT1(DT,ACTOR,VALUE,UNIT) ; 308 305 I DEBUG W "IN VITAL: HEIGHT",! 309 306 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID … … 322 319 Q 323 320 ; 324 WEIGHT1(DT,ACTOR,VALUE,UNIT) 321 WEIGHT1(DT,ACTOR,VALUE,UNIT) ; 325 322 I DEBUG W "IN VITAL: WEIGHT",! 326 323 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 339 336 Q 340 337 ; 341 BP1(DT,ACTOR,VALUE,UNIT) 338 BP1(DT,ACTOR,VALUE,UNIT) ; 342 339 I DEBUG W "IN VITAL: BLOOD PRESSURE",! 343 340 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 356 353 Q 357 354 ; 358 TMP1(DT,ACTOR,VALUE,UNIT) 355 TMP1(DT,ACTOR,VALUE,UNIT) ; 359 356 I DEBUG W "IN VITAL: TEMPERATURE",! 360 357 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 373 370 Q 374 371 ; 375 RESP1(DT,ACTOR,VALUE,UNIT) 372 RESP1(DT,ACTOR,VALUE,UNIT) ; 376 373 I DEBUG W "IN VITAL: RESPIRATION",! 377 374 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 390 387 Q 391 388 ; 392 PULSE1(DT,ACTOR,VALUE,UNIT) 389 PULSE1(DT,ACTOR,VALUE,UNIT) ; 393 390 I DEBUG W "IN VITAL: PULSE",! 394 391 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 407 404 Q 408 405 ; 409 PAIN1(DT,ACTOR,VALUE,UNIT) 406 PAIN1(DT,ACTOR,VALUE,UNIT) ; 410 407 I DEBUG W "IN VITAL: PAIN",! 411 408 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC … … 424 421 Q 425 422 ; 426 OTHER1(DT,TEXT,ACTOR,VALUE,UNIT) 423 OTHER1(DT,TEXT,ACTOR,VALUE,UNIT) ; 427 424 I DEBUG W "IN VITAL: OTHER",! 428 425 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC -
ccr/trunk/p/C0CVITAL.m
r1544 r1586 1 1 C0CVITAL ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2008,2009 George Lilly, University of Minnesota and others. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; 4 ; This program is free software: you can redistribute it and/or modify 5 ; it under the terms of the GNU Affero General Public License as 6 ; published by the Free Software Foundation, either version 3 of the 7 ; License, or (at your option) any later version. 8 ; 9 ; This program is distributed in the hope that it will be useful, 10 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 11 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 ; GNU Affero General Public License for more details. 13 ; 14 ; You should have received a copy of the GNU Affero General Public License 15 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 16 ; 21 17 W "NO ENTRY FROM TOP",! … … 57 53 K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES 58 54 N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX 59 D VITDVISTA(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY60 I DEBUG ZWR VDATES ;DEBUG55 D SORTVIST(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY 56 ; I DEBUG ZWR VDATES ;DEBUG 61 57 S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE 62 58 ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY … … 239 235 K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES 240 236 N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX 241 D VITDRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY237 D SORTRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY 242 238 S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE 243 239 ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY … … 386 382 Q 387 383 ; 388 VITDRPMS(VDT) ; RUN DATE SORTING ALGORITHM FOR RPMS384 SORTRPMS(VDT) ; RUN DATE SORTING ALGORITHM FOR RPMS 389 385 ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY 390 386 ; OF DATES IN THE VITALS RESULTS … … 399 395 Q 400 396 ; 401 VITDVISTA(VDT) ; RUN DATE SORTING ALGORITHM FOR VISTA397 SORTVIST(VDT) ; RUN DATE SORTING ALGORITHM FOR VISTA 402 398 ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY 403 399 ; OF DATES IN THE VITALS RESULTS -
ccr/trunk/p/C0CVOBX1.m
r1544 r1586 1 1 LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 3 ; JMC - mods to check for IHS V LAB file 4 ; 5 ; (C) 2009 John McCormack 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (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 Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 4 18 ; 5 19 CH ; Observation/Result segment for "CH" subscript results. -
ccr/trunk/p/C0CVORU.m
r1544 r1586 1 1 C0C7VORU ;WV/JMC - Builder of HL7 Lab Results OBR/OBX/NTE based on RPMS V LAB file ;Jun 16, 2009 ; 5/10/12 5:19pm 2 ;;1.2;C0C;;May 11, 2012;Build 47 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; 4 ; (C) 2009 John McCormack 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 3 17 ; 4 18 EN(LA) ; called from C0CVLAB -
ccr/trunk/p/C0CXEWD.m
r1544 r1586 1 1 C0CXEWD ; C0C/GPL - EWD based XPath utilities; 10/11/09 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2009 George Lilly. 5 4 ; 6 ; This program is free software;you can redistribute it and/or modify7 ; it under the terms of the GNU General Public License as published by8 ; the Free Software Foundation; either version 2 of the License, or9 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 10 9 ; 11 ; This program is distributed in the hope that it will be useful,12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 15 14 ; 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. 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 Q -
ccr/trunk/p/C0CXPAT0.m
r1544 r1586 1 1 C0CXPAT0 ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2008 George Lilly. 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",! 21 Q 22 ; 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2008 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 ; 18 W "NO ENTRY",! 19 Q 20 ; 23 21 ;;><TEST> 24 22 ;;><INIT> -
ccr/trunk/p/C0CXPATH.m
r1544 r1586 1 1 C0CXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ;Copyright 2008 George Lilly. 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. 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ;Copyright 2008 George Lilly. 4 ; 5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 17 ; 20 18 W "This is an XML XPATH utility library",! … … 135 133 Q 136 134 ; 137 DO 135 DO ; 138 136 D XPG2XML("^GPL2B","^GPL2A") 139 137 Q … … 188 186 Q 189 187 ; 190 ZXO(WHAT) 188 ZXO(WHAT) ; 191 189 D PUSH("GA",WHAT) 192 190 D PUSH(OUTXML,"<"_WHAT_">") 193 191 Q 194 192 ; 195 ZXC(WHAT) 193 ZXC(WHAT) ; 196 194 D POP("GA",.TMP) 197 195 D PUSH(OUTXML,"</"_WHAT_">") 198 196 Q 199 197 ; 200 ZXVAL(WHAT,VAL) 198 ZXVAL(WHAT,VAL) ; 201 199 D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">") 202 200 Q … … 235 233 . S LINE=@IZXML@(I) 236 234 . I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED 237 . . S @TEMPLATE@(I)=$$CLEAN(LINE) 235 . . S @TEMPLATE@(I)=$$CLEAN(LINE) 238 236 . ;W LINE,! 239 237 . S FOUND=0 ; INTIALIZED FOUND FLAG
Note:
See TracChangeset
for help on using the changeset viewer.