Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXBSTOR1

PXBSTOR1.m

Go to the documentation of this file.
  1. PXBSTOR1 ;ISL/JVS - REMOVE THE DELETED PROVIDER FROM CPT'S ;2/23/04 9:41am
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**88,124**;Aug 12, 1996
  1. ;
  1. ;
  1. ;
  1. ;
  1. DCPT(CPTPRV,PXBVST) ;---ENTRY POINT
  1. ;CPTPRV=IEN of Provider to be removed
  1. ;PXBVST=VISIT of the encounter
  1. ;
  1. ;
  1. Q:'$D(CPTPRV) Q:'$D(PXBVST)
  1. ;
  1. K ^TMP("PXK",$J)
  1. N IEN
  1. S IEN=0 F S IEN=$O(^AUPNVCPT("AD",PXBVST,IEN)) Q:IEN="" D
  1. .I $D(^AUPNVCPT(IEN,12)),$P(^AUPNVCPT(IEN,12),"^",4)=CPTPRV D CHANGE
  1. Q
  1. CHANGE ;--Remove the Provider from the CPT code
  1. ;
  1. I '$D(^TMP("PXBSTOR",$J,"SEQ")) S SEQ=1
  1. I $D(^TMP("PXBSTOR",$J,"SEQ")) S SEQ=^TMP("PXBSTOR",$J,"SEQ")
  1. ;------CHANGE SOURCE TO MATCH THAT SENT IN -********-
  1. S ^TMP("PXK",$J,"SOR")=$O(^PX(839.7,"B","SD/PCE-INTERFACE-PROMPTS",0))
  1. ;-------------
  1. S ^TMP("PXK",$J,"VST",1,"IEN")=PXBVST
  1. S ^TMP("PXK",$J,"VST",1,0,"AFTER")=$G(^AUPNVSIT(PXBVST,0))
  1. S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=$G(^AUPNVSIT(PXBVST,0))
  1. ;
  1. S (CPTBEF,CPTAFT)=$G(^AUPNVCPT(IEN,0))
  1. S (CPTBEF12,CPTAFT12)=$G(^AUPNVCPT(IEN,12))
  1. S $P(CPTAFT12,"^",4)="@"
  1. ;
  1. S SEQ=SEQ+(1)
  1. ;
  1. S ^TMP("PXK",$J,"CPT",SEQ,0,"AFTER")=CPTAFT
  1. S ^TMP("PXK",$J,"CPT",SEQ,0,"BEFORE")=CPTBEF
  1. S ^TMP("PXK",$J,"CPT",SEQ,12,"AFTER")=CPTAFT12
  1. S ^TMP("PXK",$J,"CPT",SEQ,12,"BEFORE")=CPTBEF12
  1. S ^TMP("PXK",$J,"CPT",SEQ,"IEN")=IEN
  1. ;
  1. ;
  1. ;
  1. D EN1^PXKMAIN
  1. K ^TMP("PXK",$J)
  1. ;
  1. ;
  1. Q
  1. STP ;--AMIS STOP CODES
  1. ;--STOP CODE ARE ON PIECE 10 AND 11 IS THE VISIT
  1. Q:'$D(REQI)
  1. N SOURCE
  1. S SOURCE=$O(^PX(839.7,"B","SD/PCE-INTERFACE-PROMPTS",0))
  1. S STOPI=$P(REQI,"^",10)
  1. S SECVSIT=$P(REQI,"^",11)
  1. S VISIT=+$$STOPCODE^PXUTLSTP(SOURCE,STOPI,PXBVST,SECVSIT)
  1. Q
  1. ;
  1. SET() ;--SET IENS OF EACH FILE
  1. S PRVIEN=$P(REQI,"^",7) I PRVIEN]"" D
  1. .S PRVBEF=$G(^AUPNVPRV($P(REQI,"^",7),0))
  1. .S PRVBEF12=$G(^AUPNVPRV($P(REQI,"^",7),12))
  1. .S PRVBF812=$G(^AUPNVPRV($P(REQI,"^",7),812))
  1. E S (PRVBEF,PRVBEF12,PRVBF812)=""
  1. S CPTIEN=$P(REQI,"^",8)
  1. I CPTIEN]"" D
  1. .S CPTBEF=$G(^AUPNVCPT($P(REQI,"^",8),0))
  1. .;Build array for cpt modifiers
  1. .N SUBIEN
  1. .S SUBIEN=0
  1. .F S SUBIEN=$O(^AUPNVCPT($P(REQI,"^",8),1,SUBIEN)) Q:'SUBIEN D
  1. ..S CPTBEF1(SUBIEN)=$G(^AUPNVCPT($P(REQI,"^",8),1,SUBIEN,0))
  1. .S CPTBEF12=$G(^AUPNVCPT($P(REQI,"^",8),12))
  1. .S CPTBF812=$G(^AUPNVCPT($P(REQI,"^",8),812))
  1. E S (CPTBEF,CPTBEF12,CPTBF812)=""
  1. S POVIEN=$P(REQI,"^",9) I POVIEN]"" D
  1. .S POVBEF=$G(^AUPNVPOV($P(REQI,"^",9),0))
  1. .S POVBEF12=$G(^AUPNVPOV($P(REQI,"^",9),12))
  1. .S POVBEF17=$G(^AUPNVPOV($P(REQI,"^",9),17))
  1. .S POVBF812=$G(^AUPNVPOV($P(REQI,"^",9),812))
  1. .S POVBF800=$G(^AUPNVPOV($P(REQI,"^",9),800)) ;PX124
  1. E S (POVBEF,POVBEF12,POVBEF17,POVBF812,POVBF800)=""
  1. ;
  1. MISC ;--SET MISCELLANEOUS NODES
  1. ;--*** CONDITION THE SOURCE
  1. I '$G(SOURCE) S ^TMP("PXK",$J,"SOR")=$O(^PX(839.7,"B","SD/PCE-INTERFACE-PROMPTS",0))
  1. ;
  1. S ^TMP("PXK",$J,"VST",1,"IEN")=PXBVST
  1. S ^TMP("PXK",$J,"VST",1,0,"AFTER")=$G(^AUPNVSIT(PXBVST,0))
  1. S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=$G(^AUPNVSIT(PXBVST,0))
  1. ;
  1. Q $G(^TMP("PXBSTOR",$J,"SEQ"),1)