Changeset 1428 for ccr/branches/ohum/p/C0CIMMU.m
- Timestamp:
- May 11, 2012, 6:06:25 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CIMMU.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CIMMU.m
r1342 r1428 1 C0CIMMU 2 ;;1.0;C0C;;May 19, 2009;Build 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 MAP(IPXML,DFN,OUTXML) 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 EXTRACT(IPXML,DFN,OUTXML) 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 1 C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09 2 ;;1.2;C0C;;May 11, 2012;Build 46 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 MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS 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 EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES 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.
