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

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.8 KB
Line 
1PXBSTOR1 ;ISL/JVS - REMOVE THE DELETED PROVIDER FROM CPT'S ;2/23/04 9:41am
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**88,124**;Aug 12, 1996
3 ;
4 ;
5 ;
6 ;
7DCPT(CPTPRV,PXBVST) ;---ENTRY POINT
8 ;CPTPRV=IEN of Provider to be removed
9 ;PXBVST=VISIT of the encounter
10 ;
11 ;
12 Q:'$D(CPTPRV) Q:'$D(PXBVST)
13 ;
14 K ^TMP("PXK",$J)
15 N IEN
16 S IEN=0 F S IEN=$O(^AUPNVCPT("AD",PXBVST,IEN)) Q:IEN="" D
17 .I $D(^AUPNVCPT(IEN,12)),$P(^AUPNVCPT(IEN,12),"^",4)=CPTPRV D CHANGE
18 Q
19CHANGE ;--Remove the Provider from the CPT code
20 ;
21 I '$D(^TMP("PXBSTOR",$J,"SEQ")) S SEQ=1
22 I $D(^TMP("PXBSTOR",$J,"SEQ")) S SEQ=^TMP("PXBSTOR",$J,"SEQ")
23 ;------CHANGE SOURCE TO MATCH THAT SENT IN -********-
24 S ^TMP("PXK",$J,"SOR")=$O(^PX(839.7,"B","SD/PCE-INTERFACE-PROMPTS",0))
25 ;-------------
26 S ^TMP("PXK",$J,"VST",1,"IEN")=PXBVST
27 S ^TMP("PXK",$J,"VST",1,0,"AFTER")=$G(^AUPNVSIT(PXBVST,0))
28 S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=$G(^AUPNVSIT(PXBVST,0))
29 ;
30 S (CPTBEF,CPTAFT)=$G(^AUPNVCPT(IEN,0))
31 S (CPTBEF12,CPTAFT12)=$G(^AUPNVCPT(IEN,12))
32 S $P(CPTAFT12,"^",4)="@"
33 ;
34 S SEQ=SEQ+(1)
35 ;
36 S ^TMP("PXK",$J,"CPT",SEQ,0,"AFTER")=CPTAFT
37 S ^TMP("PXK",$J,"CPT",SEQ,0,"BEFORE")=CPTBEF
38 S ^TMP("PXK",$J,"CPT",SEQ,12,"AFTER")=CPTAFT12
39 S ^TMP("PXK",$J,"CPT",SEQ,12,"BEFORE")=CPTBEF12
40 S ^TMP("PXK",$J,"CPT",SEQ,"IEN")=IEN
41 ;
42 ;
43 ;
44 D EN1^PXKMAIN
45 K ^TMP("PXK",$J)
46 ;
47 ;
48 Q
49STP ;--AMIS STOP CODES
50 ;--STOP CODE ARE ON PIECE 10 AND 11 IS THE VISIT
51 Q:'$D(REQI)
52 N SOURCE
53 S SOURCE=$O(^PX(839.7,"B","SD/PCE-INTERFACE-PROMPTS",0))
54 S STOPI=$P(REQI,"^",10)
55 S SECVSIT=$P(REQI,"^",11)
56 S VISIT=+$$STOPCODE^PXUTLSTP(SOURCE,STOPI,PXBVST,SECVSIT)
57 Q
58 ;
59SET() ;--SET IENS OF EACH FILE
60 S PRVIEN=$P(REQI,"^",7) I PRVIEN]"" D
61 .S PRVBEF=$G(^AUPNVPRV($P(REQI,"^",7),0))
62 .S PRVBEF12=$G(^AUPNVPRV($P(REQI,"^",7),12))
63 .S PRVBF812=$G(^AUPNVPRV($P(REQI,"^",7),812))
64 E S (PRVBEF,PRVBEF12,PRVBF812)=""
65 S CPTIEN=$P(REQI,"^",8)
66 I CPTIEN]"" D
67 .S CPTBEF=$G(^AUPNVCPT($P(REQI,"^",8),0))
68 .;Build array for cpt modifiers
69 .N SUBIEN
70 .S SUBIEN=0
71 .F S SUBIEN=$O(^AUPNVCPT($P(REQI,"^",8),1,SUBIEN)) Q:'SUBIEN D
72 ..S CPTBEF1(SUBIEN)=$G(^AUPNVCPT($P(REQI,"^",8),1,SUBIEN,0))
73 .S CPTBEF12=$G(^AUPNVCPT($P(REQI,"^",8),12))
74 .S CPTBF812=$G(^AUPNVCPT($P(REQI,"^",8),812))
75 E S (CPTBEF,CPTBEF12,CPTBF812)=""
76 S POVIEN=$P(REQI,"^",9) I POVIEN]"" D
77 .S POVBEF=$G(^AUPNVPOV($P(REQI,"^",9),0))
78 .S POVBEF12=$G(^AUPNVPOV($P(REQI,"^",9),12))
79 .S POVBEF17=$G(^AUPNVPOV($P(REQI,"^",9),17))
80 .S POVBF812=$G(^AUPNVPOV($P(REQI,"^",9),812))
81 .S POVBF800=$G(^AUPNVPOV($P(REQI,"^",9),800)) ;PX124
82 E S (POVBEF,POVBEF12,POVBEF17,POVBF812,POVBF800)=""
83 ;
84MISC ;--SET MISCELLANEOUS NODES
85 ;--*** CONDITION THE SOURCE
86 I '$G(SOURCE) S ^TMP("PXK",$J,"SOR")=$O(^PX(839.7,"B","SD/PCE-INTERFACE-PROMPTS",0))
87 ;
88 S ^TMP("PXK",$J,"VST",1,"IEN")=PXBVST
89 S ^TMP("PXK",$J,"VST",1,0,"AFTER")=$G(^AUPNVSIT(PXBVST,0))
90 S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=$G(^AUPNVSIT(PXBVST,0))
91 ;
92 Q $G(^TMP("PXBSTOR",$J,"SEQ"),1)
Note: See TracBrowser for help on using the repository browser.