Changeset 1586 for ccr/trunk/p/C0CRARPT.m
- Timestamp:
- Oct 30, 2012, 1:11:02 PM (12 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0CRARPT.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CRARPT.m
r1544 r1586 1 C0CRARPT ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 4 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR 5 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME 6 ; MIXML IS THE TEMPLATE TO USE 7 ; MOXML IS THE OUTPUT XML ARRAY 8 ; DFN IS THE PATIENT RECORD NUMBER 9 N C0COXML,C0CO,C0CV,C0CIXML 10 I '$D(MIVAR) S C0CV="" ;DEFAULT 11 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY 12 I '$D(MIXML) S C0CIXML="" ;DEFAULT 13 E S C0CIXML=MIXML ;PASSED INPUT XML 14 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK 15 I '$D(MOXML) D Q 16 . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT 17 . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT 18 E D 19 . N C0COOXML 20 . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) 21 . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML") 22 . S C0COCNT=$O(C0CRSXML(""),-1) 23 . S C0CRES=0 24 . F S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES="" D 25 . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>") 26 . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES)) 27 . . S C0COCNT=C0COCNT+1 28 . S C0CRSXML(C0COCNT)="</Results>" 29 . S C0CRSXML(0)=C0COCNT 30 . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 31 . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body") 32 S C0CO=MOXML,@C0CO@(0)=0 33 K C0CRSXML,C0COCNT,C0COXML,C0CRES 34 Q 35 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 36 ; RTN IS PASSED BY REFERENCE 37 N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES 38 N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE 39 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING 40 I RMIXML="" D ; INPUT XML NOT PASSED 41 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE 42 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R") 43 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE 44 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE 45 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED 46 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION 47 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS 48 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE 49 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ 50 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE 51 D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT 52 I '$D(@C0CV@(0)) D Q ; NO VARS THERE 53 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR 54 ; NO RESULTS 55 I @C0CV@(0)=0 S RTN(0)=0 Q 56 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) 57 K @RIMVARS 58 M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH 59 N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP 60 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR) 61 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT 62 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA 63 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END 64 ; TO IMPROVE PERFORMANCE 65 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results> 66 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES 67 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES 68 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST 69 . S C0CMAP=$NA(@C0CV@(C0CI)) ; 70 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA 71 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test> 72 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST 73 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS 74 . . K C0CTO ; CLEAR OUTPUT VARIABLE 75 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT 76 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS 77 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS 78 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ; 79 . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP 80 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test> 81 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test> 82 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML 83 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST 84 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result> 85 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results> 86 D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML 87 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE 88 Q 89 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL 90 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS 91 S RADFN=DFN 92 D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT 93 ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY 94 N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG 95 S C0CQT=1 ; SURPRESS LISTING 96 D LIST ; EXTRACT THE VARIABLES 97 ;S C0CQT=QTSAV ; RESET SILENT FLAG 98 K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT 99 K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN 100 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS 101 Q 102 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB 103 N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP 104 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 105 I '$D(C0CQT) S C0CQT=0 106 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT 107 I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D 108 . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE 109 . K ^TMP("C0CCCR","RATBL") 110 . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL") 111 I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE 112 S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE 113 S C0CHB=$NA(^TMP("HLS",$J)) 114 S C0CI="" 115 S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT 116 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG 117 . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES 118 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1) 119 . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT) 120 . M XV=C0CVAR ; 121 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION 122 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT 123 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT 124 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS 125 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI 126 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR 127 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1) 128 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT 129 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 130 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 131 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS 132 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION 133 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3 134 . . ; RESULTTESTCODEVALUE 135 . . ; RESULTTESTDESCRIPTIONTEXT 136 . . I C0CVAR("C3")="C4" D ; PRIMARY CODE "CPT" 137 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE 138 . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT 139 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT 140 . . E I C0CVAR("C6")'="" D ; NO CPT CODES, USE SECONDARY IF PRESENT 141 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE 142 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME 143 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT 144 . . E D ; NO SECONDARY, USE PRIMARY 145 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE 146 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME 147 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT 148 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ; 149 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG 150 . . S C0CZG=XV("RESULTTESTVALUE") 151 . . S XV("RESULTTESTVALUE")=C0CZG 152 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION 153 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS 154 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT 155 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT 156 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX 157 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE 158 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER 159 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2 160 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID") 161 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT 162 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 163 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 164 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES 165 K XV,C0CZG,C0CX1,C0CX2,C0CVAR 166 Q 1 C0CRARPT ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; 4 ; (C) ELN 2010 5 ; 6 ; This program is free software: you can redistribute it and/or modify 7 ; it under the terms of the GNU Affero General Public License as 8 ; published by the Free Software Foundation, either version 3 of the 9 ; License, or (at your option) any later version. 10 ; 11 ; This program is distributed in the hope that it will be useful, 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ; GNU Affero General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU Affero General Public License 17 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 18 ; 19 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 20 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR 21 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME 22 ; MIXML IS THE TEMPLATE TO USE 23 ; MOXML IS THE OUTPUT XML ARRAY 24 ; DFN IS THE PATIENT RECORD NUMBER 25 N C0COXML,C0CO,C0CV,C0CIXML 26 I '$D(MIVAR) S C0CV="" ;DEFAULT 27 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY 28 I '$D(MIXML) S C0CIXML="" ;DEFAULT 29 E S C0CIXML=MIXML ;PASSED INPUT XML 30 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK 31 I '$D(MOXML) D Q 32 . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT 33 . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT 34 E D 35 . N C0COOXML 36 . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) 37 . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML") 38 . S C0COCNT=$O(C0CRSXML(""),-1) 39 . S C0CRES=0 40 . F S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES="" D 41 . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>") 42 . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES)) 43 . . S C0COCNT=C0COCNT+1 44 . S C0CRSXML(C0COCNT)="</Results>" 45 . S C0CRSXML(0)=C0COCNT 46 . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 47 . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body") 48 S C0CO=MOXML,@C0CO@(0)=0 49 K C0CRSXML,C0COCNT,C0COXML,C0CRES 50 Q 51 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 52 ; RTN IS PASSED BY REFERENCE 53 N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES 54 N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE 55 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING 56 I RMIXML="" D ; INPUT XML NOT PASSED 57 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE 58 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R") 59 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE 60 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE 61 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED 62 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION 63 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS 64 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE 65 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ 66 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE 67 D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT 68 I '$D(@C0CV@(0)) D Q ; NO VARS THERE 69 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR 70 ; NO RESULTS 71 I @C0CV@(0)=0 S RTN(0)=0 Q 72 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) 73 K @RIMVARS 74 M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH 75 N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP 76 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR) 77 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT 78 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA 79 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END 80 ; TO IMPROVE PERFORMANCE 81 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results> 82 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES 83 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES 84 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST 85 . S C0CMAP=$NA(@C0CV@(C0CI)) ; 86 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA 87 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test> 88 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST 89 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS 90 . . K C0CTO ; CLEAR OUTPUT VARIABLE 91 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT 92 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS 93 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS 94 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ; 95 . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP 96 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test> 97 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test> 98 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML 99 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST 100 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result> 101 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results> 102 D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML 103 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE 104 Q 105 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL 106 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS 107 S RADFN=DFN 108 D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT 109 ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY 110 N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG 111 S C0CQT=1 ; SURPRESS LISTING 112 D LIST ; EXTRACT THE VARIABLES 113 ;S C0CQT=QTSAV ; RESET SILENT FLAG 114 K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT 115 K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN 116 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS 117 Q 118 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB 119 N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP 120 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 121 I '$D(C0CQT) S C0CQT=0 122 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT 123 I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D 124 . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE 125 . K ^TMP("C0CCCR","RATBL") 126 . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL") 127 I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE 128 S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE 129 S C0CHB=$NA(^TMP("HLS",$J)) 130 S C0CI="" 131 S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT 132 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG 133 . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES 134 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1) 135 . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT) 136 . M XV=C0CVAR ; 137 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION 138 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT 139 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT 140 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS 141 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI 142 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR 143 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1) 144 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT 145 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 146 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 147 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS 148 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION 149 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3 150 . . ; RESULTTESTCODEVALUE 151 . . ; RESULTTESTDESCRIPTIONTEXT 152 . . I C0CVAR("C3")="C4" D ; PRIMARY CODE "CPT" 153 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE 154 . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT 155 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT 156 . . E I C0CVAR("C6")'="" D ; NO CPT CODES, USE SECONDARY IF PRESENT 157 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE 158 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME 159 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT 160 . . E D ; NO SECONDARY, USE PRIMARY 161 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE 162 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME 163 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT 164 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ; 165 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG 166 . . S C0CZG=XV("RESULTTESTVALUE") 167 . . S XV("RESULTTESTVALUE")=C0CZG 168 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION 169 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS 170 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT 171 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT 172 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX 173 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE 174 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER 175 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2 176 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID") 177 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT 178 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 179 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 180 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES 181 K XV,C0CZG,C0CX1,C0CX2,C0CVAR 182 Q
Note:
See TracChangeset
for help on using the changeset viewer.
