Changeset 785 for ccr/trunk/p

Timestamp:

May 25, 2010, 1:45:29 PM (15 years ago)

Author:

George Lilly

Message:

encoutners

Location:

ccr/trunk/p

Files:

• C0CCMT.m (modified) (2 diffs)
• C0CENC.m (modified) (2 diffs)
• C0CXPATH.m (modified) (1 diff)

ccr/trunk/p/C0CCMT.m

@@ -46 +46 @@
  . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
  . N ZNOTE,ZN
+ . D CLEAN($NA(@C0CNTE@(ZI,"TEXT"))) ;REMOVE CONTROL CHARS AND XML RESERVED
  . M ZNOTE=@C0CNTE@(ZI,"TEXT") ;THE NOTE TO ADD TO THE BUILD
  . S ZNOTE(0)=$O(ZNOTE(""),-1) ;LENGTH OF THE NOTE
@@ -56 +57 @@
  Q
  ;  
+CLEAN(INARY) ; INARY IS PASSED BY NAME
+ ; REMOVE CONTROL CHARACTERS AND XML RESERVED SYMBOLS FROM THE ARRAY
+ N ZI,ZJ S ZI=""
+ F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ;
+ . S @INARY@(ZI)=$$CLEAN^C0CXPATH(@INARY@(ZI)) ; CONTROL CHARS
+ . S @INARY@(ZI)=$$SYMENC^MXMLUTL(@INARY@(ZI)) ; XML RESERVED SYMBOLS
+ Q
+ ;

ccr/trunk/p/C0CENC.m

@@ -26 +26 @@
  ;
  D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
- I '$D(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
+ ;I '$D(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
+ K @C0CENC
+ D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS
  D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS
  Q
@@ -109 +111 @@
  ; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/10
  N ZS,ZC
- S ZC=$O(@ZARY@("CPT","")) ; FIRST CPT IN THE VISIT
- S ZS=$G(@ZARY@("CPT",ZC)) ; PIECES OF THE FIRST CPT
- I ZS="" Q 0 ; OOPS NO TEXT FOR THE TYPE QUIT
- S ZTXT=$P(ZS,U,3) ; TEXT OF THE FIRST CPT
- I ZTXT="" Q 0 ; NO ENCOUNTER TYPE FOUND
- S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER
- S ZSYS=""
- I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE
+ S ZC="" S ZS=""
+ S ZTXT=""
+ F  S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC=""  D  ; TRY AND FIND A "99" CPT CODE
+ . N ZT
+ . S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE
+ . I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE?
+ I ZS'="" D  ; CODED ENCOUNTER TYPE FOUND
+ . S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE
+ . S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER
+ . S ZSYS=""
+ . I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE
+ I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES
+ I ZTXT="" Q 0 ; FAILED
+ W !,ZTXT
  Q 1 ; SUCCESS
+ ;
+ANYTXT(ZVST) ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE
+ ; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED)
+ ; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME
+ ; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY
+ N ZI,ZJ
+ S ZI="" S ZJ=""
+ F  S ZI=$O(@ZVST@("CPT",ZI)) Q:ZI=""  D  ; LOOK FOR SOME TEXT TO USE
+ . N ZT
+ . S ZT=$G(@ZVST@("CPT",ZI)) ; LOOK AT THIS CPT MULTIPLE
+ . I $P(ZT,U,2)_" "_$P(ZT,U,3)'=" " S ZJ=$P(ZT,U,2)_" "_$P(ZT,U,3)
+ . ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE
+ I ZJ="" S ZJ=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE
+ Q ZJ
  ;
 PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME

ccr/trunk/p/C0CXPATH.m

@@ -324 +324 @@
  Q
  ;
-CLEAN(STR) ; extrinsic function; returns string
+CLEAN(STR,TR) ; extrinsic function; returns string
  ;; Removes all non printable characters from a string.
  ;; STR by Value
+ ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE
  N TR,I
- F I=0:1:31 S TR=$G(TR)_$C(I)
- S TR=TR_$C(127)
+ I '$D(TR) D  ;
+ . F I=0:1:31 S TR=$G(TR)_$C(I)
+ . S TR=TR_$C(127)
  QUIT $TR(STR,TR)
  ;