Changeset 1544 for ccr/trunk/p/C0CIM2.m

Timestamp:

Oct 1, 2012, 9:32:46 PM (13 years ago)

Author:

Sam Habiel

Message:

Merged Routines in OHUM branch back in main tree

Location:

ccr/trunk/p

Files:

• . (modified) (1 prop)
• C0CIM2.m (modified) (1 diff, 1 prop)

ccr/trunk/p/C0CIM2.m

@@ -1 @@
-C0CIM2  ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
- ;;1.0;C0C;;Feb 16, 2010;Build 38
- ;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
- ;  
+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
+        ;