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

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