RCXVDC5 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
;;4.5;Accounts Receivable;**201,227,228,240,243,248,245,251**;Mar 20, 1995;Build 21
;
; Integrated Billing Action File (# 350)
Q
D350 ;
NEW RCXVD,RCXVDA,RCXVDB,RCXVD0A,RCXVDT,RCXVP1,RCXVP2,RCXVPC,RCT
NEW RCIBVD,RCIBAD,RCIBDD,RCIBSL,RCIBBG,RCIBPE,RCXVNPI
S RCXVD0A="",RCT=0
F S RCXVD0A=$O(^IB("ABIL",RCXVBLNA,RCXVD0A)) Q:RCXVD0A="" D
. S RCXVD=$G(^IB(RCXVD0A,0))
. I $G(DFN)="" S DFN=$P(RCXVD,U,2)
. ;
. S RCXVDA=RCXVBLNA_RCXVU_$P(RCXVD,U,1)
. S RCXVDA=RCXVDA_RCXVU_$$GET1^DIQ(350,RCXVD0A_",",.05,"E")
. S RCXVP1=$P(RCXVD,U,3),RCXVP2=""
. I RCXVP1'="" S RCXVP2=$P($G(^IBE(350.1,RCXVP1,0)),U,1)
. S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; ACTION TYPE (P)
. S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,6) ; UNITS
. S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,7) ; TOTAL CHARGE
. S RCXVDT=$P(RCXVD,U,14)
. S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT BILLD FROM
. S RCXVDT=$P(RCXVD,U,15)
. S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT BILLD TO
. S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,11) ; AR BILL #
. S RCXVDT=$P($P($G(^IB(RCXVD0A,1)),U,2),".",1)
. S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT ENTRY ADDED
. S RCXVDA=RCXVDA_RCXVU_$P($G(^DPT(DFN,0)),U,9) ; SSN
. S RCXVDT=$P(RCXVD,U,17)
. S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; EVENT DT
. S RCXVDT=$$PRESC($P(RCXVD,U,4))
. S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;FILL/REFILL DATE
. S (RCIBVD,RCIBAD,RCIBDD)="" D
..S RCIBSL=$P(RCXVD,U,4) Q:+RCIBSL=52
..S RCIBBG=$P($G(^IBE(350.1,+$P(RCXVD,"^",3),0)),"^",11)
..I RCIBBG=4 S RCXVDT=$P(RCXVD,U,14),RCIBVD=$E($$HLDATE^HLFNC(RCXVDT),1,8) Q
..S RCIBPE=$G(^IB(+$P(RCXVD,"^",16),0))
..I +RCIBSL'=405,+RCIBSL'=45 S RCIBSL=$P(RCIBPE,"^",4)
..I +RCIBSL=405!(+RCIBSL=45) D INP
..Q
. ;add outpatient visit date, inp. admission date, inp. discharge date
. S RCXVDA=RCXVDA_RCXVU_RCIBVD_RCXVU_RCIBAD_RCXVU_RCIBDD
. S RCXVNPI="",RCXVDA=RCXVDA_RCXVU_$$SITE(RCXVD0A,1)_RCXVU_RCXVNPI ;DIVISION WHERE CARE RENDERED^DIVISION NPI
. S RCT=RCT+1
. S ^TMP($J,RCXVBLN,"5-350A",RCT)=RCXVDA
Q
;
PRESC(RCPC4) ;Calculates prescription fill/refill date
; Input is resulting from field (4th piece of 0 node) in 350
; Output is fill/refill date in fileman format
N RCRXN,RCRF,RCPRDT,PSOFILE,DIC,DR,DA,DIQ,RCX
S RCPRDT=""
I $P(RCPC4,":")'=52 Q RCPRDT
S RCRXN=+$P(RCPC4,":",2),RCRF=$P(RCPC4,":",3)
;Set variables for DIQ^PSODI call
S PSOFILE=52
S DIC=52
S DIQ="RCX"
S DIQ(0)="I"
I RCRF>0 D
.S DR=52
.S DR(52.1)="17"
.S DA=RCRXN
.S DA(52.1)=RCRF
.D DIQ^PSODI(PSOFILE,DIC,.DR,.DA,.DIQ)
.S RCPRDT=$G(RCX(52.1,DA(52.1),17,"I"))
E D
.S DR=31
.S DA=+RCRXN
.D DIQ^PSODI(PSOFILE,DIC,DR,DA,.DIQ)
.S RCPRDT=$G(RCX(52,DA,31,"I"))
S RCPRDT=$P(RCPRDT,".")
;Return refill date without time
Q RCPRDT
INP ; get inpatient admission and discharge date
N PM,PM0,X,X1,X2
I +RCIBSL=405 D
.S PM=+$P(RCIBSL,":",2),PM0=$G(^DGPM(PM,0))
.S RCIBAD=$S(PM0:+PM0\1,1:$P(RCIBPE,"^",17))
.S RCIBAD=$E($$HLDATE^HLFNC(RCIBAD),1,8)
.S RCIBDD=$S(PM0:$S($D(^DGPM(+$P(PM0,"^",17),0)):+^(0)\1,1:""),1:"")
.S RCIBDD=$E($$HLDATE^HLFNC(RCIBDD),1,8)
I +RCIBSL=45 D
.S PM=+$P(RCIBSL,":",2),PM0=$G(^DGPT(PM,0))
.S RCIBAD=$S(PM0:+$P(PM0,"^",2)\1,1:$P(RCIBPE,"^",17))
.S RCIBAD=$E($$HLDATE^HLFNC(RCIBAD),1,8)
.S RCIBDD=$S($G(^DGPT(PM,70)):+^(70)\1,1:"")
.S RCIBDD=$E($$HLDATE^HLFNC(RCIBDD),1,8)
Q
SITE(IIEN,FLG) ; Find the Care Site for Co-Pays
; Input Parameters
; IIEN = Internal Entry Number for IB ACTION #350
; FLG = 1=Division Name,2=Facility Number
;
NEW VDIV,VFAC,VWIEN,VWFIL,VVIS,VLOC,VWARD,VLVAL,VWHER
S VWHER=$P(^IB(IIEN,0),U,4)
;
I VWHER="" Q ""
;
S VWFIL=$P(VWHER,":",1),VWIEN=$P(VWHER,":",2)
I VWIEN[";" S VWIEN=$P(VWIEN,";",1)
;
S VLVAL=""
MV I VWFIL=405 D
. I VWIEN="" Q
. S VWARD=$P($G(^DGPM(VWIEN,0)),U,6)
. I VWARD="" Q
. S VLOC=$P($G(^DIC(42,VWARD,44)),U,1)
. I VLOC="" Q
. S VDIV=$P($G(^SC(VLOC,0)),U,15)
. I VDIV="" Q
. D VLU
;
OP I VWFIL=409.68 D
. S VLOC=$P($G(^SCE(VWIEN,0)),U,4)
. I VLOC="" D
.. S VVIS=$P($G(^SCE(VWIEN,0)),U,5)
.. I VVIS="" Q
.. S VLOC=$P($G(^AUPNVSIT(VVIS,0)),U,22)
. I VLOC="" Q
. S VDIV=$P($G(^SC(VLOC,0)),U,15)
. I VDIV="" Q
. D VLU
;
RX I VWFIL=52 D
.N PSOFILE,DIC,DR,DA,DIQ,RCX
.S PSOFILE=52
.S DIC=52
.S DA=VWIEN
.S DR=5
.S DIQ="RCX"
.S DIQ(0)="I"
.D DIQ^PSODI(PSOFILE,DIC,DR,DA,.DIQ)
.S VLOC=$G(RCX(PSOFILE,DA,DR,"I"))
.I VLOC="" Q
.S VDIV=$P($G(^SC(VLOC,0)),U,15)
.I VDIV="" Q
.D VLU
;
LC I VWFIL=44 D
. S VDIV=$P($G(^SC(VWIEN,0)),U,15)
. I VDIV="" Q
. D VLU
;
IB I VWFIL=350 D
. S VFAC=$P($G(^IB(VWIEN,0)),U,13)
. I VFAC="" Q
. S VDIV=$O(^DG(40.8,"C",VFAC,""))
. I VDIV="" Q
. D VLU
;
Q VLVAL
;
VLU I FLG=1 S VLVAL=$P(^DG(40.8,VDIV,0),U,1)
I FLG=2 S VLVAL=$P(^DG(40.8,VDIV,0),U,2)
I $G(VLVAL)'=""&($G(VDIV)'="") S RCXVNPI=$P($$NPI^XUSNPI("Organization_ID",$$GET1^DIQ(40.8,VDIV,.07,"I")),RCXVU,1) S:+RCXVNPI<1 RCXVNPI=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVDC5 5108 printed Nov 22, 2024@16:59:46 Page 2
RCXVDC5 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
+1 ;;4.5;Accounts Receivable;**201,227,228,240,243,248,245,251**;Mar 20, 1995;Build 21
+2 ;
+3 ; Integrated Billing Action File (# 350)
+4 QUIT
D350 ;
+1 NEW RCXVD,RCXVDA,RCXVDB,RCXVD0A,RCXVDT,RCXVP1,RCXVP2,RCXVPC,RCT
+2 NEW RCIBVD,RCIBAD,RCIBDD,RCIBSL,RCIBBG,RCIBPE,RCXVNPI
+3 SET RCXVD0A=""
SET RCT=0
+4 FOR
SET RCXVD0A=$ORDER(^IB("ABIL",RCXVBLNA,RCXVD0A))
if RCXVD0A=""
QUIT
Begin DoDot:1
+5 SET RCXVD=$GET(^IB(RCXVD0A,0))
+6 IF $GET(DFN)=""
SET DFN=$PIECE(RCXVD,U,2)
+7 ;
+8 SET RCXVDA=RCXVBLNA_RCXVU_$PIECE(RCXVD,U,1)
+9 SET RCXVDA=RCXVDA_RCXVU_$$GET1^DIQ(350,RCXVD0A_",",.05,"E")
+10 SET RCXVP1=$PIECE(RCXVD,U,3)
SET RCXVP2=""
+11 IF RCXVP1'=""
SET RCXVP2=$PIECE($GET(^IBE(350.1,RCXVP1,0)),U,1)
+12 ; ACTION TYPE (P)
SET RCXVDA=RCXVDA_RCXVU_RCXVP2
+13 ; UNITS
SET RCXVDA=RCXVDA_RCXVU_$PIECE(RCXVD,U,6)
+14 ; TOTAL CHARGE
SET RCXVDA=RCXVDA_RCXVU_$PIECE(RCXVD,U,7)
+15 SET RCXVDT=$PIECE(RCXVD,U,14)
+16 ; DT BILLD FROM
SET RCXVDA=RCXVDA_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
+17 SET RCXVDT=$PIECE(RCXVD,U,15)
+18 ; DT BILLD TO
SET RCXVDA=RCXVDA_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
+19 ; AR BILL #
SET RCXVDA=RCXVDA_RCXVU_$PIECE(RCXVD,U,11)
+20 SET RCXVDT=$PIECE($PIECE($GET(^IB(RCXVD0A,1)),U,2),".",1)
+21 ; DT ENTRY ADDED
SET RCXVDA=RCXVDA_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
+22 ; SSN
SET RCXVDA=RCXVDA_RCXVU_$PIECE($GET(^DPT(DFN,0)),U,9)
+23 SET RCXVDT=$PIECE(RCXVD,U,17)
+24 ; EVENT DT
SET RCXVDA=RCXVDA_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
+25 SET RCXVDT=$$PRESC($PIECE(RCXVD,U,4))
+26 ;FILL/REFILL DATE
SET RCXVDA=RCXVDA_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
+27 SET (RCIBVD,RCIBAD,RCIBDD)=""
Begin DoDot:2
+28 SET RCIBSL=$PIECE(RCXVD,U,4)
if +RCIBSL=52
QUIT
+29 SET RCIBBG=$PIECE($GET(^IBE(350.1,+$PIECE(RCXVD,"^",3),0)),"^",11)
+30 IF RCIBBG=4
SET RCXVDT=$PIECE(RCXVD,U,14)
SET RCIBVD=$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
QUIT
+31 SET RCIBPE=$GET(^IB(+$PIECE(RCXVD,"^",16),0))
+32 IF +RCIBSL'=405
IF +RCIBSL'=45
SET RCIBSL=$PIECE(RCIBPE,"^",4)
+33 IF +RCIBSL=405!(+RCIBSL=45)
DO INP
+34 QUIT
End DoDot:2
+35 ;add outpatient visit date, inp. admission date, inp. discharge date
+36 SET RCXVDA=RCXVDA_RCXVU_RCIBVD_RCXVU_RCIBAD_RCXVU_RCIBDD
+37 ;DIVISION WHERE CARE RENDERED^DIVISION NPI
SET RCXVNPI=""
SET RCXVDA=RCXVDA_RCXVU_$$SITE(RCXVD0A,1)_RCXVU_RCXVNPI
+38 SET RCT=RCT+1
+39 SET ^TMP($JOB,RCXVBLN,"5-350A",RCT)=RCXVDA
End DoDot:1
+40 QUIT
+41 ;
PRESC(RCPC4) ;Calculates prescription fill/refill date
+1 ; Input is resulting from field (4th piece of 0 node) in 350
+2 ; Output is fill/refill date in fileman format
+3 NEW RCRXN,RCRF,RCPRDT,PSOFILE,DIC,DR,DA,DIQ,RCX
+4 SET RCPRDT=""
+5 IF $PIECE(RCPC4,":")'=52
QUIT RCPRDT
+6 SET RCRXN=+$PIECE(RCPC4,":",2)
SET RCRF=$PIECE(RCPC4,":",3)
+7 ;Set variables for DIQ^PSODI call
+8 SET PSOFILE=52
+9 SET DIC=52
+10 SET DIQ="RCX"
+11 SET DIQ(0)="I"
+12 IF RCRF>0
Begin DoDot:1
+13 SET DR=52
+14 SET DR(52.1)="17"
+15 SET DA=RCRXN
+16 SET DA(52.1)=RCRF
+17 DO DIQ^PSODI(PSOFILE,DIC,.DR,.DA,.DIQ)
+18 SET RCPRDT=$GET(RCX(52.1,DA(52.1),17,"I"))
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 SET DR=31
+21 SET DA=+RCRXN
+22 DO DIQ^PSODI(PSOFILE,DIC,DR,DA,.DIQ)
+23 SET RCPRDT=$GET(RCX(52,DA,31,"I"))
End DoDot:1
+24 SET RCPRDT=$PIECE(RCPRDT,".")
+25 ;Return refill date without time
+26 QUIT RCPRDT
INP ; get inpatient admission and discharge date
+1 NEW PM,PM0,X,X1,X2
+2 IF +RCIBSL=405
Begin DoDot:1
+3 SET PM=+$PIECE(RCIBSL,":",2)
SET PM0=$GET(^DGPM(PM,0))
+4 SET RCIBAD=$SELECT(PM0:+PM0\1,1:$PIECE(RCIBPE,"^",17))
+5 SET RCIBAD=$EXTRACT($$HLDATE^HLFNC(RCIBAD),1,8)
+6 SET RCIBDD=$SELECT(PM0:$SELECT($DATA(^DGPM(+$PIECE(PM0,"^",17),0)):+^(0)\1,1:""),1:"")
+7 SET RCIBDD=$EXTRACT($$HLDATE^HLFNC(RCIBDD),1,8)
End DoDot:1
+8 IF +RCIBSL=45
Begin DoDot:1
+9 SET PM=+$PIECE(RCIBSL,":",2)
SET PM0=$GET(^DGPT(PM,0))
+10 SET RCIBAD=$SELECT(PM0:+$PIECE(PM0,"^",2)\1,1:$PIECE(RCIBPE,"^",17))
+11 SET RCIBAD=$EXTRACT($$HLDATE^HLFNC(RCIBAD),1,8)
+12 SET RCIBDD=$SELECT($GET(^DGPT(PM,70)):+^(70)\1,1:"")
+13 SET RCIBDD=$EXTRACT($$HLDATE^HLFNC(RCIBDD),1,8)
End DoDot:1
+14 QUIT
SITE(IIEN,FLG) ; Find the Care Site for Co-Pays
+1 ; Input Parameters
+2 ; IIEN = Internal Entry Number for IB ACTION #350
+3 ; FLG = 1=Division Name,2=Facility Number
+4 ;
+5 NEW VDIV,VFAC,VWIEN,VWFIL,VVIS,VLOC,VWARD,VLVAL,VWHER
+6 SET VWHER=$PIECE(^IB(IIEN,0),U,4)
+7 ;
+8 IF VWHER=""
QUIT ""
+9 ;
+10 SET VWFIL=$PIECE(VWHER,":",1)
SET VWIEN=$PIECE(VWHER,":",2)
+11 IF VWIEN[";"
SET VWIEN=$PIECE(VWIEN,";",1)
+12 ;
+13 SET VLVAL=""
MV IF VWFIL=405
Begin DoDot:1
+1 IF VWIEN=""
QUIT
+2 SET VWARD=$PIECE($GET(^DGPM(VWIEN,0)),U,6)
+3 IF VWARD=""
QUIT
+4 SET VLOC=$PIECE($GET(^DIC(42,VWARD,44)),U,1)
+5 IF VLOC=""
QUIT
+6 SET VDIV=$PIECE($GET(^SC(VLOC,0)),U,15)
+7 IF VDIV=""
QUIT
+8 DO VLU
End DoDot:1
+9 ;
OP IF VWFIL=409.68
Begin DoDot:1
+1 SET VLOC=$PIECE($GET(^SCE(VWIEN,0)),U,4)
+2 IF VLOC=""
Begin DoDot:2
+3 SET VVIS=$PIECE($GET(^SCE(VWIEN,0)),U,5)
+4 IF VVIS=""
QUIT
+5 SET VLOC=$PIECE($GET(^AUPNVSIT(VVIS,0)),U,22)
End DoDot:2
+6 IF VLOC=""
QUIT
+7 SET VDIV=$PIECE($GET(^SC(VLOC,0)),U,15)
+8 IF VDIV=""
QUIT
+9 DO VLU
End DoDot:1
+10 ;
RX IF VWFIL=52
Begin DoDot:1
+1 NEW PSOFILE,DIC,DR,DA,DIQ,RCX
+2 SET PSOFILE=52
+3 SET DIC=52
+4 SET DA=VWIEN
+5 SET DR=5
+6 SET DIQ="RCX"
+7 SET DIQ(0)="I"
+8 DO DIQ^PSODI(PSOFILE,DIC,DR,DA,.DIQ)
+9 SET VLOC=$GET(RCX(PSOFILE,DA,DR,"I"))
+10 IF VLOC=""
QUIT
+11 SET VDIV=$PIECE($GET(^SC(VLOC,0)),U,15)
+12 IF VDIV=""
QUIT
+13 DO VLU
End DoDot:1
+14 ;
LC IF VWFIL=44
Begin DoDot:1
+1 SET VDIV=$PIECE($GET(^SC(VWIEN,0)),U,15)
+2 IF VDIV=""
QUIT
+3 DO VLU
End DoDot:1
+4 ;
IB IF VWFIL=350
Begin DoDot:1
+1 SET VFAC=$PIECE($GET(^IB(VWIEN,0)),U,13)
+2 IF VFAC=""
QUIT
+3 SET VDIV=$ORDER(^DG(40.8,"C",VFAC,""))
+4 IF VDIV=""
QUIT
+5 DO VLU
End DoDot:1
+6 ;
+7 QUIT VLVAL
+8 ;
VLU IF FLG=1
SET VLVAL=$PIECE(^DG(40.8,VDIV,0),U,1)
+1 IF FLG=2
SET VLVAL=$PIECE(^DG(40.8,VDIV,0),U,2)
+2 IF $GET(VLVAL)'=""&($GET(VDIV)'="")
SET RCXVNPI=$PIECE($$NPI^XUSNPI("Organization_ID",$$GET1^DIQ(40.8,VDIV,.07,"I")),RCXVU,1)
if +RCXVNPI<1
SET RCXVNPI=""
+3 QUIT
