source: ccr/trunk/p/C0CIM2.m@ 1204

Last change on this file since 1204 was 1204, checked in by George Lilly, 13 years ago

updates for MU Certification

File size: 5.7 KB
Line 
1C0CIM2 ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
2 ;;1.0;C0C;;Feb 16, 2010;Build 38
3 ;Copyright 2010 George Lilly, University of Minnesota and others.
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 W "NO ENTRY FROM TOP",!
22 Q
23 ;
24EXTRACT(IMMXML,DFN,IMMOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE
25 ; IMMXML AND IMMOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
26 ;
27 ; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS
28 ; THAT GET PASSED TO *GET ROUTINES
29 ;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
30 N C0CIMM
31 S C0CIMM=$NA(^TMP("C0CCCR",$J,DFN,"C0CIMM"))
32 ; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
33 ; THAT GET INSERTED INTO THE XML TEMPLATE
34 ; I '$D(@C0CIMM) D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS IF NOT THERE
35 D GETRPMS(DFN,C0CIMM) ; GET VARS IF NOT THERE
36 ; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
37 ; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
38 D MAP(IMMXML,C0CIMM,IMMOUT) ;MAP RESULTS FOR PROCEDURES
39 Q
40 ;
41GETRPMS(DFN,C0CIMM) ; CALLS GET^BGOVIMM TO GET IMMUNIZATIONS.
42 ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
43 ; C0CIMM: IMMUNIZATIONS
44 ; READY TO BE MAPPED TO XML BY MAP^C0CIMM
45 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
46 ; EXIST.
47 ;
48 ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
49 ;
50 ; SETUP RPC/API CALL HERE
51 ; USE START AND END DATES FROM PARAMETERS IF REQUIRED
52 N IMMA
53 D GET^BGOVIMM(.IMMA,DFN) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
54 ; PREFORM SORT HERE IF NEEDED
55 ;
56 ; NO SORT REQUIRED FOR IMMUNIZATIONS
57 ;
58 ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
59 ; RNF1 ARRAY FORMAT:
60 ; VAR("NAME_OF_RIM_VARIABLE")=VALUE
61 ;
62 ; IMMUNIZATIONS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF IMMUNIZATION RESULTS
63 ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
64 ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
65 N C0CIM,C0CC,ZRNF
66 S C0CIM="" ; INITIALIZE FOR $O
67 F C0CC=1:1 S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST
68 . I DEBUG W @IMMA@(C0CIM),!
69 . ; FIGURE OUT WHICH TYPE OF IMMUNIZATION IT IS (IMMUNIZATION, FORECAST, CONTRAINDICATIONS, REFUSALS)
70 . D:$P(@IMMA@(C0CIM),U,1)="I" IMMUN
71 . D:$P(@IMMA@(C0CIM),U,1)="F" FORECAST
72 . D:$P(@IMMA@(C0CIM),U,1)="C" CONTRA
73 . D:$P(@IMMA@(C0CIM),U,1)="R" REFUSE
74 . D RNF1TO2^C0CRNF(C0CIMM,"ZRNF") ;ADD THIS ROW TO THE ARRAY
75 . K ZRNF
76 ; SAVE RIM VARIABLES SEE C0CRIMA
77 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
78 M @ZRIM=@C0CIMM@("V")
79 Q
80 ;
81IMMUN ; PARSES IMMUNIZATION TYPE ROWS FOR RPMS
82 ; RPC FORMAT
83 ; I ^ Imm Name [2] ^ Visit Date [3] ^ V File IEN [4] ^ Other Location [5] ^ Group [6] ^ Imm IEN [7] ^ Lot [8] ^
84 ; Reaction [9] ^ VIS Date [10] ^ Age [11] ^ Visit Date [12] ^ Provider IEN~Name [13] ^ Inj Site [14] ^
85 ; Volume [15] ^ Visit IEN [16] ^ Visit Category [17] ^ Full Name [18] ^ Location IEN~Name [19] ^ Visit Locked [20]
86 ; RETRIEVE IMMUNIZATION RECORD FROM IMMUNIZATION FILE (9999999.14) FOR THIS IMMUNIZATION
87 D GETN^C0CRNF("C0CZIM",9999999.14,$P(@IMMA@(C0CIM),U,7)) ; GET IMMUNIZATION RECORD
88 ; RETIREVE IMMUNIZATION RECORD FROM V IMMUNIZATION FILE (9000010.11) FOR THIS IMMUNIZATION
89 D GETN^C0CRNF("C0CZVI",9000010.11,$P(@IMMA@(C0CIM),U,4)) ; GET V IMMUNIZATION RECORD
90 S ZRNF("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
91 S ZRNF("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
92 S ZRNF("IMMUNEDATETIME")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("EVENT DATE AND TIME","C0CZVI"),"DT")
93 S ZRNF("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_$P($P(@IMMA@(C0CIM),U,13),"~",1)
94 S ZRNF("IMMUNEPRODUCTNAMETEXT")=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
95 S ZRNF("IMMUNEPRODUCTCODE")=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
96 I $$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM")'="" S ZRNF("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code"
97 E S ZRNF("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
98 ;CLEANUP FROM C0CRNF CALLS
99 K C0CZIM,C0CZVI
100 Q
101FORECAST ; PARSES FORECAST TYPE ROWS FOR RPMS
102 ; CURRENTLY DISABLED
103 Q
104CONTRA ; PARSES FORECAST TYPE ROWS FOR RPMS
105 ; CURRENTLY DISABLED
106 Q
107REFUSE ; PARSES FORECAST TYPE ROWS FOR RPMS
108 ; CURRENTLY DISABLED
109 Q
110 ;
111MAP(IMMXML,C0CIMM,IMMOUT) ; MAP IMMUNIZATION XML
112 ;
113 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"IMMTEMP")) ;WORK AREA FOR TEMPLATE
114 K @ZTEMP
115 N ZBLD
116 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"IMMBLD")) ; BUILD LIST AREA
117 D QUEUE^C0CXPATH(ZBLD,IMMXML,1,1) ; FIRST LINE
118 N ZINNER
119 ; XPATH NEEDS TO MATCH YOUR SECTION
120 D QUERY^C0CXPATH(IMMXML,"//Immunizations/Immunization","ZINNER") ;ONE PROC
121 N ZTMP,ZVAR,ZI
122 S ZI=""
123 F S ZI=$O(@C0CIMM@("V",ZI)) Q:ZI="" D ;FOR EACH IMMUNIZATION
124 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS IMMUNIZATION XML
125 . S ZVAR=$NA(@C0CIMM@("V",ZI)) ;THIS IMMUNIZATION VARIABLES
126 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE IMMUNIZATION
127 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
128 D QUEUE^C0CXPATH(ZBLD,IMMXML,@IMMXML@(0),@IMMXML@(0))
129 N ZZTMP ; IS THIS NEEDED?
130 D BUILD^C0CXPATH(ZBLD,IMMOUT) ;BUILD FINAL XML
131 K @ZTEMP,@ZBLD
132 Q
133 ;
Note: See TracBrowser for help on using the repository browser.