| 1 | C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09 | 
|---|
| 2 | ;;1.2;C0C;;May 11, 2012;Build 47 | 
|---|
| 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 | ; | 
|---|