- 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 Feb 18, 2025@23:53:40 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)
