source: ccr/trunk/p/GPLPROBS.m@ 129

Last change on this file since 129 was 122, checked in by George Lilly, 16 years ago

XINDEX fixes. almost clean except for long var names and big files

File size: 5.3 KB
Line 
1GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
2 ;;0.1;CCDCCR;nopatch;noreleasedate
3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(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 General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 ;
21 ; PROCESS THE PROBLEMS SECTION OF THE CCR
22 ;
23EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
24 ;
25 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
26 ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
27 ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
28 ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
29 ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
30 ;
31 N RPCRSLT,J,K,PTMP,X,VMAP,TBU
32 S TVMAP=$NA(^TMP("GPLCCR",$J,"PROBVALS"))
33 S TARYTMP=$NA(^TMP("GPLCCR",$J,"PROBARYTMP"))
34 K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
35 D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
36 I '$D(RPCRSLT(1)) D Q ; RPC RETURNS NULL
37 . W "NULL RESULT FROM LIST^ORQQPL3 ",!
38 . S @OUTXML@(0)=0
39 . ; Q
40 ; I DEBUG ZWR RPCRSLT
41 F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST
42 . S VMAP=$NA(@TVMAP@(J))
43 . K @VMAP
44 . W "VMAP= ",VMAP,!
45 . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
46 . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
47 . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
48 . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
49 . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
50 . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
51 . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
52 . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
53 . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
54 . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
55 . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
56 . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
57 . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
58 . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
59 . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
60 . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
61 . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
62 . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
63 . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
64 . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
65 . S ARYTMP=$NA(@TARYTMP@(J))
66 . ; W "ARYTMP= ",ARYTMP,!
67 . K @ARYTMP
68 . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
69 . I J=1 D ; FIRST ONE IS JUST A COPY
70 . . ; W "FIRST ONE",!
71 . . D CP^GPLXPATH(ARYTMP,OUTXML)
72 . . ; W "OUTXML ",OUTXML,!
73 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
74 . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
75 ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
76 ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
77 ; ZWR @OUTXML
78 ; $$HTML^DILF(
79 ; GENERATE THE NARITIVE HTML FOR THE CCD
80 I CCD D ; IF THIS IS FOR A CCD
81 . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
82 . F GPLPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM
83 . . S VMAP=$NA(@TVMAP@(GPLPROBI))
84 . . W "VMAP =",VMAP,!
85 . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
86 . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
87 . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
88 . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
89 . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
90 . . I GPLPROBI=1 D ; FIRST ONE IS JUST A COPY
91 . . . D CP^GPLXPATH("HOUT","HTMLO")
92 . . I GPLPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML
93 . . . W "DOING INNER",!
94 . . . N HTMLBLD,HTMLTMP
95 . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
96 . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
97 . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
98 . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
99 . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
100 . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
101 . I DEBUG D PARY^GPLXPATH("HTMLO")
102 . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
103 N PROBSTMP,I
104 D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
105 I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS -
106 . ; STRINGS MARKED AS @@X@@
107 . W "PROBLEMS Missing list: ",!
108 . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
109 Q
110 ;
Note: See TracBrowser for help on using the repository browser.