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


Ignore:
Timestamp:
Oct 1, 2012, 9:32:46 PM (12 years ago)
Author:
Sam Habiel
Message:

Merged Routines in OHUM branch back in main tree

Location:
ccr/trunk/p
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p

  • ccr/trunk/p/C0CIM2.m

    r1336 r1544  
    1 C0CIM2  ; 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  ;
    24 EXTRACT(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  ;
    41 GETRPMS(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  ;
    81 IMMUN ; 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
    101 FORECAST ; PARSES FORECAST TYPE ROWS FOR RPMS
    102  ; CURRENTLY DISABLED
    103  Q
    104 CONTRA ; PARSES FORECAST TYPE ROWS FOR RPMS
    105  ; CURRENTLY DISABLED
    106  Q
    107 REFUSE ; PARSES FORECAST TYPE ROWS FOR RPMS
    108  ; CURRENTLY DISABLED
    109  Q
    110  ;
    111 MAP(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  
     1C0CIM2  ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
     2        ;;1.2;C0C;;May 11, 2012;Build 47
     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 TracChangeset for help on using the changeset viewer.