source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBGCPT.m@ 1773

Last change on this file since 1773 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PXBGCPT ;ISL/JVS - GATHER CPT ;8/10/04 1:21pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,149,124**;Aug 12, 1996
3 ;
4CPT(VISIT) ;--Gather the entries in the V CPT file
5 ;
6 N IEN,QUANTITY,PROVIDER,NARR,CPT,GROUP,PXBC
7 N DIC,DR,DA,DIQ
8 N PXSFIL,PXSIEN,PXMOD
9 ;
10 K ^TMP("PXBU",$J),VAUGHN,CPT,PXBKY,PXBSAM,PXBSKY,PXBPRV
11 I $D(^AUPNVCPT("AD",VISIT)) D
12 .S IEN=0
13 .F S IEN=$O(^AUPNVCPT("AD",VISIT,IEN)) Q:IEN'>0 D
14 ..S ^TMP("PXBU",$J,"CPT",IEN)=""
15 ;
16A ;--Set array with CPT codes and associated modifiers
17 ;
18 I $D(^TMP("PXBU",$J,"CPT")) D
19 .S IEN=0
20 .F S IEN=$O(^TMP("PXBU",$J,"CPT",IEN)) Q:IEN'>0 D
21 ..N VAUGHN,PX124,EDATA
22 ..S PX124=".01;.16;1204;.04;1*;1202;.05;.09:.15"
23 ..D GETS^DIQ(9000010.18,IEN,PX124,"E","VAUGHN")
24 ..S CPT=$G(VAUGHN(9000010.18,IEN_",",".01","E"))
25 ..S QUANTITY=$G(VAUGHN(9000010.18,IEN_",",".16","E"))
26 ..S PROVIDER=$G(VAUGHN(9000010.18,IEN_",","1204","E"))
27 ..S NARR=$E($G(VAUGHN(9000010.18,IEN_",",".04","E")),1,29)
28 ..I NARR="" S NARR=$P($$CPT^ICPTCOD(CPT,$G(IDATE)),U,3)
29 ..S EDATA=$E($G(VAUGHN(9000010.18,IEN_",",1202,"E")),1,29)
30 ..D CASE^PXBUTL
31 ..S GROUP=CPT_"^"_QUANTITY_"^"_PROVIDER_"^"_NARR
32 ..F PX124=.05,.09,.1,.11,.12,.13,.14,.15 D
33 ...S DA=$G(VAUGHN(9000010.18,IEN_",",PX124,"E")),DR=DA,GROUP=GROUP_U_DA
34 ...I DA S DR=$$XLATE^PXBGPOV(VISIT,DA),DA=$P(DR,U,2)
35 ...I DR S PXBREQ(DA,"I")=$P(DR,U,4,20)
36 ..K DR,DA
37 ..S $P(GROUP,U,22)=EDATA,CPT(CPT,IEN)=GROUP
38 ..S PXSFIL=9000010.181,PXSIEN=""
39 ..F S PXSIEN=$O(VAUGHN(PXSFIL,PXSIEN)) Q:PXSIEN="" D
40 ...S PXMOD=VAUGHN(PXSFIL,PXSIEN,.01,"E")
41 ...S CPT(CPT,IEN,"MOD",+PXSIEN)=PXMOD
42 ;
43B ;--Add line numbers
44 ;
45 I $D(CPT) D
46 .S PXBC=0,CPT=""
47 .F S CPT=$O(CPT(CPT)) Q:CPT="" D
48 ..S IEN=0
49 ..F S IEN=$O(CPT(CPT,IEN)) Q:IEN="" S PXBC=PXBC+1 D
50 ...S PXBKY(CPT,PXBC)=$G(CPT(CPT,IEN))
51 ...S PXBSAM(PXBC)=$G(CPT(CPT,IEN))
52 ...S PXBSKY(PXBC,IEN)=""
53 ...S PXSIEN=0
54 ...F S PXSIEN=$O(CPT(CPT,IEN,"MOD",PXSIEN)) Q:PXSIEN="" D
55 ....S PXBKY(CPT,PXBC,"MOD",PXSIEN)=CPT(CPT,IEN,"MOD",PXSIEN)
56 ....S PXBSAM(PXBC,"MOD",PXSIEN)=CPT(CPT,IEN,"MOD",PXSIEN)
57 ...I $P($G(CPT(CPT,IEN)),"^",3)]"" D
58 ....S PXBPRV($P($G(CPT(CPT,IEN)),"^",3),$P($G(CPT(CPT,IEN)),"^",1),IEN,PXBC)=QUANTITY
59EXIT ;--KILL
60 K ^TMP("PXBU",$J),VAUGHN
61 S PXBCNT=+$G(PXBC)
62 Q
63 ;
Note: See TracBrowser for help on using the repository browser.