| 1 | C0CIM2 ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
|
|---|
| 2 | ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
|---|
| 3 | ;Copyright 2010 George Lilly, University of Minnesota and others.
|
|---|
| 4 | ;
|
|---|
| 5 | ; This program is free software: you can redistribute it and/or modify
|
|---|
| 6 | ; it under the terms of the GNU Affero General Public License as
|
|---|
| 7 | ; published by the Free Software Foundation, either version 3 of the
|
|---|
| 8 | ; License, or (at your option) any later version.
|
|---|
| 9 | ;
|
|---|
| 10 | ; This program is distributed in the hope that it will be useful,
|
|---|
| 11 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 12 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 13 | ; GNU Affero General Public License for more details.
|
|---|
| 14 | ;
|
|---|
| 15 | ; You should have received a copy of the GNU Affero General Public License
|
|---|
| 16 | ; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|---|
| 17 | ;
|
|---|
| 18 | W "NO ENTRY FROM TOP",!
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | EXTRACT(IMMXML,DFN,IMMOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE
|
|---|
| 22 | ; IMMXML AND IMMOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
|---|
| 23 | ;
|
|---|
| 24 | ; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS
|
|---|
| 25 | ; THAT GET PASSED TO *GET ROUTINES
|
|---|
| 26 | ;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
|
|---|
| 27 | N C0CIMM
|
|---|
| 28 | S C0CIMM=$NA(^TMP("C0CCCR",$J,DFN,"C0CIMM"))
|
|---|
| 29 | ; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
|
|---|
| 30 | ; THAT GET INSERTED INTO THE XML TEMPLATE
|
|---|
| 31 | ; I '$D(@C0CIMM) D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS IF NOT THERE
|
|---|
| 32 | D GETRPMS(DFN,C0CIMM) ; GET VARS IF NOT THERE
|
|---|
| 33 | ; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
|
|---|
| 34 | ; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
|
|---|
| 35 | D MAP(IMMXML,C0CIMM,IMMOUT) ;MAP RESULTS FOR PROCEDURES
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | GETRPMS(DFN,C0CIMM) ; CALLS GET^BGOVIMM TO GET IMMUNIZATIONS.
|
|---|
| 39 | ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
|
|---|
| 40 | ; C0CIMM: IMMUNIZATIONS
|
|---|
| 41 | ; READY TO BE MAPPED TO XML BY MAP^C0CIMM
|
|---|
| 42 | ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
|
|---|
| 43 | ; EXIST.
|
|---|
| 44 | ;
|
|---|
| 45 | ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
|
|---|
| 46 | ;
|
|---|
| 47 | ; SETUP RPC/API CALL HERE
|
|---|
| 48 | ; USE START AND END DATES FROM PARAMETERS IF REQUIRED
|
|---|
| 49 | N IMMA
|
|---|
| 50 | D GET^BGOVIMM(.IMMA,DFN) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
|
|---|
| 51 | ; PREFORM SORT HERE IF NEEDED
|
|---|
| 52 | ;
|
|---|
| 53 | ; NO SORT REQUIRED FOR IMMUNIZATIONS
|
|---|
| 54 | ;
|
|---|
| 55 | ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
|
|---|
| 56 | ; RNF1 ARRAY FORMAT:
|
|---|
| 57 | ; VAR("NAME_OF_RIM_VARIABLE")=VALUE
|
|---|
| 58 | ;
|
|---|
| 59 | ; IMMUNIZATIONS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF IMMUNIZATION RESULTS
|
|---|
| 60 | ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
|
|---|
| 61 | ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
|
|---|
| 62 | N C0CIM,C0CC,ZRNF
|
|---|
| 63 | S C0CIM="" ; INITIALIZE FOR $O
|
|---|
| 64 | F C0CC=1:1 S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST
|
|---|
| 65 | . I DEBUG W @IMMA@(C0CIM),!
|
|---|
| 66 | . ; FIGURE OUT WHICH TYPE OF IMMUNIZATION IT IS (IMMUNIZATION, FORECAST, CONTRAINDICATIONS, REFUSALS)
|
|---|
| 67 | . D:$P(@IMMA@(C0CIM),U,1)="I" IMMUN
|
|---|
| 68 | . D:$P(@IMMA@(C0CIM),U,1)="F" FORECAST
|
|---|
| 69 | . D:$P(@IMMA@(C0CIM),U,1)="C" CONTRA
|
|---|
| 70 | . D:$P(@IMMA@(C0CIM),U,1)="R" REFUSE
|
|---|
| 71 | . D RNF1TO2^C0CRNF(C0CIMM,"ZRNF") ;ADD THIS ROW TO THE ARRAY
|
|---|
| 72 | . K ZRNF
|
|---|
| 73 | ; SAVE RIM VARIABLES SEE C0CRIMA
|
|---|
| 74 | N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
|
|---|
| 75 | M @ZRIM=@C0CIMM@("V")
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | IMMUN ; PARSES IMMUNIZATION TYPE ROWS FOR RPMS
|
|---|
| 79 | ; RPC FORMAT
|
|---|
| 80 | ; I ^ Imm Name [2] ^ Visit Date [3] ^ V File IEN [4] ^ Other Location [5] ^ Group [6] ^ Imm IEN [7] ^ Lot [8] ^
|
|---|
| 81 | ; Reaction [9] ^ VIS Date [10] ^ Age [11] ^ Visit Date [12] ^ Provider IEN~Name [13] ^ Inj Site [14] ^
|
|---|
| 82 | ; Volume [15] ^ Visit IEN [16] ^ Visit Category [17] ^ Full Name [18] ^ Location IEN~Name [19] ^ Visit Locked [20]
|
|---|
| 83 | ; RETRIEVE IMMUNIZATION RECORD FROM IMMUNIZATION FILE (9999999.14) FOR THIS IMMUNIZATION
|
|---|
| 84 | D GETN^C0CRNF("C0CZIM",9999999.14,$P(@IMMA@(C0CIM),U,7)) ; GET IMMUNIZATION RECORD
|
|---|
| 85 | ; RETIREVE IMMUNIZATION RECORD FROM V IMMUNIZATION FILE (9000010.11) FOR THIS IMMUNIZATION
|
|---|
| 86 | D GETN^C0CRNF("C0CZVI",9000010.11,$P(@IMMA@(C0CIM),U,4)) ; GET V IMMUNIZATION RECORD
|
|---|
| 87 | S ZRNF("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
|
|---|
| 88 | S ZRNF("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
|
|---|
| 89 | S ZRNF("IMMUNEDATETIME")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("EVENT DATE AND TIME","C0CZVI"),"DT")
|
|---|
| 90 | S ZRNF("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_$P($P(@IMMA@(C0CIM),U,13),"~",1)
|
|---|
| 91 | S ZRNF("IMMUNEPRODUCTNAMETEXT")=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
|
|---|
| 92 | S ZRNF("IMMUNEPRODUCTCODE")=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
|
|---|
| 93 | I $$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM")'="" S ZRNF("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code"
|
|---|
| 94 | E S ZRNF("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
|
|---|
| 95 | ;CLEANUP FROM C0CRNF CALLS
|
|---|
| 96 | K C0CZIM,C0CZVI
|
|---|
| 97 | Q
|
|---|
| 98 | FORECAST ; PARSES FORECAST TYPE ROWS FOR RPMS
|
|---|
| 99 | ; CURRENTLY DISABLED
|
|---|
| 100 | Q
|
|---|
| 101 | CONTRA ; PARSES FORECAST TYPE ROWS FOR RPMS
|
|---|
| 102 | ; CURRENTLY DISABLED
|
|---|
| 103 | Q
|
|---|
| 104 | REFUSE ; PARSES FORECAST TYPE ROWS FOR RPMS
|
|---|
| 105 | ; CURRENTLY DISABLED
|
|---|
| 106 | Q
|
|---|
| 107 | ;
|
|---|
| 108 | MAP(IMMXML,C0CIMM,IMMOUT) ; MAP IMMUNIZATION XML
|
|---|
| 109 | ;
|
|---|
| 110 | N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"IMMTEMP")) ;WORK AREA FOR TEMPLATE
|
|---|
| 111 | K @ZTEMP
|
|---|
| 112 | N ZBLD
|
|---|
| 113 | S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"IMMBLD")) ; BUILD LIST AREA
|
|---|
| 114 | D QUEUE^C0CXPATH(ZBLD,IMMXML,1,1) ; FIRST LINE
|
|---|
| 115 | N ZINNER
|
|---|
| 116 | ; XPATH NEEDS TO MATCH YOUR SECTION
|
|---|
| 117 | D QUERY^C0CXPATH(IMMXML,"//Immunizations/Immunization","ZINNER") ;ONE PROC
|
|---|
| 118 | N ZTMP,ZVAR,ZI
|
|---|
| 119 | S ZI=""
|
|---|
| 120 | F S ZI=$O(@C0CIMM@("V",ZI)) Q:ZI="" D ;FOR EACH IMMUNIZATION
|
|---|
| 121 | . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS IMMUNIZATION XML
|
|---|
| 122 | . S ZVAR=$NA(@C0CIMM@("V",ZI)) ;THIS IMMUNIZATION VARIABLES
|
|---|
| 123 | . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE IMMUNIZATION
|
|---|
| 124 | . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
|
|---|
| 125 | D QUEUE^C0CXPATH(ZBLD,IMMXML,@IMMXML@(0),@IMMXML@(0))
|
|---|
| 126 | N ZZTMP ; IS THIS NEEDED?
|
|---|
| 127 | D BUILD^C0CXPATH(ZBLD,IMMOUT) ;BUILD FINAL XML
|
|---|
| 128 | K @ZTEMP,@ZBLD
|
|---|
| 129 | Q
|
|---|
| 130 | ;
|
|---|
