PXBUTL3 ;ISL/JVS - CLEAN UP CPT CODES ;5/21/96 12:15
;;1.0;PCE PATIENT CARE ENCOUNTER;**73**;Aug 12, 1996
;
KILL ;
N TEST,CPT,IEN,KILL,PRV,QUA,REQI,TESTIEN
;
I $D(^AUPNVCPT("AD",PXBVST)) D
.S IEN=0
.F S IEN=$O(^AUPNVCPT("AD",PXBVST,IEN)) Q:IEN'>0 D
..S ^TMP("PXBU",$J,"CPT",IEN)=""
..S PRV=+$P($G(^AUPNVCPT(IEN,12)),"^",4)
..S CPT=$P(^AUPNVCPT(IEN,0),"^",1)
..S QUA=$P(^AUPNVCPT(IEN,0),"^",16)
..I $D(TEST(PRV,CPT,IEN)) D
...S TESTIEN=$O(TEST(PRV,CPT,0))
...S QUA=QUA+$G(TEST(PRV,CPT,TESTIEN))
...S KILL(IEN)=""
...S TEST(PRV,CPT,TESTIEN)=QUA
..I '$D(TEST(PRV,CPT,IEN)) D
...S TEST(+$P($G(^AUPNVCPT(IEN,12)),"^",4),$P(^AUPNVCPT(IEN,0),"^",1),IEN)=$P(^AUPNVCPT(IEN,0),"^",16)
I '$D(KILL) Q
S PRV="",REQI=""
F S PRV=$O(TEST(PRV)) Q:PRV="" D
.S CPT=""
.F S CPT=$O(TEST(PRV,CPT)) Q:CPT="" D
..S IEN=""
..F S IEN=$O(TEST(PRV,CPT,IEN)) Q:IEN="" D
...S $P(REQI,"^",8)=IEN
...S $P(REQI,"^",3)=CPT
...I PRV>0 S $P(REQI,"^",1)=PRV
...S $P(REQI,"^",4)=$G(TEST(PRV,CPT,IEN))
...D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
...D EN1^PXKMAIN
I $D(KILL) D
.S IEN=""
.F S IEN=$O(KILL(IEN)) Q:IEN="" D
..S $P(REQI,"^",8)=IEN
..S $P(REQI,"^",4)=0
..S $P(REQI,"^",3)=$P(^AUPNVCPT(IEN,0),"^",1)
..D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
..D EN1^PXKMAIN
EXIT ;--EXIT
K ^TMP("PXBU",$J)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBUTL3 1343 printed Apr 09, 2024@21:31:24 Page 2
PXBUTL3 ;ISL/JVS - CLEAN UP CPT CODES ;5/21/96 12:15
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73**;Aug 12, 1996
+2 ;
KILL ;
+1 NEW TEST,CPT,IEN,KILL,PRV,QUA,REQI,TESTIEN
+2 ;
+3 IF $DATA(^AUPNVCPT("AD",PXBVST))
Begin DoDot:1
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^AUPNVCPT("AD",PXBVST,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+6 SET ^TMP("PXBU",$JOB,"CPT",IEN)=""
+7 SET PRV=+$PIECE($GET(^AUPNVCPT(IEN,12)),"^",4)
+8 SET CPT=$PIECE(^AUPNVCPT(IEN,0),"^",1)
+9 SET QUA=$PIECE(^AUPNVCPT(IEN,0),"^",16)
+10 IF $DATA(TEST(PRV,CPT,IEN))
Begin DoDot:3
+11 SET TESTIEN=$ORDER(TEST(PRV,CPT,0))
+12 SET QUA=QUA+$GET(TEST(PRV,CPT,TESTIEN))
+13 SET KILL(IEN)=""
+14 SET TEST(PRV,CPT,TESTIEN)=QUA
End DoDot:3
+15 IF '$DATA(TEST(PRV,CPT,IEN))
Begin DoDot:3
+16 SET TEST(+$PIECE($GET(^AUPNVCPT(IEN,12)),"^",4),$PIECE(^AUPNVCPT(IEN,0),"^",1),IEN)=$PIECE(^AUPNVCPT(IEN,0),"^",16)
End DoDot:3
End DoDot:2
End DoDot:1
+17 IF '$DATA(KILL)
QUIT
+18 SET PRV=""
SET REQI=""
+19 FOR
SET PRV=$ORDER(TEST(PRV))
if PRV=""
QUIT
Begin DoDot:1
+20 SET CPT=""
+21 FOR
SET CPT=$ORDER(TEST(PRV,CPT))
if CPT=""
QUIT
Begin DoDot:2
+22 SET IEN=""
+23 FOR
SET IEN=$ORDER(TEST(PRV,CPT,IEN))
if IEN=""
QUIT
Begin DoDot:3
+24 SET $PIECE(REQI,"^",8)=IEN
+25 SET $PIECE(REQI,"^",3)=CPT
+26 IF PRV>0
SET $PIECE(REQI,"^",1)=PRV
+27 SET $PIECE(REQI,"^",4)=$GET(TEST(PRV,CPT,IEN))
+28 DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)
+29 DO EN1^PXKMAIN
End DoDot:3
End DoDot:2
End DoDot:1
+30 IF $DATA(KILL)
Begin DoDot:1
+31 SET IEN=""
+32 FOR
SET IEN=$ORDER(KILL(IEN))
if IEN=""
QUIT
Begin DoDot:2
+33 SET $PIECE(REQI,"^",8)=IEN
+34 SET $PIECE(REQI,"^",4)=0
+35 SET $PIECE(REQI,"^",3)=$PIECE(^AUPNVCPT(IEN,0),"^",1)
+36 DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)
+37 DO EN1^PXKMAIN
End DoDot:2
End DoDot:1
EXIT ;--EXIT
+1 KILL ^TMP("PXBU",$JOB)
