Changeset 1586 for ccr/trunk/p/C0COVRES.m
- Timestamp:
- Oct 30, 2012, 1:11:02 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0COVRES.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0COVRES.m
r1544 r1586 1 1 C0COVRES ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15 2 ;;1.2;C0C;;May 11, 2012;Build 47 3 ; 2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 ; (C) ELN 2012 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 ; 4 18 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 19 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR 20 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME 21 ; MIXML IS THE TEMPLATE TO USE 22 ; MOXML IS THE OUTPUT XML ARRAY 23 ; DFN IS THE PATIENT RECORD NUMBER 24 N C0COXML,C0CO,C0CV,C0CIXML 25 I '$D(MIVAR) S C0CV="" ;DEFAULT 26 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY 27 I '$D(MIXML) S C0CIXML="" ;DEFAULT 28 E S C0CIXML=MIXML ;PASSED INPUT XML 29 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK 30 I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT 31 E S C0CO=MOXML 32 M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT 33 Q 20 34 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 35 ; RTN IS PASSED BY REFERENCE 36 N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES 37 N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE 38 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING 39 I RMIXML="" D ; INPUT XML NOT PASSED 40 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE 41 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R") 42 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE 43 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE 44 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED 45 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION 46 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS 47 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE 48 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ 49 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE 50 D EXTRACT("C0CT",DFN,) ; LAB EXTRACT 51 D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT 52 ;OHUM/RUT 3111221 53 ;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT 54 I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT 55 ;OHUM/RUT 56 I '$D(@C0CV@(0)) D Q ; NO VARS THERE 57 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR 58 ; NO RESULTS 59 I @C0CV@(0)=0 S RTN(0)=0 Q 60 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) 61 K @RIMVARS 62 ;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH 63 N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP 64 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR) 65 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT 66 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA 67 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END 68 ; TO IMPROVE PERFORMANCE 69 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results> 70 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES 71 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES 72 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST 73 . S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE 74 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA 75 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test> 76 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST 77 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS 78 . . K C0CTO ; CLEAR OUTPUT VARIABLE 79 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT 80 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS 81 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS 82 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ; 83 . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP 84 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test> 85 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test> 86 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML 87 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST 88 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result> 89 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results> 90 D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML 91 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE 92 Q 79 93 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 94 ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 95 N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG 96 S C0CNSSN=0 97 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 98 D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT 99 I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT 100 . S @C0CLB@(0)=0 101 ;K @C0CLB ; CLEAR OUT OLD VARS IF ANY 102 N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG 103 S C0CQT=1 ; SURPRESS LISTING 104 D LIST^C0COVREL ; EXTRACT THE VARIABLES 105 S C0CQT=QTSAV ; RESET SILENT FLAG 106 K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT 107 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS 108 Q
Note:
See TracChangeset
for help on using the changeset viewer.
