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 ;
