PXBSTOR1.m

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