Changeset 1204 for ccr/trunk/p/C0CPROBS.m
- Timestamp:
- Jun 23, 2011, 3:01:41 PM (14 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0CPROBS.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CPROBS.m
r762 r1204 1 C0CPROBS 2 ;;1.0;C0C;;May 19, 2009; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 EXTRACT(IPXML,DFN,OUTXML) 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 RPMS 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 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 VISTA 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 CCD 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 MISSINGVARS 173 174 175 176 177 178 179 180 1 C0CPROBS ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08 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 PROBLEMS SECTION OF THE CCR 23 ; 24 EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE 25 ; 26 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 27 ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE 28 ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE 29 ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS 30 ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT 31 ; 32 N RPCRSLT,J,K,PTMP,X,VMAP,TBU 33 S TVMAP=$NA(^TMP("C0CCCR",$J,"PROBVALS")) 34 S TARYTMP=$NA(^TMP("C0CCCR",$J,"PROBARYTMP")) 35 K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES 36 I $$RPMS^C0CUTIL() D RPMS ; IF BGOPRB ROUTINE IS MISSING (IE RPMS) 37 I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT 38 Q 39 ; 40 RPMS ; GETS THE PROBLEM LIST FOR RPMS 41 S RPCGLO=$NA(^TMP("BGO",$J)) 42 D GET^BGOPROB(.RPCRSLT,DFN) ; CALL THE PROBLEM LIST RPC 43 ; FORMAT OF RPC: 44 ; Number Code [1] ^ Patient IEN [2] ^ ICD Code [3] ^ Modify Date [4] ^ Class [5] ^ Provider Narrative [6] ^ 45 ; Date Entered [7] ^ Status [8] ^ Date Onset [9] ^ Problem IEN [10] ^ Notes [11] ^ ICD9 IEN [12] ^ 46 ; ICD9 Short Name [13] ^ Provider [14] ^ Facility IEN [15] ^ Priority [16] 47 I '$D(@RPCGLO) W "NULL RESULT FROM GET^BGOPROB ",! S @OUTXML@(0)=0 Q 48 S J="" 49 F S J=$O(@RPCGLO@(J)) Q:J="" D ; FOR EACH PROBLEM IN THE LIST 50 . S VMAP=$NA(@TVMAP@(J)) 51 . K @VMAP 52 . I DEBUG W "VMAP= ",VMAP,! 53 . S PTMP=@RPCRSLT@(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY 54 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL 55 . D GETN1^C0CRNF("C0CG1",9000011,$P(PTMP,U,10),"") ;GET VALUES BY NAME 56 . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM 57 . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,10) 58 . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,8)="A":"Active",$P(PTMP,U,8)="I":"Inactive",1:"") 59 . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,6) 60 . S @VMAP@("PROBLEMCODINGVERSION")="" 61 . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,3) 62 . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE OF ONSET","C0CG1"),"DT") 63 . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE LAST MODIFIED","C0CG1"),"DT") 64 . ;S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) ;UNKNOWN NOT MAPPED IN C0CCCR0 65 . ;S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) ;UNKNOWN NOT MAPPED IN C0CCCR0 66 . ;S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) ;NOT MAPPED IN C0CCCR0 67 . ;S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) ;NOT MAPPED IN C0CCCR0 68 . ;S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) ;NOT MAPPED IN C0CCCR0 69 . ;S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) ;NOT MAPPED IN C0CCCR0 70 . ;S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER 71 . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$$ZVALUEI^C0CRNF("RECORDING PROVIDER","C0CG1") 72 . ;S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) ;NOT MAPPED IN C0CCCR0 73 . ;S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) ;NOT MAPPED IN C0CCCR0 74 . ;S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") ;NOT MAPPED IN C0CCCR0 75 . ;S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT") ;NOT MAPPED IN C0CCCR0 76 . S ARYTMP=$NA(@TARYTMP@(J)) 77 . ; W "ARYTMP= ",ARYTMP,! 78 . K @ARYTMP 79 . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ; 80 . I J=1 D ; FIRST ONE IS JUST A COPY 81 . . ; W "FIRST ONE",! 82 . . D CP^C0CXPATH(ARYTMP,OUTXML) 83 . . ; W "OUTXML ",OUTXML,! 84 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML 85 . . D INSINNER^C0CXPATH(OUTXML,ARYTMP) 86 ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*) 87 ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS 88 ; ZWR @OUTXML 89 ; $$HTML^DILF( 90 ; GENERATE THE NARITIVE HTML FOR THE CCD 91 I CCD D CCD ; IF THIS IS FOR A CCD 92 D MISSINGVARS 93 Q 94 ; 95 VISTA ; GETS THE PROBLEM LIST FOR VISTA 96 D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC 97 I '$D(RPCRSLT(1)) D Q ; RPC RETURNS NULL 98 . W "NULL RESULT FROM LIST^ORQQPL3 ",! 99 . S @OUTXML@(0)=0 100 . ; Q 101 ; I DEBUG ZWR RPCRSLT 102 S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS 103 F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST 104 . S VMAP=$NA(@TVMAP@(J)) 105 . K @VMAP 106 . I DEBUG W "VMAP= ",VMAP,! 107 . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY 108 . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM 109 . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1) 110 . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",$P(PTMP,U,2)="I":"Inactive",1:"") 111 . N ZPRIOR S ZPRIOR=$P(PTMP,U,14) ;PRIORITY FLAG 112 . S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status 113 . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3) 114 . S @VMAP@("PROBLEMCODINGVERSION")="" 115 . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4) 116 . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT") 117 . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT") 118 . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) 119 . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) 120 . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) 121 . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) 122 . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) 123 . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) 124 . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER 125 . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1) 126 . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) 127 . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) 128 . S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") 129 . S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT") 130 . S ARYTMP=$NA(@TARYTMP@(J)) 131 . ; W "ARYTMP= ",ARYTMP,! 132 . K @ARYTMP 133 . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ; 134 . I J=1 D ; FIRST ONE IS JUST A COPY 135 . . ; W "FIRST ONE",! 136 . . D CP^C0CXPATH(ARYTMP,OUTXML) 137 . . ; W "OUTXML ",OUTXML,! 138 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML 139 . . D INSINNER^C0CXPATH(OUTXML,ARYTMP) 140 ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*) 141 ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS 142 ; ZWR @OUTXML 143 ; $$HTML^DILF( 144 ; GENERATE THE NARITIVE HTML FOR THE CCD 145 I CCD D CCD ; IF THIS IS FOR A CCD 146 D MISSINGVARS 147 Q 148 CCD 149 N HTMP,HOUT,HTMLO,C0CPROBI,ZX 150 F C0CPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM 151 . S VMAP=$NA(@TVMAP@(C0CPROBI)) 152 . I DEBUG W "VMAP =",VMAP,! 153 . D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE 154 . D UNMARK^C0CXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP 155 . ; D PARY^C0CXPATH("HTMP") ; PRINT IT 156 . D MAP^C0CXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES 157 . ; D PARY^C0CXPATH("HOUT") ; PRINT IT AGAIN 158 . I C0CPROBI=1 D ; FIRST ONE IS JUST A COPY 159 . . D CP^C0CXPATH("HOUT","HTMLO") 160 . I C0CPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML 161 . . I DEBUG W "DOING INNER",! 162 . . N HTMLBLD,HTMLTMP 163 . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1) 164 . . D QUEUE^C0CXPATH("HTMLBLD","HOUT",2,HOUT(0)-1) 165 . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0)) 166 . . D BUILD^C0CXPATH("HTMLBLD","HTMLTMP") 167 . . D CP^C0CXPATH("HTMLTMP","HTMLO") 168 . . ; D INSINNER^C0CXPATH("HOUT","HTMLO","//") 169 I DEBUG D PARY^C0CXPATH("HTMLO") 170 D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION 171 Q 172 MISSINGVARS 173 N PROBSTMP,I 174 D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS 175 I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS - 176 . ; STRINGS MARKED AS @@X@@ 177 . W !,"PROBLEMS Missing list: ",! 178 . F I=1:1:PROBSTMP(0) W PROBSTMP(I),! 179 Q 180 ;
Note:
See TracChangeset
for help on using the changeset viewer.
