Changeset 50
- Timestamp:
- Jul 7, 2008, 1:30:04 AM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLCCR.m
r47 r50 11 11 N CCRGLO 12 12 D CCRRPC(.CCRGLO,DFN,"CCR","","","") 13 S OARY=$NA(^TMP( $J,DFN,"CCR",1))13 S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1)) 14 14 S ONAM="PAT_"_DFN_"_CCR_V1.xml" 15 15 S ODIR="/home/glilly/CCROUT" 16 16 ;S ODIR="/home/cedwards/" 17 17 ;S ODIR="/opt/wv/p/" 18 18 D OUTPUT^GPLXPATH(OARY,ONAM,ODIR) 19 19 Q … … 31 31 ; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN 32 32 S DEBUG=0 33 S TGLOBAL=$NA(^TMP( $J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE34 S CCRGLO=$NA(^TMP( $J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR35 S ACTGLO=$NA(^TMP( $J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS33 S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 34 S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 35 S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 36 36 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 37 S CCRGRTN=$NA(^TMP( $J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL37 S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL 38 38 D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 39 39 D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL … … 48 48 D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES 49 49 ; 50 K ^TMP( $J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT51 S CCRXTAB= "^TMP($J,""CCRSTEP"")"; GLOBAL TO STORE CCR STEPS50 K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 51 S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 52 52 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 53 53 N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD … … 75 75 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 76 76 ; TAB IS PASSED BY NAME 77 ;W "TAB= ",TAB,!78 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP( $J,DFN,""PROBLEMS"")")79 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP( $J,DFN,""VITALS"")")77 W "TAB= ",TAB,! 78 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")") 79 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")") 80 80 Q 81 81 ; 82 82 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 83 N VMAP S VMAP=$NA(^TMP( $J,DFN,"HEADER"))83 N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER")) 84 84 ; K @VMAP 85 85 S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$FMTHL7^XLFDT($$NOW^XLFDT),"DT") -
ccr/trunk/p/GPLPROBS.m
r43 r50 16 16 I '$D(RPCRSLT(0)) W "ERROR CALLING LIST^ORQQPL3 ",! Q 17 17 ZWR RPCRSLT 18 S TVMAP=$NA(^TMP( $J,"PROBVALS"))19 S TARYTMP=$NA(^TMP( $J,"PROBARYTMP"))18 S TVMAP=$NA(^TMP("GPLCCR",$J,"PROBVALS")) 19 S TARYTMP=$NA(^TMP("GPLCCR",$J,"PROBARYTMP")) 20 20 F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST 21 21 . S VMAP=$NA(@TVMAP@(J)) … … 52 52 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML 53 53 . . D INSINNER^GPLXPATH(OUTXML,ARYTMP) 54 ; ZWR ^TMP( $J,"PROBVALS",*)55 ; ZWR ^TMP( $J,"PROBARYTMP",*) ; SHOW THE RESULTS54 ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*) 55 ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS 56 56 ; ZWR @OUTXML 57 57 ; $$HTML^DILF( -
ccr/trunk/p/GPLUNIT.m
r43 r50 39 39 ; 40 40 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D 41 . W NUM," ",LINE,!42 41 . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section 43 42 . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section -
ccr/trunk/p/GPLVITALS.m
r40 r50 10 10 I '$D(VITRSLT(1)) W "ERROR RUNNINIG VITALS RPC",! Q 11 11 ; ZWR RPCRSLT 12 S VITTVMAP=$NA(^TMP( $J,"VITALS"))13 S VITTARYTMP=$NA(^TMP( $J,"VITALARYTMP"))12 S VITTVMAP=$NA(^TMP("GPLCCR",$J,"VITALS")) 13 S VITTARYTMP=$NA(^TMP("GPLCCR",$J,"VITALARYTMP")) 14 14 F J=1:1:VITRSLT(1) D ; FOR EACH VITAL IN THE LIST 15 . I $D(VITRSLT(J)) D 15 . I $D(VITRSLT(J)) D 16 16 . . S VITVMAP=$NA(@VITTVMAP@(J)) 17 17 . . K @VITVMAP -
ccr/trunk/p/GPLXPATH.m
r43 r50 331 331 Q 332 332 ; 333 TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS 334 ; THEXML IS PASSED BY NAME 335 N I,J,TMPXML,DEL 336 F I=1:1:@THEXML@(0) D ; LOOP THROUGH ENTIRE ARRAY 337 . I @THEXML@(I)'["><" D PUSH("TMPXML",@THEXML@(I)) 338 D INDEX("TMPXML") ; MAKE AN XPATH INDEX 339 S I="" S I=$O(TMPXML(I)) 340 F K=0:0 D Q:I="" ; NOW LOOK FOR EMPTY SECTIONS 341 . I I["//" D ; 342 . . W I,TMPXML(I),! 343 . . S J=$P(TMPXML(I),"^",1) 344 . . I J+1=$P(TMPXML(I),"^",2) D ; 345 . . . W I,! 346 . . . S DEL(J)="" 347 . . . S DEL(J+1)="" 348 . S I=$O(TMPXML(I)) 349 F I=1:1:TMPXML(0) D ; 350 . I '$D(DEL(I)) 351 . D PUSH("TMPXML2",TMPXML(I)) 352 D CP("TMPXML2",THEXML) 353 Q 354 ; 333 355 PARY(GLO) ;PRINT AN ARRAY 334 356 N I
Note:
See TracChangeset
for help on using the changeset viewer.