| [613] | 1 | IBCEP9A ;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 | ;
|
|---|
| 7 | START(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 | ;
|
|---|
| 28 | PTF ;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 | ;
|
|---|
| 41 | VST ; 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 | ;
|
|---|
| 49 | VSTPRV(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 | ;
|
|---|
| 55 | DATA ;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 | ;
|
|---|
