| 1 | GPLIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
|
|---|
| 2 | ;;0.1;CCDCCR;nopatch;noreleasedate;Build 7
|
|---|
| 3 | ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
|---|
| 4 | ;General Public License See attached copy of the License.
|
|---|
| 5 | ;
|
|---|
| 6 | ;This program is free software; you can redistribute it and/or modify
|
|---|
| 7 | ;it under the terms of the GNU General Public License as published by
|
|---|
| 8 | ;the Free Software Foundation; either version 2 of the License, or
|
|---|
| 9 | ;(at your option) any later version.
|
|---|
| 10 | ;
|
|---|
| 11 | ;This program is distributed in the hope that it will be useful,
|
|---|
| 12 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 13 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 14 | ;GNU General Public License for more details.
|
|---|
| 15 | ;
|
|---|
| 16 | ;You should have received a copy of the GNU General Public License along
|
|---|
| 17 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
|---|
| 18 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|---|
| 19 | ;
|
|---|
| 20 | ;
|
|---|
| 21 | ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR
|
|---|
| 22 | ;
|
|---|
| 23 | MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS
|
|---|
| 24 | ;
|
|---|
| 25 | N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES
|
|---|
| 26 | N C0CZT ; TMP ARRAY OF MAPPED XML
|
|---|
| 27 | S C0CZV=$NA(^TMP("GPLCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES
|
|---|
| 28 | D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES
|
|---|
| 29 | N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS
|
|---|
| 30 | S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY
|
|---|
| 31 | I C0CZIC>0 D ;IMMUNIZATIONS FOUND
|
|---|
| 32 | . F C0CZI=1:1:C0CZIC D ;FOR EACH IMMUNIZATION
|
|---|
| 33 | . . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION
|
|---|
| 34 | . . D MAP^GPLXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML
|
|---|
| 35 | . . I C0CZI=1 D ; FIRST ONE
|
|---|
| 36 | . . . D CP^GPLXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS
|
|---|
| 37 | . . E D ;NOT THE FIRST
|
|---|
| 38 | . . . D INSINNER^GPLXPATH(OUTXML,"C0CZT")
|
|---|
| 39 | E S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES
|
|---|
| 43 | ;
|
|---|
| 44 | ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
|---|
| 45 | ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
|
|---|
| 46 | ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
|
|---|
| 47 | ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
|
|---|
| 48 | ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
|
|---|
| 49 | ;
|
|---|
| 50 | N RPCRSLT,J,K,PTMP,X,VMAP,TBU
|
|---|
| 51 | S TVMAP=$NA(^TMP("GPLCCR",$J,"IMMUNE"))
|
|---|
| 52 | S TARYTMP=$NA(^TMP("GPLCCR",$J,"IMMUARYTMP"))
|
|---|
| 53 | S IMMA=$NA(^TMP("PXI",$J)) ;
|
|---|
| 54 | K @IMMA ; CLEAR OUT PREVIOUS RESULTS
|
|---|
| 55 | K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
|
|---|
| 56 | D IMMUN^PXRHS03(DFN) ;
|
|---|
| 57 | I $O(@IMMA@(""))="" D Q ; RPC RETURNS NULL
|
|---|
| 58 | . W "NULL RESULT FROM IMMUN^PXRHS03 ",!
|
|---|
| 59 | . S @OUTXML@(0)=0
|
|---|
| 60 | ;S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
|
|---|
| 61 | N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ;
|
|---|
| 62 | S C0CIM=""
|
|---|
| 63 | S C0CC=0 ; COUNT
|
|---|
| 64 | F S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST
|
|---|
| 65 | . S C0CC=C0CC+1 ;INCREMENT COUNT
|
|---|
| 66 | . S @TVMAP@(0)=C0CC ; SAVE NEW COUNT TO ARRAY
|
|---|
| 67 | . S VMAP=$NA(@TVMAP@(C0CC)) ; THIS IMMUNE ELEMENT
|
|---|
| 68 | . K @VMAP ; MAKE SURE IT IS CLEARED OUT
|
|---|
| 69 | . W C0CIM,!
|
|---|
| 70 | . S C0CIMD="" ; IMMUNE DATE
|
|---|
| 71 | . F S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD="" D ; FOR EACH DATE
|
|---|
| 72 | . . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD
|
|---|
| 73 | . . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS
|
|---|
| 74 | . . W C0CIEN,"_",C0CIMD
|
|---|
| 75 | . . S C0CT=$$FMDTOUTC^CCRUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME
|
|---|
| 76 | . . W C0CT,!
|
|---|
| 77 | . . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
|
|---|
| 78 | . . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
|
|---|
| 79 | . . S @VMAP@("IMMUNEDATETIME")=C0CT ;FORMATTED DATE/TIME
|
|---|
| 80 | . . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER
|
|---|
| 81 | . . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP
|
|---|
| 82 | . . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION
|
|---|
| 83 | . . I $G(DUZ("AG"))="I" D ; RUNNING IN RPMS
|
|---|
| 84 | . . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD
|
|---|
| 85 | . . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
|
|---|
| 86 | . . . ; FOR LOOKING UP THE CODE
|
|---|
| 87 | . . . ; GET IT FROM THE CODE FILE
|
|---|
| 88 | . . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
|
|---|
| 89 | . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
|
|---|
| 90 | . . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE
|
|---|
| 91 | . . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ;
|
|---|
| 92 | . . . E S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
|
|---|
| 93 | . . E D ; NOT IN RPMS
|
|---|
| 94 | . . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION
|
|---|
| 95 | . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
|
|---|
| 96 | . . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE
|
|---|
| 97 | . . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE
|
|---|
| 98 | N IMMUTMP,I
|
|---|
| 99 | D MISSING^GPLXPATH(ARYTMP,"IMMUTMP") ; SEARCH XML FOR MISSING VARS
|
|---|
| 100 | I IMMUTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
|---|
| 101 | . ; STRINGS MARKED AS @@X@@
|
|---|
| 102 | . W !,"IMMUNE Missing list: ",!
|
|---|
| 103 | . F I=1:1:IMMUTMP(0) W IMMUTMP(I),!
|
|---|
| 104 | Q
|
|---|
| 105 | ;
|
|---|
