Changeset 785 for ccr/trunk/p/C0CENC.m

Timestamp:

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

Author:

George Lilly

Message:

encoutners

File:

• ccr/trunk/p/C0CENC.m (modified) (2 diffs)

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