Changeset 1330 for ccr/branches/ohum/p/C0CIM2.m
- Timestamp:
- Jan 3, 2012, 11:45:29 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CIM2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CIM2.m
r1329 r1330 1 C0CIM2 2 ;;1.0;C0C;;Feb 16, 2010;Build 38 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 EXTRACT(IMMXML,DFN,IMMOUT) 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 GETRPMS(DFN,C0CIMM) 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 IMMUN 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 FORECAST 102 103 104 CONTRA 105 106 107 REFUSE 108 109 110 111 MAP(IMMXML,C0CIMM,IMMOUT) 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 1 C0CIM2 ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10 2 ;;1.0;C0C;;Feb 16, 2010;Build 1 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(IMMXML,DFN,IMMOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE 25 ; IMMXML AND IMMOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED 26 ; 27 ; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS 28 ; THAT GET PASSED TO *GET ROUTINES 29 ;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME)) 30 N C0CIMM 31 S C0CIMM=$NA(^TMP("C0CCCR",$J,DFN,"C0CIMM")) 32 ; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS 33 ; THAT GET INSERTED INTO THE XML TEMPLATE 34 ; I '$D(@C0CIMM) D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS IF NOT THERE 35 D GETRPMS(DFN,C0CIMM) ; GET VARS IF NOT THERE 36 ; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE 37 ; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES 38 D MAP(IMMXML,C0CIMM,IMMOUT) ;MAP RESULTS FOR PROCEDURES 39 Q 40 ; 41 GETRPMS(DFN,C0CIMM) ; CALLS GET^BGOVIMM TO GET IMMUNIZATIONS. 42 ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME 43 ; C0CIMM: IMMUNIZATIONS 44 ; READY TO BE MAPPED TO XML BY MAP^C0CIMM 45 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 46 ; EXIST. 47 ; 48 ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J)) 49 ; 50 ; SETUP RPC/API CALL HERE 51 ; USE START AND END DATES FROM PARAMETERS IF REQUIRED 52 N IMMA 53 D GET^BGOVIMM(.IMMA,DFN) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE 54 ; PREFORM SORT HERE IF NEEDED 55 ; 56 ; NO SORT REQUIRED FOR IMMUNIZATIONS 57 ; 58 ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY 59 ; RNF1 ARRAY FORMAT: 60 ; VAR("NAME_OF_RIM_VARIABLE")=VALUE 61 ; 62 ; IMMUNIZATIONS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF IMMUNIZATION RESULTS 63 ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD 64 ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS 65 N C0CIM,C0CC,ZRNF 66 S C0CIM="" ; INITIALIZE FOR $O 67 F C0CC=1:1 S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST 68 . I DEBUG W @IMMA@(C0CIM),! 69 . ; FIGURE OUT WHICH TYPE OF IMMUNIZATION IT IS (IMMUNIZATION, FORECAST, CONTRAINDICATIONS, REFUSALS) 70 . D:$P(@IMMA@(C0CIM),U,1)="I" IMMUN 71 . D:$P(@IMMA@(C0CIM),U,1)="F" FORECAST 72 . D:$P(@IMMA@(C0CIM),U,1)="C" CONTRA 73 . D:$P(@IMMA@(C0CIM),U,1)="R" REFUSE 74 . D RNF1TO2^C0CRNF(C0CIMM,"ZRNF") ;ADD THIS ROW TO THE ARRAY 75 . K ZRNF 76 ; SAVE RIM VARIABLES SEE C0CRIMA 77 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE")) 78 M @ZRIM=@C0CIMM@("V") 79 Q 80 ; 81 IMMUN ; PARSES IMMUNIZATION TYPE ROWS FOR RPMS 82 ; RPC FORMAT 83 ; I ^ Imm Name [2] ^ Visit Date [3] ^ V File IEN [4] ^ Other Location [5] ^ Group [6] ^ Imm IEN [7] ^ Lot [8] ^ 84 ; Reaction [9] ^ VIS Date [10] ^ Age [11] ^ Visit Date [12] ^ Provider IEN~Name [13] ^ Inj Site [14] ^ 85 ; Volume [15] ^ Visit IEN [16] ^ Visit Category [17] ^ Full Name [18] ^ Location IEN~Name [19] ^ Visit Locked [20] 86 ; RETRIEVE IMMUNIZATION RECORD FROM IMMUNIZATION FILE (9999999.14) FOR THIS IMMUNIZATION 87 D GETN^C0CRNF("C0CZIM",9999999.14,$P(@IMMA@(C0CIM),U,7)) ; GET IMMUNIZATION RECORD 88 ; RETIREVE IMMUNIZATION RECORD FROM V IMMUNIZATION FILE (9000010.11) FOR THIS IMMUNIZATION 89 D GETN^C0CRNF("C0CZVI",9000010.11,$P(@IMMA@(C0CIM),U,4)) ; GET V IMMUNIZATION RECORD 90 S ZRNF("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID 91 S ZRNF("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME 92 S ZRNF("IMMUNEDATETIME")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("EVENT DATE AND TIME","C0CZVI"),"DT") 93 S ZRNF("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_$P($P(@IMMA@(C0CIM),U,13),"~",1) 94 S ZRNF("IMMUNEPRODUCTNAMETEXT")=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD 95 S ZRNF("IMMUNEPRODUCTCODE")=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE 96 I $$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM")'="" S ZRNF("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" 97 E S ZRNF("IMMUNEPRODUCTCODESYSTEM")="" ;NULL 98 ;CLEANUP FROM C0CRNF CALLS 99 K C0CZIM,C0CZVI 100 Q 101 FORECAST ; PARSES FORECAST TYPE ROWS FOR RPMS 102 ; CURRENTLY DISABLED 103 Q 104 CONTRA ; PARSES FORECAST TYPE ROWS FOR RPMS 105 ; CURRENTLY DISABLED 106 Q 107 REFUSE ; PARSES FORECAST TYPE ROWS FOR RPMS 108 ; CURRENTLY DISABLED 109 Q 110 ; 111 MAP(IMMXML,C0CIMM,IMMOUT) ; MAP IMMUNIZATION XML 112 ; 113 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"IMMTEMP")) ;WORK AREA FOR TEMPLATE 114 K @ZTEMP 115 N ZBLD 116 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"IMMBLD")) ; BUILD LIST AREA 117 D QUEUE^C0CXPATH(ZBLD,IMMXML,1,1) ; FIRST LINE 118 N ZINNER 119 ; XPATH NEEDS TO MATCH YOUR SECTION 120 D QUERY^C0CXPATH(IMMXML,"//Immunizations/Immunization","ZINNER") ;ONE PROC 121 N ZTMP,ZVAR,ZI 122 S ZI="" 123 F S ZI=$O(@C0CIMM@("V",ZI)) Q:ZI="" D ;FOR EACH IMMUNIZATION 124 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS IMMUNIZATION XML 125 . S ZVAR=$NA(@C0CIMM@("V",ZI)) ;THIS IMMUNIZATION VARIABLES 126 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE IMMUNIZATION 127 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD 128 D QUEUE^C0CXPATH(ZBLD,IMMXML,@IMMXML@(0),@IMMXML@(0)) 129 N ZZTMP ; IS THIS NEEDED? 130 D BUILD^C0CXPATH(ZBLD,IMMOUT) ;BUILD FINAL XML 131 K @ZTEMP,@ZBLD 132 Q 133 ;
Note:
See TracChangeset
for help on using the changeset viewer.
