source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP9A.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1IBCEP9A ;ALB/CXW - PROVIDER EXTRACT ;26-SEP-00
2 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
3 ; This routine is to build an extract file with provider information
4 ; by looking at different file sources
5 ; DBIA's used: DBIA418, DBIA419, 2546
6 ;
7START(IBRAW) ; Extract a list of providers from existing VistA data
8 ; IBRAW = 0 or "" if display format
9 ; = 1 if raw data format
10 ; Variables:
11 ; IBYR1/IBYR3 - the first date of next year
12 ; IBYR2 - the last date two years ago
13 ; IBPID - provider entry number
14 ; HFLE - host file name
15 ;
16 N IBCONT,IBYR1,IBYR2,IBYR3,IBPTF,IBPID,IBPINT,IBDFN,IBDT,IBIEN
17 S IBCONT=0,IBRAW=$G(IBRAW)
18 D NOW^%DTC
19 S (IBYR1,IBYR3)=$E(X,1,3)+1_"0101"
20 S IBYR2=$E(X,1,3)-2_"1230"
21 K ^TMP("IBPID",$J)
22 D PTF,VST
23 Q:IBRAW
24 D DATA
25 I '$D(^TMP("IBPID",$J)) W "No data found"
26 Q
27 ;
28PTF ;PTF (file 45/field 50) with admission within last two years DBIA419
29 F S IBYR1=$O(^DGPM("AMV1",IBYR1),-1) Q:'IBYR1!(IBYR1\1<IBYR2) S IBDFN=0 F S IBDFN=$O(^DGPM("AMV1",IBYR1,IBDFN)) Q:'IBDFN S IBIEN=0 F S IBIEN=$O(^DGPM("AMV1",IBYR1,IBDFN,IBIEN)) Q:'IBIEN D
30 . ; DBIA418
31 . S IBPTF=+$P($G(^DGPM(IBIEN,0)),U,16)
32 . Q:'IBPTF
33 . S IBPID=$G(^DGPT(IBPTF,70)),IBPID=$P(IBPID,"^",15)
34 . I IBPID S ^TMP("IBPID",$J,IBPID)=""
35 . ;501 movement (file 45.02)
36 . S IBDT=0 F S IBDT=$O(^DGPT(IBPTF,"M","AM",IBDT)) Q:'IBDT S IBPINT=0 F S IBPINT=$O(^DGPT(IBPTF,"M","AM",IBDT,IBPINT)) Q:'IBPINT D
37 .. S IBPID=$G(^DGPT(IBPTF,"M",IBPINT,"P")),IBPID=$P(IBPID,"^",5)
38 .. I IBPID S ^TMP("IBPID",$J,IBPID)=""
39 Q
40 ;
41VST ; get providers associated with outpatient encntrs within the last 2 yrs
42 ;
43 N IBVAL,IBCBK
44 S IBVAL("BDT")=IBYR2,IBVAL("EDT")=IBYR3
45 S IBCBK="D VSTPRV^IBCEP9A(Y)"
46 D SCAN^IBSDU("DATE/TIME",.IBVAL,"",IBCBK,1) ; Get all encntrs in dt rnge
47 Q
48 ;
49VSTPRV(IBOE) ; Get all providers for an encounter IBOE
50 N IBPID,Z
51 D GETPRV^SDOE(IBOE,"IBPID")
52 S Z=0 F S Z=$O(IBPID(Z)) Q:'Z I +IBPID(Z) S ^TMP("IBPID",$J,+IBPID(Z))=""
53 Q
54 ;
55DATA ;store data in file
56 N IBNAM,IBSSN,IBDGE
57 S IBPID=0
58 F S IBPID=$O(^TMP("IBPID",$J,IBPID)) Q:'IBPID D
59 . S IBNAM=$P($G(^VA(200,IBPID,0)),"^")
60 . S IBSSN=$P($G(^VA(200,IBPID,1)),"^",9)
61 . S IBDGE=$P($G(^VA(200,IBPID,3.1)),"^",6)
62 . S ^TMP("IBPID",$J,IBPID)=IBNAM_$J("",40-$L(IBNAM))_IBSSN_$J("",9-$L(IBSSN))_IBDGE_$J("",10-$L(IBDGE))
63 Q
64 ;
Note: See TracBrowser for help on using the repository browser.