Changeset 1337 for ccr/branches/ohum/p/C0CPROBS.m
- Timestamp:
- Jan 4, 2012, 9:40:24 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CPROBS.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CPROBS.m
r1333 r1337 1 C0CPROBS 2 ;;1.0;C0C;;May 19, 2009;Build 1 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 96 97 VISTA 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 149 150 151 152 153 CCD 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 MISSINGVARS 178 179 180 181 182 183 184 185 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 . ; FOR CERTIFICATION - GPL 63 . I @VMAP@("PROBLEMCODEVALUE")=493.90 S @VMAP@("PROBLEMCODEVALUE")=493 64 . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE OF ONSET","C0CG1"),"DT") 65 . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE LAST MODIFIED","C0CG1"),"DT") 66 . ;S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) ;UNKNOWN NOT MAPPED IN C0CCCR0 67 . ;S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) ;UNKNOWN NOT MAPPED IN C0CCCR0 68 . ;S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) ;NOT MAPPED IN C0CCCR0 69 . ;S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) ;NOT MAPPED IN C0CCCR0 70 . ;S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) ;NOT MAPPED IN C0CCCR0 71 . ;S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) ;NOT MAPPED IN C0CCCR0 72 . ;S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER 73 . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$$ZVALUEI^C0CRNF("RECORDING PROVIDER","C0CG1") 74 . ;S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) ;NOT MAPPED IN C0CCCR0 75 . ;S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) ;NOT MAPPED IN C0CCCR0 76 . ;S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") ;NOT MAPPED IN C0CCCR0 77 . ;S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT") ;NOT MAPPED IN C0CCCR0 78 . S ARYTMP=$NA(@TARYTMP@(J)) 79 . ; W "ARYTMP= ",ARYTMP,! 80 . K @ARYTMP 81 . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ; 82 . I J=1 D ; FIRST ONE IS JUST A COPY 83 . . ; W "FIRST ONE",! 84 . . D CP^C0CXPATH(ARYTMP,OUTXML) 85 . . ; W "OUTXML ",OUTXML,! 86 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML 87 . . D INSINNER^C0CXPATH(OUTXML,ARYTMP) 88 ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*) 89 ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS 90 ; ZWR @OUTXML 91 ; $$HTML^DILF( 92 ; GENERATE THE NARITIVE HTML FOR THE CCD 93 I CCD D CCD ; IF THIS IS FOR A CCD 94 D MISSINGVARS 95 Q 96 ; 97 VISTA ; GETS THE PROBLEM LIST FOR VISTA 98 D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC 99 I '$D(RPCRSLT(1)) D Q ; RPC RETURNS NULL 100 . W "NULL RESULT FROM LIST^ORQQPL3 ",! 101 . S @OUTXML@(0)=0 102 . ; Q 103 ; I DEBUG ZWR RPCRSLT 104 S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS 105 F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST 106 . S VMAP=$NA(@TVMAP@(J)) 107 . K @VMAP 108 . I DEBUG W "VMAP= ",VMAP,! 109 . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY 110 . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM 111 . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1) 112 . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",$P(PTMP,U,2)="I":"Inactive",1:"") 113 . N ZPRIOR S ZPRIOR=$P(PTMP,U,14) ;PRIORITY FLAG 114 . ; turn off acute/chronic for certification gpl 115 . ;S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status 116 . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3) 117 . S @VMAP@("PROBLEMCODINGVERSION")="" 118 . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4) 119 . ; FOR CERTIFICATION - GPL 120 . I @VMAP@("PROBLEMCODEVALUE")["493.90" S @VMAP@("PROBLEMCODEVALUE")=493 121 . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT") 122 . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT") 123 . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) 124 . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) 125 . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) 126 . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) 127 . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) 128 . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) 129 . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER 130 . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1) 131 . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) 132 . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) 133 . S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") 134 . S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT") 135 . S ARYTMP=$NA(@TARYTMP@(J)) 136 . ; W "ARYTMP= ",ARYTMP,! 137 . K @ARYTMP 138 . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ; 139 . I J=1 D ; FIRST ONE IS JUST A COPY 140 . . ; W "FIRST ONE",! 141 . . D CP^C0CXPATH(ARYTMP,OUTXML) 142 . . ; W "OUTXML ",OUTXML,! 143 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML 144 . . D INSINNER^C0CXPATH(OUTXML,ARYTMP) 145 ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*) 146 ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS 147 ; ZWR @OUTXML 148 ; $$HTML^DILF( 149 ; GENERATE THE NARITIVE HTML FOR THE CCD 150 I CCD D CCD ; IF THIS IS FOR A CCD 151 D MISSINGVARS 152 Q 153 CCD 154 N HTMP,HOUT,HTMLO,C0CPROBI,ZX 155 F C0CPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM 156 . S VMAP=$NA(@TVMAP@(C0CPROBI)) 157 . I DEBUG W "VMAP =",VMAP,! 158 . D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE 159 . D UNMARK^C0CXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP 160 . ; D PARY^C0CXPATH("HTMP") ; PRINT IT 161 . D MAP^C0CXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES 162 . ; D PARY^C0CXPATH("HOUT") ; PRINT IT AGAIN 163 . I C0CPROBI=1 D ; FIRST ONE IS JUST A COPY 164 . . D CP^C0CXPATH("HOUT","HTMLO") 165 . I C0CPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML 166 . . I DEBUG W "DOING INNER",! 167 . . N HTMLBLD,HTMLTMP 168 . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1) 169 . . D QUEUE^C0CXPATH("HTMLBLD","HOUT",2,HOUT(0)-1) 170 . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0)) 171 . . D BUILD^C0CXPATH("HTMLBLD","HTMLTMP") 172 . . D CP^C0CXPATH("HTMLTMP","HTMLO") 173 . . ; D INSINNER^C0CXPATH("HOUT","HTMLO","//") 174 I DEBUG D PARY^C0CXPATH("HTMLO") 175 D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION 176 Q 177 MISSINGVARS 178 N PROBSTMP,I 179 D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS 180 I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS - 181 . ; STRINGS MARKED AS @@X@@ 182 . W !,"PROBLEMS Missing list: ",! 183 . F I=1:1:PROBSTMP(0) W PROBSTMP(I),! 184 Q 185 ;
Note:
See TracChangeset
for help on using the changeset viewer.
