source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBSTOR1.m@ 1423

PXBSTOR1 ;ISL/JVS - REMOVE THE DELETED PROVIDER FROM CPT'S ;2/23/04 9:41am
 ;;1.0;PCE PATIENT CARE ENCOUNTER;**88,124**;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 from 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
 ;
SET() ;--SET IENS OF EACH FILE
 S PRVIEN=$P(REQI,"^",7) I PRVIEN]"" D
 .S PRVBEF=$G(^AUPNVPRV($P(REQI,"^",7),0))
 .S PRVBEF12=$G(^AUPNVPRV($P(REQI,"^",7),12))
 .S PRVBF812=$G(^AUPNVPRV($P(REQI,"^",7),812))
 E  S (PRVBEF,PRVBEF12,PRVBF812)=""
 S CPTIEN=$P(REQI,"^",8)
 I CPTIEN]"" D
 .S CPTBEF=$G(^AUPNVCPT($P(REQI,"^",8),0))
 .;Build array for cpt modifiers
 .N SUBIEN
 .S SUBIEN=0
 .F  S SUBIEN=$O(^AUPNVCPT($P(REQI,"^",8),1,SUBIEN)) Q:'SUBIEN  D
 ..S CPTBEF1(SUBIEN)=$G(^AUPNVCPT($P(REQI,"^",8),1,SUBIEN,0))
 .S CPTBEF12=$G(^AUPNVCPT($P(REQI,"^",8),12))
 .S CPTBF812=$G(^AUPNVCPT($P(REQI,"^",8),812))
 E  S (CPTBEF,CPTBEF12,CPTBF812)=""
 S POVIEN=$P(REQI,"^",9) I POVIEN]"" D
 .S POVBEF=$G(^AUPNVPOV($P(REQI,"^",9),0))
 .S POVBEF12=$G(^AUPNVPOV($P(REQI,"^",9),12))
 .S POVBEF17=$G(^AUPNVPOV($P(REQI,"^",9),17))
 .S POVBF812=$G(^AUPNVPOV($P(REQI,"^",9),812))
 .S POVBF800=$G(^AUPNVPOV($P(REQI,"^",9),800)) ;PX124
 E  S (POVBEF,POVBEF12,POVBEF17,POVBF812,POVBF800)=""
 ;
MISC ;--SET MISCELLANEOUS NODES
 ;--*** CONDITION THE SOURCE
 I '$G(SOURCE) 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))
 ;
 Q $G(^TMP("PXBSTOR",$J,"SEQ"),1)