Ignore:
Timestamp:
Jan 4, 2012, 9:40:24 PM (13 years ago)
Author:
George Lilly
Message:

certification version without tabs

File:
1 edited

Legend:

Unmodified
Added
Removed
  • ccr/branches/ohum/p/C0CIMMU.m

    r1333 r1337  
    1 C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
    2         ;;1.0;C0C;;May 19, 2009;Build 1
    3         ;Copyright 2008,2009 George Lilly, University of Minnesota.
    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         ;
    22         ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR
    23         ;
    24 MAP(IPXML,DFN,OUTXML)   ; MAP IMMUNIZATIONS
    25         ;
    26         N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES
    27         N C0CZT ; TMP ARRAY OF MAPPED XML
    28         S C0CZV=$NA(^TMP("C0CCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES
    29         D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES
    30         N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS
    31         S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY
    32         I C0CZIC>0 D  ;IMMUNIZATIONS FOUND
    33         . F C0CZI=1:1:C0CZIC D  ;FOR EACH IMMUNIZATION
    34         . . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION
    35         . . D MAP^C0CXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML
    36         . . I C0CZI=1 D  ; FIRST ONE
    37         . . . D CP^C0CXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS
    38         . . E  D  ;NOT THE FIRST
    39         . . . D INSINNER^C0CXPATH(OUTXML,"C0CZT")
    40         E  S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS
    41         N IMMUTMP,I
    42         D MISSING^C0CXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS
    43         I IMMUTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
    44         . ; STRINGS MARKED AS @@X@@
    45         . W !,"IMMUNE Missing list: ",!
    46         . F I=1:1:IMMUTMP(0) W IMMUTMP(I),!
    47         Q
    48         ;
    49 EXTRACT(IPXML,DFN,OUTXML)       ; EXTRACT IMMUNIZATIONS INTO VARIABLES
    50         ;
    51         ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
    52         ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
    53         ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
    54         ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
    55         ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
    56         ;
    57         N RPCRSLT,J,K,PTMP,X,VMAP,TBU
    58         S TVMAP=$NA(^TMP("C0CCCR",$J,"IMMUNE"))
    59         S TARYTMP=$NA(^TMP("C0CCCR",$J,"IMMUARYTMP"))
    60         S IMMA=$NA(^TMP("PXI",$J)) ;
    61         K @IMMA ; CLEAR OUT PREVIOUS RESULTS
    62         K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
    63         D IMMUN^PXRHS03(DFN) ;
    64         I $O(@IMMA@(""))="" D  Q  ; RPC RETURNS NULL
    65         . W "NULL RESULT FROM IMMUN^PXRHS03 ",!
    66         . S @TVMAP@(0)=0
    67         N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ;
    68         S C0CIM=""
    69         S C0CC=0 ; COUNT
    70         F  S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM=""  D  ; FOR EACH IMMUNE TYPE IN THE LIST
    71         . S C0CC=C0CC+1 ;INCREMENT COUNT
    72         . S @TVMAP@(0)=C0CC ; SAVE NEW COUNT TO ARRAY
    73         . S VMAP=$NA(@TVMAP@(C0CC)) ; THIS IMMUNE ELEMENT
    74         . K @VMAP ; MAKE SURE IT IS CLEARED OUT
    75         . W C0CIM,!
    76         . S C0CIMD="" ; IMMUNE DATE
    77         . F  S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD=""  D  ; FOR EACH DATE
    78         . . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD
    79         . . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS
    80         . . W C0CIEN,"_",C0CIMD
    81         . . S C0CT=$$FMDTOUTC^C0CUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME
    82         . . W C0CT,!
    83         . . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
    84         . . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
    85         . . S @VMAP@("IMMUNEDATETIME")=C0CT ;FORMATTED DATE/TIME
    86         . . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER
    87         . . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP
    88         . . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION
    89         . . I $G(DUZ("AG"))="I" D  ; RUNNING IN RPMS
    90         . . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD
    91         . . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
    92         . . . ; FOR LOOKING UP THE CODE
    93         . . . ; GET IT FROM THE CODE FILE
    94         . . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
    95         . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
    96         . . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE
    97         . . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ;
    98         . . . E  S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
    99         . . E  D  ; NOT IN RPMS
    100         . . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION
    101         . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
    102         . . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE
    103         . . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE
    104         N C0CIRIM S C0CIRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
    105         M @C0CIRIM=@TVMAP ; PERSIST RIM VARIABLES
    106         Q
    107         ;
     1C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
     2 ;;1.0;C0C;;May 19, 2009;Build 38
     3 ;Copyright 2008,2009 George Lilly, University of Minnesota.
     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 ;
     22 ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR
     23 ;
     24MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS
     25 ;
     26 N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES
     27 N C0CZT ; TMP ARRAY OF MAPPED XML
     28 S C0CZV=$NA(^TMP("C0CCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES
     29 D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES
     30 N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS
     31 S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY
     32 I C0CZIC>0 D  ;IMMUNIZATIONS FOUND
     33 . F C0CZI=1:1:C0CZIC D  ;FOR EACH IMMUNIZATION
     34 . . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION
     35 . . D MAP^C0CXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML
     36 . . I C0CZI=1 D  ; FIRST ONE
     37 . . . D CP^C0CXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS
     38 . . E  D  ;NOT THE FIRST
     39 . . . D INSINNER^C0CXPATH(OUTXML,"C0CZT")
     40 E  S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS
     41 N IMMUTMP,I
     42 D MISSING^C0CXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS
     43 I IMMUTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
     44 . ; STRINGS MARKED AS @@X@@
     45 . W !,"IMMUNE Missing list: ",!
     46 . F I=1:1:IMMUTMP(0) W IMMUTMP(I),!
     47 Q
     48 ;
     49EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES
     50 ;
     51 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
     52 ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
     53 ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
     54 ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
     55 ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
     56 ;
     57 N RPCRSLT,J,K,PTMP,X,VMAP,TBU
     58 S TVMAP=$NA(^TMP("C0CCCR",$J,"IMMUNE"))
     59 S TARYTMP=$NA(^TMP("C0CCCR",$J,"IMMUARYTMP"))
     60 S IMMA=$NA(^TMP("PXI",$J)) ;
     61 K @IMMA ; CLEAR OUT PREVIOUS RESULTS
     62 K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
     63 D IMMUN^PXRHS03(DFN) ;
     64 I $O(@IMMA@(""))="" D  Q  ; RPC RETURNS NULL
     65 . W "NULL RESULT FROM IMMUN^PXRHS03 ",!
     66 . S @TVMAP@(0)=0
     67 N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ;
     68 S C0CIM=""
     69 S C0CC=0 ; COUNT
     70 F  S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM=""  D  ; FOR EACH IMMUNE TYPE IN THE LIST
     71 . S C0CC=C0CC+1 ;INCREMENT COUNT
     72 . S @TVMAP@(0)=C0CC ; SAVE NEW COUNT TO ARRAY
     73 . S VMAP=$NA(@TVMAP@(C0CC)) ; THIS IMMUNE ELEMENT
     74 . K @VMAP ; MAKE SURE IT IS CLEARED OUT
     75 . W C0CIM,!
     76 . S C0CIMD="" ; IMMUNE DATE
     77 . F  S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD=""  D  ; FOR EACH DATE
     78 . . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD
     79 . . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS
     80 . . W C0CIEN,"_",C0CIMD
     81 . . S C0CT=$$FMDTOUTC^C0CUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME
     82 . . W C0CT,!
     83 . . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
     84 . . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
     85 . . S @VMAP@("IMMUNEDATETIME")=C0CT ;FORMATTED DATE/TIME
     86 . . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER
     87 . . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP
     88 . . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION
     89 . . I $G(DUZ("AG"))="I" D  ; RUNNING IN RPMS
     90 . . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD
     91 . . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
     92 . . . ; FOR LOOKING UP THE CODE
     93 . . . ; GET IT FROM THE CODE FILE
     94 . . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
     95 . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
     96 . . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE
     97 . . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ;
     98 . . . E  S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
     99 . . E  D  ; NOT IN RPMS
     100 . . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION
     101 . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
     102 . . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE
     103 . . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE
     104 N C0CIRIM S C0CIRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
     105 M @C0CIRIM=@TVMAP ; PERSIST RIM VARIABLES
     106 Q
     107 ;
Note: See TracChangeset for help on using the changeset viewer.