- PXBGCPT ;ISL/JVS - GATHER CPT ;7/16/96 11:41
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**73**;Aug 12, 1996
- ;
- CPT(VISIT) ;--Gather the entries in the V CPT file
- ;
- N IEN,QUANTITY,PROVIDER,NARR,CPT,GROUP,PXBC
- N DIC,DR,DA,DIQ
- N PXSFIL,PXSIEN,PXMOD
- ;
- K ^TMP("PXBU",$J),VAUGHN,CPT,PXBKY,PXBSAM,PXBSKY,PXBPRV
- I $D(^AUPNVCPT("AD",VISIT)) D
- .S IEN=0
- .F S IEN=$O(^AUPNVCPT("AD",VISIT,IEN)) Q:IEN'>0 D
- ..S ^TMP("PXBU",$J,"CPT",IEN)=""
- ;
- A ;--Set array with CPT codes and associated modifiers
- ;
- I $D(^TMP("PXBU",$J,"CPT")) D
- .S IEN=0
- .F S IEN=$O(^TMP("PXBU",$J,"CPT",IEN)) Q:IEN'>0 D
- ..N VAUGHN
- ..D GETS^DIQ(9000010.18,IEN,".01;.16;1204;.04;1*","E","VAUGHN")
- ..S CPT=$G(VAUGHN(9000010.18,IEN_",",".01","E"))
- ..S QUANTITY=$G(VAUGHN(9000010.18,IEN_",",".16","E"))
- ..S PROVIDER=$G(VAUGHN(9000010.18,IEN_",","1204","E"))
- ..S NARR=$E($G(VAUGHN(9000010.18,IEN_",",".04","E")),1,29)
- ..I NARR="" S NARR=$$GET1^DIQ(81,CPT,2)
- ..D CASE^PXBUTL
- ..S GROUP=CPT_"^"_QUANTITY_"^"_PROVIDER_"^"_NARR
- ..S CPT(CPT,IEN)=GROUP
- ..S PXSFIL=9000010.181
- ..S PXSIEN=""
- ..F S PXSIEN=$O(VAUGHN(PXSFIL,PXSIEN)) Q:PXSIEN="" D
- ...S PXMOD=VAUGHN(PXSFIL,PXSIEN,.01,"E")
- ...S CPT(CPT,IEN,"MOD",+PXSIEN)=PXMOD
- ;
- B ;--Add line numbers
- ;
- I $D(CPT) D
- .S PXBC=0,CPT=""
- .F S CPT=$O(CPT(CPT)) Q:CPT="" D
- ..S IEN=0
- ..F S IEN=$O(CPT(CPT,IEN)) Q:IEN="" S PXBC=PXBC+1 D
- ...S PXBKY(CPT,PXBC)=$G(CPT(CPT,IEN))
- ...S PXBSAM(PXBC)=$G(CPT(CPT,IEN))
- ...S PXBSKY(PXBC,IEN)=""
- ...S PXSIEN=0
- ...F S PXSIEN=$O(CPT(CPT,IEN,"MOD",PXSIEN)) Q:PXSIEN="" D
- ....S PXBKY(CPT,PXBC,"MOD",PXSIEN)=CPT(CPT,IEN,"MOD",PXSIEN)
- ....S PXBSAM(PXBC,"MOD",PXSIEN)=CPT(CPT,IEN,"MOD",PXSIEN)
- ...I $P($G(CPT(CPT,IEN)),"^",3)]"" D
- ....S PXBPRV($P($G(CPT(CPT,IEN)),"^",3),$P($G(CPT(CPT,IEN)),"^",1),IEN,PXBC)=QUANTITY
- EXIT ;--KILL
- K ^TMP("PXBU",$J),VAUGHN
- S PXBCNT=+$G(PXBC)
- Q
- ;
- PXBGCPT ;ISL/JVS - GATHER CPT ;7/16/96 11:41
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73**;Aug 12, 1996
- +2 ;
- CPT(VISIT) ;--Gather the entries in the V CPT file
- +1 ;
- +2 NEW IEN,QUANTITY,PROVIDER,NARR,CPT,GROUP,PXBC
- +3 NEW DIC,DR,DA,DIQ
- +4 NEW PXSFIL,PXSIEN,PXMOD
- +5 ;
- +6 KILL ^TMP("PXBU",$JOB),VAUGHN,CPT,PXBKY,PXBSAM,PXBSKY,PXBPRV
- +7 IF $DATA(^AUPNVCPT("AD",VISIT))
- Begin DoDot:1
- +8 SET IEN=0
- +9 FOR
- SET IEN=$ORDER(^AUPNVCPT("AD",VISIT,IEN))
- IF IEN'>0
- QUIT
- Begin DoDot:2
- +10 SET ^TMP("PXBU",$JOB,"CPT",IEN)=""
- End DoDot:2
- End DoDot:1
- +11 ;
- A ;--Set array with CPT codes and associated modifiers
- +1 ;
- +2 IF $DATA(^TMP("PXBU",$JOB,"CPT"))
- Begin DoDot:1
- +3 SET IEN=0
- +4 FOR
- SET IEN=$ORDER(^TMP("PXBU",$JOB,"CPT",IEN))
- IF IEN'>0
- QUIT
- Begin DoDot:2
- +5 NEW VAUGHN
- +6 DO GETS^DIQ(9000010.18,IEN,".01;.16;1204;.04;1*","E","VAUGHN")
- +7 SET CPT=$GET(VAUGHN(9000010.18,IEN_",",".01","E"))
- +8 SET QUANTITY=$GET(VAUGHN(9000010.18,IEN_",",".16","E"))
- +9 SET PROVIDER=$GET(VAUGHN(9000010.18,IEN_",","1204","E"))
- +10 SET NARR=$EXTRACT($GET(VAUGHN(9000010.18,IEN_",",".04","E")),1,29)
- +11 IF NARR=""
- SET NARR=$$GET1^DIQ(81,CPT,2)
- +12 DO CASE^PXBUTL
- +13 SET GROUP=CPT_"^"_QUANTITY_"^"_PROVIDER_"^"_NARR
- +14 SET CPT(CPT,IEN)=GROUP
- +15 SET PXSFIL=9000010.181
- +16 SET PXSIEN=""
- +17 FOR
- SET PXSIEN=$ORDER(VAUGHN(PXSFIL,PXSIEN))
- IF PXSIEN=""
- QUIT
- Begin DoDot:3
- +18 SET PXMOD=VAUGHN(PXSFIL,PXSIEN,.01,"E")
- +19 SET CPT(CPT,IEN,"MOD",+PXSIEN)=PXMOD
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +20 ;
- B ;--Add line numbers
- +1 ;
- +2 IF $DATA(CPT)
- Begin DoDot:1
- +3 SET PXBC=0
- SET CPT=""
- +4 FOR
- SET CPT=$ORDER(CPT(CPT))
- IF CPT=""
- QUIT
- Begin DoDot:2
- +5 SET IEN=0
- +6 FOR
- SET IEN=$ORDER(CPT(CPT,IEN))
- IF IEN=""
- QUIT
- SET PXBC=PXBC+1
- Begin DoDot:3
- +7 SET PXBKY(CPT,PXBC)=$GET(CPT(CPT,IEN))
- +8 SET PXBSAM(PXBC)=$GET(CPT(CPT,IEN))
- +9 SET PXBSKY(PXBC,IEN)=""
- +10 SET PXSIEN=0
- +11 FOR
- SET PXSIEN=$ORDER(CPT(CPT,IEN,"MOD",PXSIEN))
- IF PXSIEN=""
- QUIT
- Begin DoDot:4
- +12 SET PXBKY(CPT,PXBC,"MOD",PXSIEN)=CPT(CPT,IEN,"MOD",PXSIEN)
- +13 SET PXBSAM(PXBC,"MOD",PXSIEN)=CPT(CPT,IEN,"MOD",PXSIEN)
- End DoDot:4
- +14 IF $PIECE($GET(CPT(CPT,IEN)),"^",3)]""
- Begin DoDot:4
- +15 SET PXBPRV($PIECE($GET(CPT(CPT,IEN)),"^",3),$PIECE($GET(CPT(CPT,IEN)),"^",1),IEN,PXBC)=QUANTITY
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- EXIT ;--KILL
- +1 KILL ^TMP("PXBU",$JOB),VAUGHN
- +2 SET PXBCNT=+$GET(PXBC)
- +3 QUIT
- +4 ;
