Changeset 1337 for ccr/branches/ohum/p/C0CIN.m
- Timestamp:
- Jan 4, 2012, 9:40:24 PM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CIN.m
r1333 r1337 1 C0CIN 2 ;;1.0;C0C;;Sep 20, 2009;Build 1 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 TEST 24 25 26 27 28 29 30 RPCAIN(RTN,DFN,DUZ,SOURCE,TYPE,ARY) 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 ADDSRC(ZSRC) 50 51 52 53 54 55 56 57 58 RPCFIN(RTN,DFN,DUZ,SOURCE,TYPE,FN,FP) 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 RPCLIST(RTN,DFN) 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 RPCDOC(RTN,IEN) 98 99 100 101 102 103 EN(INXML,SOURCE,C0CDFN) 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 GETACCR(AOUT,C0CDFN) 132 133 134 135 136 137 138 TEST64 139 140 141 142 143 144 145 146 147 NORMAL(OUTXML,INXML) 148 149 150 151 152 153 154 155 156 157 158 159 CLEANCR(OUTXML,INXML) 160 161 162 163 164 165 166 167 168 169 LOAD(ZRTN,filepath) 170 171 172 173 174 175 176 177 178 179 180 181 182 183 UPDIE 184 185 186 187 188 189 190 191 192 193 1 C0CIN ; CCDCCR/GPL - CCR IMPORT utilities; 9/20/08 2 ;;1.0;C0C;;Sep 20, 2009;Build 38 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. 19 ; 20 W "This is the CCR Import Utility Library ",! 21 Q 22 ; 23 TEST ; TESTS BOTH ROUTINES AT ONCE 24 N ZI,ZJ 25 S ZI="/home/vademo2/CCR" ;directory purposely leaving off the trailing / 26 S ZJ="PAT_358_CCR_V1_0_21.xml" ; random test patient 27 D RPCFIN(.GPL,358,135,"GPLTEST","CCR",ZJ,ZI) 28 Q 29 ; 30 RPCAIN(RTN,DFN,DUZ,SOURCE,TYPE,ARY) ; ARRAY IN RPC - ACCEPT AN XML DOCUMENT 31 ; AND STORE IT IN THE INCOMING XML FILE 32 ; RETURNS THE IEN OF THE RECORD OR TEXT IF THERE IS AN ERROR 33 I $G(DFN)="" S RTN="DFN NOT DEFINED" Q ; 34 N C0CXF S C0CXF=175 ; FILE NUMBER FOR INCOMING XML FILE 35 N C0CFDA,ZX 36 S C0CFDA(C0CXF,"+1,",.01)=DFN ; PATIENT 37 S C0CFDA(C0CXF,"+1,",.02)=DUZ ; PROVIDER CREATING THE RECORD 38 S C0CFDA(C0CXF,"+1,",1)=$$NOW^XLFDT ;DATE 39 S C0CFDA(C0CXF,"+1,",2)=TYPE ;TYPE 40 S C0CFDA(C0CXF,"+1,",3)=$$ADDSRC(SOURCE) ;SOURCE 41 S C0CFDA(C0CXF,"+1,",7)="NEW" ; STATUS OF NEW FOR NOT PROCESSED 42 D UPDIE ; CREATE THE RECORD 43 S ZX=C0CIEN(1) ; CAPTURE THE RECORD NUMBER 44 D WP^DIE(C0CXF,ZX_",",4,,ARY,"ZERR") 45 ;W "RECORD:",ZX,! 46 S RTN=ZX ; RETURN IEN OF THE XML FILE 47 Q 48 ; 49 ADDSRC(ZSRC) ;EXTRISIC TO ADD A SOURCE TO THE CCR SOURCE FILE 50 ; RETURNS RECORD NUMBER. IF SOURCE EXISTS, JUST RETURNS IT'S RECORD NUMBER 51 ; 52 N ZX,ZF,C0CFDA 53 S ZF=171.401 ; FILE NUMBER FOR CCR SOURCE FILE 54 S C0CFDA(ZF,"?+1,",.01)=ZSRC 55 D UPDIE 56 Q $O(^C0C(171.401,"B",ZSRC,"")) 57 ; 58 RPCFIN(RTN,DFN,DUZ,SOURCE,TYPE,FN,FP) ; FILE IN RPC - READ AN XML DOCUMENT 59 ; FROM A HOST FILE AND STORE IT IN THE INCOMING XML FILE 60 N ZX,ZTMP 61 I $E($RE(FP))'="/" S ZX=FP_"/" 62 E S ZX=FP 63 S ZX=ZX_FN 64 D LOAD("ZTMP",ZX) 65 I '$D(ZTMP) D Q ; NO LUCK 66 . W "FILE NOT LOADED",! 67 D RPCAIN(.RTN,DFN,DUZ,SOURCE,TYPE,"ZTMP") 68 N C0CFDA 69 S C0CFDA(175,RTN_",",5)=FN ; FILE NAME 70 S C0CFDA(175,RTN_",",6)=FP ; FILE PATH 71 D UPDIE ; UPDATE WITH FILE NAME AND PATH 72 Q 73 ; 74 RPCLIST(RTN,DFN) ; CCR LIST - LIST XML DOCUMENTS FOR PATIENT DFN 75 ; THAT ARE STORED IN THE INCOMING XML FILE 76 ; RETURNS AN ARRAY OF THE FORM 77 ; RTN(x)="IEN^DATE^TYPE^SOURCE^STATUS^CREATEDBY" WHERE 78 ; IEN IS THE RECORD NUMBER OF THE XML DOCUMENT 79 ; DATE IS THE DATE THE DOCUMENT WAS STORED IN THE FILE 80 ; TYPE IS "CCD" OR "CCR" OR "OTHER" 81 ; SOURCE IS THE NAME OF THE DOCUMENT SOURCE FROM THE CCR SOURCE FILE 82 ; STATUS IS THE STATUS OF THE DOCUMENT (VALUES TO BE DEFINED) 83 ; CREATEDBY IS THE NAME OF THE PROVIDER WHO UPLOADED THE XML 84 N ZF S ZF=175 ; FILE NUMBER OF INCOMING XML FILE 85 N ZI S ZI="" 86 N ZN S ZN=0 87 F S ZI=$O(^C0CIN("B",DFN,ZI),-1) Q:ZI="" D ; FOR EACH RECORD FOR THIS PATIENT 88 . S ZN=ZN+1 ;INCREMENT COUNT OF RETURN ARRAY 89 . S $P(RTN(ZN),"^",1)=ZI ; IEN OF RECORD 90 . S $P(RTN(ZN),"^",2)=$$GET1^DIQ(ZF,ZI_",",1,"E") ;DATE 91 . S $P(RTN(ZN),"^",3)=$$GET1^DIQ(ZF,ZI_",",2,"E") ;TYPE 92 . S $P(RTN(ZN),"^",4)=$$GET1^DIQ(ZF,ZI_",",3,"E") ;SOURCE 93 . S $P(RTN(ZN),"^",5)=$$GET1^DIQ(ZF,ZI_",",7,"I") ; STATUS 94 . S $P(RTN(ZN),"^",6)=$$GET1^DIQ(ZF,ZI_",",.02,"E") ; CREATED BY 95 Q 96 ; 97 RPCDOC(RTN,IEN) ; RETRIEVE DOCUMENT NUMBER IEN FROM THE INCOMING XML FILE 98 ; RETURNED IN ARRAY RTN 99 N ZI 100 S ZI=$$GET1^DIQ(175,IEN_",",4,,"RTN") 101 Q 102 ; 103 EN(INXML,SOURCE,C0CDFN) ; IMPORT A CCR, PASSED BY NAME INXML 104 ; FILE UNDER SOURCE, WHICH IS A POINTER TO THE CCR SOURCE FILE 105 ; FOR PATIENT C0CDFN 106 ;N C0CXP 107 S C0CINB=$NA(^TMP("C0CIN",$J,"VARS",C0CDFN)) 108 S C0CDOCID=$$PARSE^C0CMXML(INXML) ;W !,"DocID: ",C0CDOCID 109 ;S REDUX="//ContinuityOfCareRecord/Body" 110 S REDUX="" 111 D XPATH^C0CMXML(1,"/","C0CIDX","C0CXP",,REDUX) 112 ;D INDEX^C0CXPATH(INXML,"C0CXP",-1) ; GENERATE XPATHS FROM THE CCR 113 ;N ZI,ZJ,ZK 114 S ZI="" 115 F S ZI=$O(C0CXP(ZI)) Q:ZI="" D ; FOR EACH XPATH 116 . D DEMUX^C0CMXP("ZJ",ZI) ; 117 . W ZJ,! 118 . S ZK=$P(ZJ,"^",3) ; PULL OUT THE XPATH 119 . S ZM=$P(ZJ,"^",1) ; PULL OUT THE MULTIPLE 120 . S ZS=$P(ZJ,"^",2) ; PULL OUT THE SUBMULTIPLE 121 . S C0CDICN=$O(^C0CDIC(170,"XPATH",ZK,"")) 122 . I C0CDICN="" D Q ; 123 . . W "MISSING XPATH:",!,ZK,! ; OOPS, XPATH NOT IN C0CDIC 124 . . S MISSING(ZK)="" 125 . ;D GETS^DIQ(170,C0CDICN_",","*",,"C0CFDA") 126 . S C0CVAR=$$GET1^DIQ(170,C0CDICN_",",.01) ; VARIABLE NAME 127 . S C0CSEC=$$GET1^DIQ(170,C0CDICN_",",12) ;ELEMENT TYPE 128 . W C0CSEC,":",C0CVAR,! 129 Q 130 ; 131 GETACCR(AOUT,C0CDFN) ; EXTRACT A CCR FOR PATIENT ADFN AND PUT IT IN ARRAY AOUT 132 ;PASSED BY NAME 133 N ZT 134 D CCRRPC^C0CCCR(.ZT,C0CDFN,"LABLIMIT:T-1000") 135 M @AOUT=ZT 136 Q 137 ; 138 TEST64 ;TEST BASE64 DECODING FOR IMPORTING CCR FROM THE NHIN 139 W $$FTG^%ZISH("/tmp/","base64_encoded_ccr.txt","G64(1)",1) 140 S G=G64(1) 141 S ZI="" 142 F S ZI=$O(G64(1,"OVF",ZI)) Q:ZI="" D ; FOR EVERY OVERFLOW RECORD 143 . S G=G_G64(1,"OVF",ZI) ;HOPE IT'S NOT TOO BIG 144 S G2=$$DECODE^RGUTUU(G) 145 Q 146 ; 147 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML 148 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME 149 ; 150 N ZI,ZN,ZTMP 151 S ZN=1 152 S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">" 153 S ZN=ZN+1 154 F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ; 155 . S @OUTXML@(ZN)=@OUTXML@(ZN)_">" 156 . S ZN=ZN+1 157 Q 158 ; 159 CLEANCR(OUTXML,INXML) ; USE $C(10) TO SEPARATE THE STRING INXML INTO 160 ;AN ARRAY OUTXML(n) OUTXML AND INXML PASSED BY NAME 161 N ZX,ZY,ZN 162 S ZX=1,ZN=1 163 F S ZY=$F(@INXML,$C(10),ZX) Q:ZY=0 D ; 164 . S @OUTXML@(ZN)=$E(G2,ZX,ZY-2) 165 . I @OUTXML@(ZN)'="" S ZN=ZN+1 166 . S ZX=ZY 167 Q 168 ; 169 LOAD(ZRTN,filepath) ; load an xml file into the ZRTN array, passed by name 170 n i 171 D ; 172 . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)="" 173 . s ztmp=$na(^TMP("C0CLOAD",$J)) 174 . k @ztmp 175 . s zfile=$re($p($re(filepath),"/",1)) ;file name 176 . s zpath=$p(filepath,zfile,1) ; file path 177 . s zok=$$FTG^%ZISH(zpath,zfile,$NA(@ztmp@(1)),3) ; import the file incr sub 3 178 . m @ZRTN=@ztmp 179 . k @ztmp 180 . s i=$o(@ZRTN@(""),-1) ; highest line number 181 q 182 ; 183 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 184 K ZERR,C0CIEN 185 D CLEAN^DILF 186 D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR") 187 I $D(ZERR) D ; 188 . W "ERROR",! 189 . ZWR ZERR 190 . B 191 K C0CFDA 192 Q 193 ;
Note:
See TracChangeset
for help on using the changeset viewer.