VistA-ccr/p/C0CIM2.m

C0CIM2	 ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
	;;1.2;C0C;;May 11, 2012;Build 47
	;Copyright 2010 George Lilly, University of Minnesota and others.
	;Licensed under the terms of the GNU General Public License.
	;See attached copy of the License.
	;
	;This program is free software; you can redistribute it and/or modify
	;it under the terms of the GNU General Public License as published by
	;the Free Software Foundation; either version 2 of the License, or
	;(at your option) any later version.
	;
	;This program is distributed in the hope that it will be useful,
	;but WITHOUT ANY WARRANTY; without even the implied warranty of
	;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	;GNU General Public License for more details.
	;
	;You should have received a copy of the GNU General Public License along
	;with this program; if not, write to the Free Software Foundation, Inc.,
	;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
	;
	W "NO ENTRY FROM TOP",!
	Q
	;
EXTRACT(IMMXML,DFN,IMMOUT)	; EXTRACT PROCEDURES INTO XML TEMPLATE
	; IMMXML AND IMMOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
	;
	; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS
	; THAT GET PASSED TO *GET ROUTINES
	;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
	N C0CIMM
	S C0CIMM=$NA(^TMP("C0CCCR",$J,DFN,"C0CIMM"))
	; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
	; THAT GET INSERTED INTO THE XML TEMPLATE
	; I '$D(@C0CIMM) D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS IF NOT THERE
	D GETRPMS(DFN,C0CIMM) ; GET VARS IF NOT THERE
	; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
	; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
	D MAP(IMMXML,C0CIMM,IMMOUT) ;MAP RESULTS FOR PROCEDURES
	Q
	;
GETRPMS(DFN,C0CIMM)	; CALLS GET^BGOVIMM TO GET IMMUNIZATIONS. 
	; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
	; C0CIMM: IMMUNIZATIONS
	; READY TO BE MAPPED TO XML BY MAP^C0CIMM
	; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 
	; EXIST.
	;
	; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
	;
	; SETUP RPC/API CALL HERE
	; USE START AND END DATES FROM PARAMETERS IF REQUIRED
	N IMMA
	D GET^BGOVIMM(.IMMA,DFN) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
	; PREFORM SORT HERE IF NEEDED
	;
	; NO SORT REQUIRED FOR IMMUNIZATIONS
	;
	; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
	; RNF1 ARRAY FORMAT:
	; VAR("NAME_OF_RIM_VARIABLE")=VALUE
	;
	; IMMUNIZATIONS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF IMMUNIZATION RESULTS
	; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
	; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
	N C0CIM,C0CC,ZRNF
	S C0CIM="" ; INITIALIZE FOR $O
	F C0CC=1:1 S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM=""  D  ; FOR EACH IMMUNE TYPE IN THE LIST
	. I DEBUG W @IMMA@(C0CIM),!
	. ; FIGURE OUT WHICH TYPE OF IMMUNIZATION IT IS (IMMUNIZATION, FORECAST, CONTRAINDICATIONS, REFUSALS)
	. D:$P(@IMMA@(C0CIM),U,1)="I" IMMUN
	. D:$P(@IMMA@(C0CIM),U,1)="F" FORECAST
	. D:$P(@IMMA@(C0CIM),U,1)="C" CONTRA
	. D:$P(@IMMA@(C0CIM),U,1)="R" REFUSE
	. D RNF1TO2^C0CRNF(C0CIMM,"ZRNF") ;ADD THIS ROW TO THE ARRAY
	. K ZRNF
	; SAVE RIM VARIABLES SEE C0CRIMA
	N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
	M @ZRIM=@C0CIMM@("V")
	Q
	;
IMMUN	; PARSES IMMUNIZATION TYPE ROWS FOR RPMS
	; RPC FORMAT
	;    I ^ Imm Name [2] ^ Visit Date [3] ^ V File IEN [4] ^ Other Location [5] ^ Group [6] ^ Imm IEN [7] ^ Lot [8] ^
	;     Reaction [9] ^ VIS Date [10] ^ Age [11] ^ Visit Date [12] ^ Provider IEN~Name [13] ^ Inj Site [14] ^
	;     Volume [15] ^ Visit IEN [16] ^ Visit Category [17] ^ Full Name [18] ^ Location IEN~Name [19] ^ Visit Locked [20]
	; RETRIEVE IMMUNIZATION RECORD FROM IMMUNIZATION FILE (9999999.14) FOR THIS IMMUNIZATION
	D GETN^C0CRNF("C0CZIM",9999999.14,$P(@IMMA@(C0CIM),U,7)) ; GET IMMUNIZATION RECORD
	; RETIREVE IMMUNIZATION RECORD FROM V IMMUNIZATION FILE (9000010.11) FOR THIS IMMUNIZATION
	D GETN^C0CRNF("C0CZVI",9000010.11,$P(@IMMA@(C0CIM),U,4)) ; GET V IMMUNIZATION RECORD
	S ZRNF("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
	S ZRNF("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
	S ZRNF("IMMUNEDATETIME")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("EVENT DATE AND TIME","C0CZVI"),"DT")
	S ZRNF("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_$P($P(@IMMA@(C0CIM),U,13),"~",1)
	S ZRNF("IMMUNEPRODUCTNAMETEXT")=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
	S ZRNF("IMMUNEPRODUCTCODE")=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
	I $$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM")'="" S ZRNF("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code"
	E  S ZRNF("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
	;CLEANUP FROM C0CRNF CALLS
	K C0CZIM,C0CZVI
	Q
FORECAST	; PARSES FORECAST TYPE ROWS FOR RPMS
	; CURRENTLY DISABLED
	Q
CONTRA	; PARSES FORECAST TYPE ROWS FOR RPMS
	; CURRENTLY DISABLED
	Q
REFUSE	; PARSES FORECAST TYPE ROWS FOR RPMS
	; CURRENTLY DISABLED
	Q
	;
MAP(IMMXML,C0CIMM,IMMOUT)	; MAP IMMUNIZATION XML 
	;
	N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"IMMTEMP")) ;WORK AREA FOR TEMPLATE
	K @ZTEMP
	N ZBLD
	S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"IMMBLD")) ; BUILD LIST AREA
	D QUEUE^C0CXPATH(ZBLD,IMMXML,1,1) ; FIRST LINE
	N ZINNER
	; XPATH NEEDS TO MATCH YOUR SECTION
	D QUERY^C0CXPATH(IMMXML,"//Immunizations/Immunization","ZINNER") ;ONE PROC
	N ZTMP,ZVAR,ZI
	S ZI=""
	F  S ZI=$O(@C0CIMM@("V",ZI)) Q:ZI=""  D  ;FOR EACH IMMUNIZATION
	. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS IMMUNIZATION XML
	. S ZVAR=$NA(@C0CIMM@("V",ZI)) ;THIS IMMUNIZATION VARIABLES
	. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE IMMUNIZATION
	. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
	D QUEUE^C0CXPATH(ZBLD,IMMXML,@IMMXML@(0),@IMMXML@(0))
	N ZZTMP ; IS THIS NEEDED?
	D BUILD^C0CXPATH(ZBLD,IMMOUT) ;BUILD FINAL XML
	K @ZTEMP,@ZBLD
	Q
	;