- PXBGCPT ;ISL/JVS,PKR - GATHER CPT ; Mar 24, 2022@23:05
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,149,124,211,229,230**;Aug 12, 1996;Build 4
- ;
- ; Reference to $$CPT^ICPTCOD in ICR #1995
- ;
- CPT(VISIT) ;--Gather the entries in the V CPT file
- ;
- K PXBKY,PXBSAM,PXBSKY,PXBPRV
- I '$D(^AUPNVCPT("AD",VISIT)) S PXBCNT=0 Q
- ;
- N CPT,CPTA,DA,DR,EDATA,EVENTDT,IEN,IENS,FIELDS,GROUP,MODIFIER
- N PROVIDER,PX124,PXBC,PXSFIL,PXMOD,PXSIEN,QUANTITY,VAUGHN
- A ;--Set array with CPT codes and associated modifiers
- S FIELDS=".01;.04;.05;.09;.15;.16;1*;1201;1202;1204"
- S IEN=0
- F S IEN=$O(^AUPNVCPT("AD",VISIT,IEN)) Q:IEN'>0 D
- .K VAUGHN,EDATA
- .S IENS=IEN_","
- .D GETS^DIQ(9000010.18,IENS,FIELDS,"EI","VAUGHN")
- .S CPT=$G(VAUGHN(9000010.18,IENS,".01","I")) ;PX*1.0*230 - Change to Internal to correct duplicate encounter issue
- .S QUANTITY=$G(VAUGHN(9000010.18,IENS,".16","E"))
- .S EVENTDT=$G(VAUGHN(9000010.18,IENS,"1201","I"))
- .I EVENTDT="" S EVENTDT=$P(^AUPNVSIT(VISIT,0),U,1)
- .S PROVIDER=$G(VAUGHN(9000010.18,IENS,"1204","E"))
- .S NARR=$E($G(VAUGHN(9000010.18,IENS,".04","E")),1,29)
- .I NARR="" S NARR=$P($$CPT^ICPTCOD(CPT,EVENTDT),U,3)
- .S EDATA=$E($G(VAUGHN(9000010.18,IENS,1202,"E")),1,29)
- .D CASE^PXBUTL
- .S GROUP=CPT_"^"_QUANTITY_"^"_PROVIDER_"^"_NARR
- .F PX124=.05,.09,.1,.11,.12,.13,.14,.15 D
- ..S DA=$G(VAUGHN(9000010.18,IENS,PX124,"E")),DR=DA,GROUP=GROUP_U_DA
- ..I DA S DR=$$XLATE^PXBGPOV(VISIT,DA),DA=$P(DR,U,2)
- ..I DR S PXBREQ(DA,"I")=$P(DR,U,4,20)
- .K DR,DA
- .S $P(GROUP,U,22)=EDATA,CPTA(CPT,IEN)=GROUP
- .S PXSFIL=9000010.181,PXSIEN=""
- .F S PXSIEN=$O(VAUGHN(PXSFIL,PXSIEN)) Q:PXSIEN="" D
- ..S PXMOD=VAUGHN(PXSFIL,PXSIEN,.01,"E")
- ..S CPTA(CPT,IEN,"MOD",+PXSIEN)=PXMOD
- ;
- B ;--Add line numbers
- ;
- I $D(CPTA) D
- .S PXBC=0,CPT=""
- .F S CPT=$O(CPTA(CPT)) Q:CPT="" D
- ..S IEN=0
- ..F S IEN=$O(CPTA(CPT,IEN)) Q:IEN="" S PXBC=PXBC+1 D
- ...S PXBKY(CPT,PXBC)=$G(CPTA(CPT,IEN))
- ...S PXBSAM(PXBC)=$G(CPTA(CPT,IEN))
- ...S PXBSKY(PXBC,IEN)=""
- ...S PXSIEN=0
- ...F S PXSIEN=$O(CPTA(CPT,IEN,"MOD",PXSIEN)) Q:PXSIEN="" D
- ....S PXBKY(CPT,PXBC,"MOD",PXSIEN)=CPTA(CPT,IEN,"MOD",PXSIEN)
- ....S PXBSAM(PXBC,"MOD",PXSIEN)=CPTA(CPT,IEN,"MOD",PXSIEN)
- ...I $P($G(CPTA(CPT,IEN)),"^",3)]"" D
- ....S PXBPRV($P($G(CPTA(CPT,IEN)),"^",3),$P($G(CPTA(CPT,IEN)),"^",1),IEN,PXBC)=QUANTITY
- S PXBCNT=+$G(PXBC)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBGCPT 2353 printed Feb 18, 2025@23:52:49 Page 2
- PXBGCPT ;ISL/JVS,PKR - GATHER CPT ; Mar 24, 2022@23:05
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,149,124,211,229,230**;Aug 12, 1996;Build 4
- +2 ;
- +3 ; Reference to $$CPT^ICPTCOD in ICR #1995
- +4 ;
- CPT(VISIT) ;--Gather the entries in the V CPT file
- +1 ;
- +2 KILL PXBKY,PXBSAM,PXBSKY,PXBPRV
- +3 IF '$DATA(^AUPNVCPT("AD",VISIT))
- SET PXBCNT=0
- QUIT
- +4 ;
- +5 NEW CPT,CPTA,DA,DR,EDATA,EVENTDT,IEN,IENS,FIELDS,GROUP,MODIFIER
- +6 NEW PROVIDER,PX124,PXBC,PXSFIL,PXMOD,PXSIEN,QUANTITY,VAUGHN
- A ;--Set array with CPT codes and associated modifiers
- +1 SET FIELDS=".01;.04;.05;.09;.15;.16;1*;1201;1202;1204"
- +2 SET IEN=0
- +3 FOR
- SET IEN=$ORDER(^AUPNVCPT("AD",VISIT,IEN))
- if IEN'>0
- QUIT
- Begin DoDot:1
- +4 KILL VAUGHN,EDATA
- +5 SET IENS=IEN_","
- +6 DO GETS^DIQ(9000010.18,IENS,FIELDS,"EI","VAUGHN")
- +7 ;PX*1.0*230 - Change to Internal to correct duplicate encounter issue
- SET CPT=$GET(VAUGHN(9000010.18,IENS,".01","I"))
- +8 SET QUANTITY=$GET(VAUGHN(9000010.18,IENS,".16","E"))
- +9 SET EVENTDT=$GET(VAUGHN(9000010.18,IENS,"1201","I"))
- +10 IF EVENTDT=""
- SET EVENTDT=$PIECE(^AUPNVSIT(VISIT,0),U,1)
- +11 SET PROVIDER=$GET(VAUGHN(9000010.18,IENS,"1204","E"))
- +12 SET NARR=$EXTRACT($GET(VAUGHN(9000010.18,IENS,".04","E")),1,29)
- +13 IF NARR=""
- SET NARR=$PIECE($$CPT^ICPTCOD(CPT,EVENTDT),U,3)
- +14 SET EDATA=$EXTRACT($GET(VAUGHN(9000010.18,IENS,1202,"E")),1,29)
- +15 DO CASE^PXBUTL
- +16 SET GROUP=CPT_"^"_QUANTITY_"^"_PROVIDER_"^"_NARR
- +17 FOR PX124=.05,.09,.1,.11,.12,.13,.14,.15
- Begin DoDot:2
- +18 SET DA=$GET(VAUGHN(9000010.18,IENS,PX124,"E"))
- SET DR=DA
- SET GROUP=GROUP_U_DA
- +19 IF DA
- SET DR=$$XLATE^PXBGPOV(VISIT,DA)
- SET DA=$PIECE(DR,U,2)
- +20 IF DR
- SET PXBREQ(DA,"I")=$PIECE(DR,U,4,20)
- End DoDot:2
- +21 KILL DR,DA
- +22 SET $PIECE(GROUP,U,22)=EDATA
- SET CPTA(CPT,IEN)=GROUP
- +23 SET PXSFIL=9000010.181
- SET PXSIEN=""
- +24 FOR
- SET PXSIEN=$ORDER(VAUGHN(PXSFIL,PXSIEN))
- if PXSIEN=""
- QUIT
- Begin DoDot:2
- +25 SET PXMOD=VAUGHN(PXSFIL,PXSIEN,.01,"E")
- +26 SET CPTA(CPT,IEN,"MOD",+PXSIEN)=PXMOD
- End DoDot:2
- End DoDot:1
- +27 ;
- B ;--Add line numbers
- +1 ;
- +2 IF $DATA(CPTA)
- Begin DoDot:1
- +3 SET PXBC=0
- SET CPT=""
- +4 FOR
- SET CPT=$ORDER(CPTA(CPT))
- if CPT=""
- QUIT
- Begin DoDot:2
- +5 SET IEN=0
- +6 FOR
- SET IEN=$ORDER(CPTA(CPT,IEN))
- if IEN=""
- QUIT
- SET PXBC=PXBC+1
- Begin DoDot:3
- +7 SET PXBKY(CPT,PXBC)=$GET(CPTA(CPT,IEN))
- +8 SET PXBSAM(PXBC)=$GET(CPTA(CPT,IEN))
- +9 SET PXBSKY(PXBC,IEN)=""
- +10 SET PXSIEN=0
- +11 FOR
- SET PXSIEN=$ORDER(CPTA(CPT,IEN,"MOD",PXSIEN))
- if PXSIEN=""
- QUIT
- Begin DoDot:4
- +12 SET PXBKY(CPT,PXBC,"MOD",PXSIEN)=CPTA(CPT,IEN,"MOD",PXSIEN)
- +13 SET PXBSAM(PXBC,"MOD",PXSIEN)=CPTA(CPT,IEN,"MOD",PXSIEN)
- End DoDot:4
- +14 IF $PIECE($GET(CPTA(CPT,IEN)),"^",3)]""
- Begin DoDot:4
- +15 SET PXBPRV($PIECE($GET(CPTA(CPT,IEN)),"^",3),$PIECE($GET(CPTA(CPT,IEN)),"^",1),IEN,PXBC)=QUANTITY
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 SET PXBCNT=+$GET(PXBC)
- +17 QUIT
- +18 ;
