Changeset 1336 for ccr/trunk/p/C0CENC.m
- Timestamp:
- Jan 4, 2012, 9:39:08 PM (12 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0CENC.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CENC.m
r1331 r1336 1 C0CENC 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 EXTRACT(ENCXML,DFN,ENCOUT) 25 26 27 28 29 30 31 32 33 34 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) 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 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 GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 ANYTXT(ZVST) 130 131 132 133 134 135 136 137 138 139 140 141 142 143 PRV(IARY) 144 145 146 147 148 149 150 151 DATE(ISTR) 152 153 154 CPT(ISTR) 155 156 157 158 159 160 161 162 163 164 165 166 167 168 MAP(ENCXML,C0CENC,ENCOUT) 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 1 C0CENC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10 2 ;;1.0;C0C;;May 21, 2010;Build 38 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 ; 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 "NO ENTRY FROM TOP",! 22 Q 23 ; 24 EXTRACT(ENCXML,DFN,ENCOUT) ; EXTRACT ENCOUNTERS INTO XML TEMPLATE 25 ; ENCXML AND ENCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED 26 ; 27 D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES 28 ;I '$D(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE 29 K @C0CENC 30 D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS 31 D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS 32 Q 33 ; 34 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES, 35 ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME 36 ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES 37 ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT 38 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 39 ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM 40 ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS 41 ; 42 ;K VISIT,LST,NOTE 43 I '$D(C0CPRC) D SETVARS^C0CPROC ; INITIALIZE WORK AREAS IF NOT ALREADY THERE 44 I '$D(VISIT) D ENTRY^C0CCPT(DFN,,,1) ; RETURNS VISIT LOCAL VARIABLE 45 ; NEED TO ADD START AND END DATES FROM PARAMETERS 46 N ZI S ZI="" 47 N PREVCPT,PREVDT S (PREVCPT,PREVDT)="" 48 F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST 49 . N ZDATE 50 . S ZDATE=$$DATE(VISIT(ZI,"DATE",0)) 51 . S ZPRVARY=$NA(VISIT(ZI,"PRV")) 52 . N ZPRV 53 . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM 54 . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON 55 . ; ENCOBJECTID - ENCOUNTER OBJECT ID 56 . ; ENCDATETIME - ENCOUNTER DATE TIME 57 . ; ENCTYPETXT - ENCOUNTER TYPE (PLANNING TO USE ADMINISTRATIVE CPT IF AVAIL) 58 . ; ENCTYPECODE - CODE OF TYPE - PLANNING CPT CODE 59 . ; ENCTYPECODESYS - CODING SYSTEM OF TYPE - CPT-4 60 . ; ENCDESCTXT - ENCOUNTER DESCRIPTION TEXT 61 . ; ENCDESCCODE - ENCOUNTER DESCRIPTION CODE 62 . ; ENCDESCCODESYS - ENCOUNTER DESCRIPTION CODE SYSTEM 63 . ; ENCLOCACTORID - ENCOUNTER LOCATION ACTOR ID 64 . ; ENCPRVACTORID - ENCOUNTER PRACTIONER ACTOR ID 65 . ; ENCINDTXT - ENCOUNTER INDICATION TEXT 66 . ; ENCINDCODE - ENCOUNTER INDICATION CODE 67 . ; ENCINDCODESYS - ENCOUNTER INDICATION CODE SYSTEM 68 . ; ENCACTORID - ENCOUNTER SOURCE ACTOR ID 69 . ; ENCCOMMENTID - ENCOUNTER COMMENT ID - POINTER TO NOTE IN COMMENT SECTION 70 . S ZRNF("ENCOBJECTID")="ENCOUNTER_"_ZI 71 . S ZRNF("ENCDATETIME")=ZDATE ; ENCOUNTER DATE TIME 72 . S ZRNF("ENCTYPETXT")="" 73 . S ZRNF("ENCTYPECODE")="" 74 . S ZRNF("ENCTYPECODESYS")="" 75 . S ZRNF("ENCDESCTXT")="" 76 . S ZRNF("ENCDESCCODE")="" 77 . S ZRNF("ENCDESCCODESYS")="" 78 . N TYPTXT,TYPCDE,TYPSYS ; WILL BE UPDATED BY GETTYPE CALL 79 . I $$GETTYPE("VISIT(ZI)",.TYPTXT,.TYPCDE,.TYPSYS) D ; RETURNS FALSE IF NO TYPE 80 . . S ZRNF("ENCTYPETXT")=TYPTXT 81 . . S ZRNF("ENCTYPECODE")=TYPCDE 82 . . S ZRNF("ENCTYPECODESYS")=TYPSYS 83 . . S ZRNF("ENCDESCTXT")=TYPTXT ; FOR NOW, DESCRIPTION IS SAME AS TYPE 84 . . S ZRNF("ENCDESCCODE")=TYPCDE ; DESCRIPTION IS REQUIRED (TYPE IS NOT) 85 . . S ZRNF("ENCDESCCODESYS")=TYPSYS ; NEED TO CLARIFY FOR VISTA 86 . S ZRNF("ENCLOCACTORID")="ACTORORGANIZATION_1" 87 . S ZRNF("ENCPRVACTORID")=ZPRV ; PRIMARY PROVIDER LISTED FOR THE ENCOUNTER 88 . S ZRNF("ENCINDTXT")="" ; WE WILL PUT POINTERS TO PROBLEMS HERE 89 . S ZRNF("ENCINDCODE")="" 90 . S ZRNF("ENCINDCODESYS")="" 91 . S ZRNF("ENCACTORID")=ZPRV ; SOURCE WILL BE PRIMARY PROVIDER 92 . S ZRNF("ENCCOMMENTID")="" 93 . I $G(VISIT(ZI,"TEXT",1))'="" D ; THERE IS A NOTE 94 . . M @C0CNTE@(ZI,"TEXT")=VISIT(ZI,"TEXT") ; COPY THE TEXT OF THE NOTE 95 . . S @C0CNTE@(ZI,"COMMENTOBJECTID")="NOTE_"_ZI 96 . . S @C0CNTE@(ZI,"CMTDATETIME")=ZDATE ; DATE OF THE NOTE 97 . . S @C0CNTE@(ZI,"ACTORSOURCEID")=ZPRV ; SOURCE OF THE NOTE 98 . . S ZRNF("ENCCOMMENTID")="NOTE_"_ZI ; POINT TO THE NOTE FROM THE ENCOUNTER 99 . D RNF1TO2^C0CRNF(C0CENC,"ZRNF") ; ADD THIS ROW TO THE ARRAY 100 . ;S PREVCPT=ZCPT 101 . ;S PREVDT=ZDATE 102 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"ENCOUNTERS")) 103 M @ZRIM=@C0CENC@("V") 104 K VISIT,LST,NOTE 105 Q 106 ; 107 GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) ; EXTRINSIC WHICH RETURNS FALSE IF NO ENCOUNTER TYPE 108 ; UPDATES ZTXT WITH ENCOUNTER TYPE TEXT, ZCDE WITH ENCOUNTER TYPE CODE 109 ; AND ZSYS WITH ENCOUNTER TYPE CODING SYSTEM 110 ; THIS ROUTINE SHOULD BE UPDATED TO SEARCH FOR AN ADMINISTRATIVE CPT CODE 111 ; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/10 112 N ZS,ZC 113 S ZC="" S ZS="" 114 S (ZTXT,ZCDE,ZSYS)="" 115 F S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC="" D ; TRY AND FIND A "99" CPT CODE 116 . N ZT 117 . S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE 118 . I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE? 119 I ZS'="" D ; CODED ENCOUNTER TYPE FOUND 120 . S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE 121 . S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER 122 . S ZSYS="" 123 . I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE 124 I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES 125 I ZTXT="" Q 0 ; FAILED 126 W !,ZTXT 127 Q 1 ; SUCCESS 128 ; 129 ANYTXT(ZVST) ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE 130 ; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED) 131 ; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME 132 ; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY 133 N ZK,ZL 134 S ZK="" S ZL="" 135 F S ZK=$O(@ZVST@("CPT",ZK)) Q:ZK="" D ; LOOK FOR SOME TEXT TO USE 136 . N ZT 137 . S ZT=$G(@ZVST@("CPT",ZK)) ; LOOK AT THIS CPT MULTIPLE 138 . I $P(ZT,U,2)_" "_$P(ZT,U,3)'=" " S ZL=$P(ZT,U,2)_" "_$P(ZT,U,3) 139 . ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE 140 I ZL="" S ZL=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE 141 Q ZL 142 ; 143 PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME 144 N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN="" 145 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG 146 . I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER 147 . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1) 148 I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR 149 Q ZRTN 150 ; 151 DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT 152 Q $$FMDTOUTC^C0CUTIL(ISTR,"DT") 153 ; 154 CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS 155 ; CPT^CATEGORY^TEXT 156 N Z1,Z2,Z3,ZRTN 157 S Z1=$P(ISTR,U,1) 158 I Z1="" D ; 159 . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1) 160 I Z1'="" D ; IF THERE IS A CPT CODE IN THERE 161 . ;S Z1=$P(ISTR,U,1) 162 . S Z2=$P(ISTR,U,2) 163 . S Z3=$P(ISTR,U,3) 164 . S ZRTN=Z1_U_Z2_U_Z3 165 E S ZRTN="" 166 Q ZRTN 167 ; 168 MAP(ENCXML,C0CENC,ENCOUT) ; MAP PROCEDURES XML 169 ; 170 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"ENCTEMP")) ;WORK AREA FOR TEMPLATE 171 K @ZTEMP 172 N ZBLD 173 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"ENCBLD")) ; BUILD LIST AREA 174 D QUEUE^C0CXPATH(ZBLD,ENCXML,1,1) ; FIRST LINE 175 N ZINNER 176 D QUERY^C0CXPATH(ENCXML,"//Encounters/Encounter","ZINNER") ;ONE ENCOUNTER 177 N ZTMP,ZVAR,ZI 178 S ZI="" 179 F S ZI=$O(@C0CENC@("V",ZI)) Q:ZI="" D ;FOR EACH ENCOUNTER 180 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS ENCOUNTER XML 181 . S ZVAR=$NA(@C0CENC@("V",ZI)) ;THIS ENCOUNTER VARIABLES 182 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE 183 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD 184 D QUEUE^C0CXPATH(ZBLD,ENCXML,@ENCXML@(0),@ENCXML@(0)) 185 N ZZTMP 186 D BUILD^C0CXPATH(ZBLD,ENCOUT) ;BUILD FINAL XML 187 K @ZTEMP,@ZBLD,@C0CENC 188 Q 189 ;
Note:
See TracChangeset
for help on using the changeset viewer.
