Changeset 1204 for ccr/trunk/p/C0CIMMU.m
- Timestamp:
- Jun 23, 2011, 3:01:41 PM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CIMMU.m
r508 r1204 1 1 C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09 2 ;;1.0;C0C;;May 19, 2009; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 2 ;;1.0;C0C;;May 19, 2009;Build 38 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 ; 22 ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR 23 ; 24 24 MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 25 ; 26 N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES 27 N C0CZT ; TMP ARRAY OF MAPPED XML 28 S C0CZV=$NA(^TMP("C0CCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES 29 D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES 30 N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS 31 S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY 32 I C0CZIC>0 D ;IMMUNIZATIONS FOUND 33 . F C0CZI=1:1:C0CZIC D ;FOR EACH IMMUNIZATION 34 . . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION 35 . . D MAP^C0CXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML 36 . . I C0CZI=1 D ; FIRST ONE 37 . . . D CP^C0CXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS 38 . . E D ;NOT THE FIRST 39 . . . D INSINNER^C0CXPATH(OUTXML,"C0CZT") 40 E S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS 41 N IMMUTMP,I 42 D MISSING^C0CXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS 43 I IMMUTMP(0)>0 D ; IF THERE ARE MISSING VARS - 44 . ; STRINGS MARKED AS @@X@@ 45 . W !,"IMMUNE Missing list: ",! 46 . F I=1:1:IMMUTMP(0) W IMMUTMP(I),! 47 Q 48 ; 49 49 EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES 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 50 ; 51 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 52 ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE 53 ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE 54 ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS 55 ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT 56 ; 57 N RPCRSLT,J,K,PTMP,X,VMAP,TBU 58 S TVMAP=$NA(^TMP("C0CCCR",$J,"IMMUNE")) 59 S TARYTMP=$NA(^TMP("C0CCCR",$J,"IMMUARYTMP")) 60 S IMMA=$NA(^TMP("PXI",$J)) ; 61 K @IMMA ; CLEAR OUT PREVIOUS RESULTS 62 K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES 63 D IMMUN^PXRHS03(DFN) ; 64 I $O(@IMMA@(""))="" D Q ; RPC RETURNS NULL 65 . W "NULL RESULT FROM IMMUN^PXRHS03 ",! 66 . S @TVMAP@(0)=0 67 N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ; 68 S C0CIM="" 69 S C0CC=0 ; COUNT 70 F S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST 71 . S C0CC=C0CC+1 ;INCREMENT COUNT 72 . S @TVMAP@(0)=C0CC ; SAVE NEW COUNT TO ARRAY 73 . S VMAP=$NA(@TVMAP@(C0CC)) ; THIS IMMUNE ELEMENT 74 . K @VMAP ; MAKE SURE IT IS CLEARED OUT 75 . W C0CIM,! 76 . S C0CIMD="" ; IMMUNE DATE 77 . F S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD="" D ; FOR EACH DATE 78 . . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD 79 . . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS 80 . . W C0CIEN,"_",C0CIMD 81 . . S C0CT=$$FMDTOUTC^C0CUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME 82 . . W C0CT,! 83 . . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID 84 . . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME 85 . . S @VMAP@("IMMUNEDATETIME")=C0CT ;FORMATTED DATE/TIME 86 . . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER 87 . . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP 88 . . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION 89 . . I $G(DUZ("AG"))="I" D ; RUNNING IN RPMS 90 . . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD 91 . . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD 92 . . . ; FOR LOOKING UP THE CODE 93 . . . ; GET IT FROM THE CODE FILE 94 . . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE 95 . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME 96 . . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE 97 . . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ; 98 . . . E S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL 99 . . E D ; NOT IN RPMS 100 . . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION 101 . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME 102 . . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE 103 . . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE 104 N C0CIRIM S C0CIRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE")) 105 M @C0CIRIM=@TVMAP ; PERSIST RIM VARIABLES 106 Q 107 ;
Note:
See TracChangeset
for help on using the changeset viewer.