Changeset 1337 for ccr/branches/ohum/p/C0CIM2.m

Timestamp:

Jan 4, 2012, 9:40:24 PM (13 years ago)

Author:

George Lilly

Message:

certification version without tabs

File:

• ccr/branches/ohum/p/C0CIM2.m (modified) (1 diff)

ccr/branches/ohum/p/C0CIM2.m

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