- PXBSTOR1 ;ISL/JVS - REMOVE THE DELETED PROVIDER FROM CPT'S ;7/24/96 10:29
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**88**;Aug 12, 1996
- ;
- ;
- ;
- ;
- DCPT(CPTPRV,PXBVST) ;---ENTRY POINT
- ;CPTPRV=IEN of Provider to be removed
- ;PXBVST=VISIT of the encounter
- ;
- ;
- Q:'$D(CPTPRV) Q:'$D(PXBVST)
- ;
- K ^TMP("PXK",$J)
- N IEN
- S IEN=0 F S IEN=$O(^AUPNVCPT("AD",PXBVST,IEN)) Q:IEN="" D
- .I $D(^AUPNVCPT(IEN,12)),$P(^AUPNVCPT(IEN,12),"^",4)=CPTPRV D CHANGE
- Q
- CHANGE ;--Remove the Provider form the CPT code
- ;
- I '$D(^TMP("PXBSTOR",$J,"SEQ")) S SEQ=1
- I $D(^TMP("PXBSTOR",$J,"SEQ")) S SEQ=^TMP("PXBSTOR",$J,"SEQ")
- ;------CHANGE SOURCE TO MATCH THAT SENT IN -********-
- S ^TMP("PXK",$J,"SOR")=$O(^PX(839.7,"B","SD/PCE-INTERFACE-PROMPTS",0))
- ;-------------
- S ^TMP("PXK",$J,"VST",1,"IEN")=PXBVST
- S ^TMP("PXK",$J,"VST",1,0,"AFTER")=$G(^AUPNVSIT(PXBVST,0))
- S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=$G(^AUPNVSIT(PXBVST,0))
- ;
- S (CPTBEF,CPTAFT)=$G(^AUPNVCPT(IEN,0))
- S (CPTBEF12,CPTAFT12)=$G(^AUPNVCPT(IEN,12))
- S $P(CPTAFT12,"^",4)="@"
- ;
- S SEQ=SEQ+(1)
- ;
- S ^TMP("PXK",$J,"CPT",SEQ,0,"AFTER")=CPTAFT
- S ^TMP("PXK",$J,"CPT",SEQ,0,"BEFORE")=CPTBEF
- S ^TMP("PXK",$J,"CPT",SEQ,12,"AFTER")=CPTAFT12
- S ^TMP("PXK",$J,"CPT",SEQ,12,"BEFORE")=CPTBEF12
- S ^TMP("PXK",$J,"CPT",SEQ,"IEN")=IEN
- ;
- ;
- ;
- D EN1^PXKMAIN
- K ^TMP("PXK",$J)
- ;
- ;
- Q
- STP ;--AMIS STOP CODES
- ;--STOP CODE ARE ON PIECE 10 AND 11 IS THE VISIT
- Q:'$D(REQI)
- N SOURCE
- S SOURCE=$O(^PX(839.7,"B","SD/PCE-INTERFACE-PROMPTS",0))
- S STOPI=$P(REQI,"^",10)
- S SECVSIT=$P(REQI,"^",11)
- S VISIT=+$$STOPCODE^PXUTLSTP(SOURCE,STOPI,PXBVST,SECVSIT)
- Q
- PXBSTOR1 ;ISL/JVS - REMOVE THE DELETED PROVIDER FROM CPT'S ;7/24/96 10:29
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**88**;Aug 12, 1996
- +2 ;
- +3 ;
- +4 ;
- +5 ;
- DCPT(CPTPRV,PXBVST) ;---ENTRY POINT
- +1 ;CPTPRV=IEN of Provider to be removed
- +2 ;PXBVST=VISIT of the encounter
- +3 ;
- +4 ;
- +5 IF '$DATA(CPTPRV)
- QUIT
- IF '$DATA(PXBVST)
- QUIT
- +6 ;
- +7 KILL ^TMP("PXK",$JOB)
- +8 NEW IEN
- +9 SET IEN=0
- FOR
- SET IEN=$ORDER(^AUPNVCPT("AD",PXBVST,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:1
- +10 IF $DATA(^AUPNVCPT(IEN,12))
- IF $PIECE(^AUPNVCPT(IEN,12),"^",4)=CPTPRV
- DO CHANGE
- End DoDot:1
- +11 QUIT
- CHANGE ;--Remove the Provider form the CPT code
- +1 ;
- +2 IF '$DATA(^TMP("PXBSTOR",$JOB,"SEQ"))
- SET SEQ=1
- +3 IF $DATA(^TMP("PXBSTOR",$JOB,"SEQ"))
- SET SEQ=^TMP("PXBSTOR",$JOB,"SEQ")
- +4 ;------CHANGE SOURCE TO MATCH THAT SENT IN -********-
- +5 SET ^TMP("PXK",$JOB,"SOR")=$ORDER(^PX(839.7,"B","SD/PCE-INTERFACE-PROMPTS",0))
- +6 ;-------------
- +7 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXBVST
- +8 SET ^TMP("PXK",$JOB,"VST",1,0,"AFTER")=$GET(^AUPNVSIT(PXBVST,0))
- +9 SET ^TMP("PXK",$JOB,"VST",1,0,"BEFORE")=$GET(^AUPNVSIT(PXBVST,0))
- +10 ;
- +11 SET (CPTBEF,CPTAFT)=$GET(^AUPNVCPT(IEN,0))
- +12 SET (CPTBEF12,CPTAFT12)=$GET(^AUPNVCPT(IEN,12))
- +13 SET $PIECE(CPTAFT12,"^",4)="@"
- +14 ;
- +15 SET SEQ=SEQ+(1)
- +16 ;
- +17 SET ^TMP("PXK",$JOB,"CPT",SEQ,0,"AFTER")=CPTAFT
- +18 SET ^TMP("PXK",$JOB,"CPT",SEQ,0,"BEFORE")=CPTBEF
- +19 SET ^TMP("PXK",$JOB,"CPT",SEQ,12,"AFTER")=CPTAFT12
- +20 SET ^TMP("PXK",$JOB,"CPT",SEQ,12,"BEFORE")=CPTBEF12
- +21 SET ^TMP("PXK",$JOB,"CPT",SEQ,"IEN")=IEN
- +22 ;
- +23 ;
- +24 ;
- +25 DO EN1^PXKMAIN
- +26 KILL ^TMP("PXK",$JOB)
- +27 ;
- +28 ;
- +29 QUIT
- STP ;--AMIS STOP CODES
- +1 ;--STOP CODE ARE ON PIECE 10 AND 11 IS THE VISIT
- +2 IF '$DATA(REQI)
- QUIT
- +3 NEW SOURCE
- +4 SET SOURCE=$ORDER(^PX(839.7,"B","SD/PCE-INTERFACE-PROMPTS",0))
- +5 SET STOPI=$PIECE(REQI,"^",10)
- +6 SET SECVSIT=$PIECE(REQI,"^",11)
- +7 SET VISIT=+$$STOPCODE^PXUTLSTP(SOURCE,STOPI,PXBVST,SECVSIT)
- +8 QUIT