IBCEP9A ;ALB/CXW - PROVIDER EXTRACT ;26-SEP-00
;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
; This routine is to build an extract file with provider information
; by looking at different file sources
; DBIA's used: DBIA418, DBIA419, 2546
;
START(IBRAW) ; Extract a list of providers from existing VistA data
; IBRAW = 0 or "" if display format
; = 1 if raw data format
; Variables:
; IBYR1/IBYR3 - the first date of next year
; IBYR2 - the last date two years ago
; IBPID - provider entry number
; HFLE - host file name
;
N IBCONT,IBYR1,IBYR2,IBYR3,IBPTF,IBPID,IBPINT,IBDFN,IBDT,IBIEN
S IBCONT=0,IBRAW=$G(IBRAW)
D NOW^%DTC
S (IBYR1,IBYR3)=$E(X,1,3)+1_"0101"
S IBYR2=$E(X,1,3)-2_"1230"
K ^TMP("IBPID",$J)
D PTF,VST
Q:IBRAW
D DATA
I '$D(^TMP("IBPID",$J)) W "No data found"
Q
;
PTF ;PTF (file 45/field 50) with admission within last two years DBIA419
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
. ; DBIA418
. S IBPTF=+$P($G(^DGPM(IBIEN,0)),U,16)
. Q:'IBPTF
. S IBPID=$G(^DGPT(IBPTF,70)),IBPID=$P(IBPID,"^",15)
. I IBPID S ^TMP("IBPID",$J,IBPID)=""
. ;501 movement (file 45.02)
. 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
.. S IBPID=$G(^DGPT(IBPTF,"M",IBPINT,"P")),IBPID=$P(IBPID,"^",5)
.. I IBPID S ^TMP("IBPID",$J,IBPID)=""
Q
;
VST ; get providers associated with outpatient encntrs within the last 2 yrs
;
N IBVAL,IBCBK
S IBVAL("BDT")=IBYR2,IBVAL("EDT")=IBYR3
S IBCBK="D VSTPRV^IBCEP9A(Y)"
D SCAN^IBSDU("DATE/TIME",.IBVAL,"",IBCBK,1) ; Get all encntrs in dt rnge
Q
;
VSTPRV(IBOE) ; Get all providers for an encounter IBOE
N IBPID,Z
D GETPRV^SDOE(IBOE,"IBPID")
S Z=0 F S Z=$O(IBPID(Z)) Q:'Z I +IBPID(Z) S ^TMP("IBPID",$J,+IBPID(Z))=""
Q
;
DATA ;store data in file
N IBNAM,IBSSN,IBDGE
S IBPID=0
F S IBPID=$O(^TMP("IBPID",$J,IBPID)) Q:'IBPID D
. S IBNAM=$P($G(^VA(200,IBPID,0)),"^")
. S IBSSN=$P($G(^VA(200,IBPID,1)),"^",9)
. S IBDGE=$P($G(^VA(200,IBPID,3.1)),"^",6)
. S ^TMP("IBPID",$J,IBPID)=IBNAM_$J("",40-$L(IBNAM))_IBSSN_$J("",9-$L(IBSSN))_IBDGE_$J("",10-$L(IBDGE))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEP9A 2381 printed Apr 09, 2024@21:15:10 Page 2
IBCEP9A ;ALB/CXW - PROVIDER EXTRACT ;26-SEP-00
+1 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
+2 ; This routine is to build an extract file with provider information
+3 ; by looking at different file sources
+4 ; DBIA's used: DBIA418, DBIA419, 2546
+5 ;
START(IBRAW) ; Extract a list of providers from existing VistA data
+1 ; IBRAW = 0 or "" if display format
+2 ; = 1 if raw data format
+3 ; Variables:
+4 ; IBYR1/IBYR3 - the first date of next year
+5 ; IBYR2 - the last date two years ago
+6 ; IBPID - provider entry number
+7 ; HFLE - host file name
+8 ;
+9 NEW IBCONT,IBYR1,IBYR2,IBYR3,IBPTF,IBPID,IBPINT,IBDFN,IBDT,IBIEN
+10 SET IBCONT=0
SET IBRAW=$GET(IBRAW)
+11 DO NOW^%DTC
+12 SET (IBYR1,IBYR3)=$EXTRACT(X,1,3)+1_"0101"
+13 SET IBYR2=$EXTRACT(X,1,3)-2_"1230"
+14 KILL ^TMP("IBPID",$JOB)
+15 DO PTF
DO VST
+16 if IBRAW
QUIT
+17 DO DATA
+18 IF '$DATA(^TMP("IBPID",$JOB))
WRITE "No data found"
+19 QUIT
+20 ;
PTF ;PTF (file 45/field 50) with admission within last two years DBIA419
+1 FOR
SET IBYR1=$ORDER(^DGPM("AMV1",IBYR1),-1)
if 'IBYR1!(IBYR1\1<IBYR2)
QUIT
SET IBDFN=0
FOR
SET IBDFN=$ORDER(^DGPM("AMV1",IBYR1,IBDFN))
if 'IBDFN
QUIT
SET IBIEN=0
FOR
SET IBIEN=$ORDER(^DGPM("AMV1",IBYR1,IBDFN,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:1
+2 ; DBIA418
+3 SET IBPTF=+$PIECE($GET(^DGPM(IBIEN,0)),U,16)
+4 if 'IBPTF
QUIT
+5 SET IBPID=$GET(^DGPT(IBPTF,70))
SET IBPID=$PIECE(IBPID,"^",15)
+6 IF IBPID
SET ^TMP("IBPID",$JOB,IBPID)=""
+7 ;501 movement (file 45.02)
+8 SET IBDT=0
FOR
SET IBDT=$ORDER(^DGPT(IBPTF,"M","AM",IBDT))
if 'IBDT
QUIT
SET IBPINT=0
FOR
SET IBPINT=$ORDER(^DGPT(IBPTF,"M","AM",IBDT,IBPINT))
if 'IBPINT
QUIT
Begin DoDot:2
+9 SET IBPID=$GET(^DGPT(IBPTF,"M",IBPINT,"P"))
SET IBPID=$PIECE(IBPID,"^",5)
+10 IF IBPID
SET ^TMP("IBPID",$JOB,IBPID)=""
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
VST ; get providers associated with outpatient encntrs within the last 2 yrs
+1 ;
+2 NEW IBVAL,IBCBK
+3 SET IBVAL("BDT")=IBYR2
SET IBVAL("EDT")=IBYR3
+4 SET IBCBK="D VSTPRV^IBCEP9A(Y)"
+5 ; Get all encntrs in dt rnge
DO SCAN^IBSDU("DATE/TIME",.IBVAL,"",IBCBK,1)
+6 QUIT
+7 ;
VSTPRV(IBOE) ; Get all providers for an encounter IBOE
+1 NEW IBPID,Z
+2 DO GETPRV^SDOE(IBOE,"IBPID")
+3 SET Z=0
FOR
SET Z=$ORDER(IBPID(Z))
if 'Z
QUIT
IF +IBPID(Z)
SET ^TMP("IBPID",$JOB,+IBPID(Z))=""
+4 QUIT
+5 ;
DATA ;store data in file
+1 NEW IBNAM,IBSSN,IBDGE
+2 SET IBPID=0
+3 FOR
SET IBPID=$ORDER(^TMP("IBPID",$JOB,IBPID))
if 'IBPID
QUIT
Begin DoDot:1
+4 SET IBNAM=$PIECE($GET(^VA(200,IBPID,0)),"^")
+5 SET IBSSN=$PIECE($GET(^VA(200,IBPID,1)),"^",9)
+6 SET IBDGE=$PIECE($GET(^VA(200,IBPID,3.1)),"^",6)
+7 SET ^TMP("IBPID",$JOB,IBPID)=IBNAM_$JUSTIFY("",40-$LENGTH(IBNAM))_IBSSN_$JUSTIFY("",9-$LENGTH(IBSSN))_IBDGE_$JUSTIFY("",10-$LENGTH(IBDGE))
End DoDot:1
+8 QUIT
+9 ;
