Changeset 1204 for ccr/trunk/p/C0CPROC.m
- Timestamp:
- Jun 23, 2011, 3:01:41 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0CPROC.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CPROC.m
r783 r1204 1 C0CPROC 2 ;;1.0;C0C;;Jan 21, 2010; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 SETVARS 25 26 27 28 29 30 EXTRACT(PROCXML,DFN,PROCOUT) 31 32 33 34 35 36 37 38 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) 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 PRV(IARY) 92 93 94 95 96 97 98 99 DATE(ISTR) 100 101 102 CPT(ISTR) 103 104 105 106 107 108 109 110 111 112 113 114 115 116 MAP(PROCXML,C0CPRC,PROCOUT) 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 1 C0CPROC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10 2 ;;1.0;C0C;;Jan 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 SETVARS ; SET UP VARIABLES FOR PROCEDURES, ENCOUNTERS, AND NOTES 25 S C0CENC=$NA(^TMP("C0CCCR",$J,"C0CENC",DFN)) 26 S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN)) 27 S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN)) 28 Q 29 ; 30 EXTRACT(PROCXML,DFN,PROCOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE 31 ; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED 32 ; 33 D SETVARS ; SET UP VARIABLES 34 I '$D(@C0CPRC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE 35 D MAP(PROCXML,C0CPRC,PROCOUT) ;MAP RESULTS FOR PROCEDURES 36 Q 37 ; 38 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES, 39 ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME 40 ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES 41 ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT 42 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 43 ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM 44 ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS 45 ; 46 K VISIT,LST,NOTE,C0CLPRC 47 ; C0CLPRC IS A LOOKUP TABLE FOR USE IN BUILDING ENCOUNTERS 48 ; FORMAT C0CLPRC(VISITIEN,CPT)=PROCOBJECTID FOR BUILDING LINKS TO PROCEDURES 49 D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE 50 ; NEED TO ADD START AND END DATES FROM PARAMETERS 51 N ZI S ZI="" 52 N PREVCPT,PREVDT S (PREVCPT,PREVDT)="" 53 F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST 54 . N ZDATE 55 . S ZDATE=$$DATE(VISIT(ZI,"DATE",0)) 56 . S ZPRVARY=$NA(VISIT(ZI,"PRV")) 57 . N ZPRV 58 . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM 59 . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON 60 . N ZJ S ZJ="" 61 . F S ZJ=$O(VISIT(ZI,"CPT",ZJ)) Q:ZJ="" D ;FOR EACH CPT SEG 62 . . N ZRNF 63 . . N ZCPT S ZCPT=$$CPT(VISIT(ZI,"CPT",ZJ)) ;GET CPT CODE AND TEXT 64 . . I ZCPT'="" D ;IF CPT CODE IS PRESENT 65 . . . I (ZCPT=PREVCPT)&(ZDATE=PREVDT) Q ; NO DUPS ALLOWED 66 . . . W !,ZCPT," ",ZDATE," ",ZPRV 67 . . . S ZRNF("PROCACTOROBJID")=ZPRV 68 . . . N PROCCODE S PROCCODE=$P(ZCPT,U,1) 69 . . . S ZRNF("PROCCODE")=PROCCODE 70 . . . S ZRNF("PROCCODESYS")="CPT-4" 71 . . . S ZRNF("PROCDATETEXT")="Procedure Date" 72 . . . S ZRNF("PROCDATETIME")=ZDATE 73 . . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET 74 . . . S ZRNF("PROCDESCOBJATTR")="" 75 . . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES 76 . . . S ZRNF("PROCDESCOBJATTRVAL")="" 77 . . . S ZRNF("PROCDESCTEXT")=$P(ZCPT,U,3) 78 . . . S ZRNF("PROCLINKID")="" ; NO LINKS YET 79 . . . S ZRNF("PROCLINKREL")="" ; NO LINKS YET 80 . . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ 81 . . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS 82 . . . S ZRNF("PROCSTATUS")="Completed" ; Is this right? 83 . . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE 84 . . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY 85 . . . S PREVCPT=ZCPT 86 . . . S PREVDT=ZDATE 87 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES")) 88 M @ZRIM=@C0CPRC@("V") 89 Q 90 ; 91 PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME 92 N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN="" 93 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG 94 . I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER 95 . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1) 96 I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR 97 Q ZRTN 98 ; 99 DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT 100 Q $$FMDTOUTC^C0CUTIL(ISTR,"DT") 101 ; 102 CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS 103 ; CPT^CATEGORY^TEXT 104 N Z1,Z2,Z3,ZRTN 105 S Z1=$P(ISTR,U,1) 106 I Z1="" D ; 107 . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1) 108 I Z1'="" D ; IF THERE IS A CPT CODE IN THERE 109 . ;S Z1=$P(ISTR,U,1) 110 . S Z2=$P(ISTR,U,2) 111 . S Z3=$P(ISTR,U,3) 112 . S ZRTN=Z1_U_Z2_U_Z3 113 E S ZRTN="" 114 Q ZRTN 115 ; 116 MAP(PROCXML,C0CPRC,PROCOUT) ; MAP PROCEDURES XML 117 ; 118 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE 119 K @ZTEMP 120 N ZBLD 121 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA 122 D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE 123 N ZINNER 124 D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC 125 N ZTMP,ZVAR,ZI 126 S ZI="" 127 F S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI="" D ;FOR EACH PROCEDURE 128 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML 129 . S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES 130 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE 131 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD 132 D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0)) 133 N ZZTMP 134 D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML 135 K @ZTEMP,@ZBLD,@C0CPRC 136 Q 137 ;
Note:
See TracChangeset
for help on using the changeset viewer.
