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

Last change on this file since 1664 was 1586, checked in by Sam Habiel, 12 years ago

Changed license to AGPL. Some clean-up for XINDEX

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