source: ccr/trunk/p/C0CIMMU.m@ 393

Last change on this file since 393 was 391, checked in by George Lilly, 15 years ago

name spacing the package to C0C ... removing all GPL references
File size: 4.7 KB
Line 
1C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
2 ;;0.1;CCDCCR;nopatch;noreleasedate;Build 7
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 ;
24MAP(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 ;
49EXTRACT(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^CCRUTIL(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 TracBrowser for help on using the repository browser.