BARDYSUT ; IHS/SD/TPF - DAYS IN A/R REPORT UTILS ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**1**;AUG 16, 2006
;
Q
;FOR ANY GIVEN VISIT RETURN THE PRIMARY PROVIDER FOR THE VISIT/ENCOUNTER
;'V PROVIDER' FILE FIELD 'PRIMARY/SECONDARY'
GETVPROV(VIEN) ;EP - PRIMARY PROVIDER
N PRV,FOUND
S FOUND=0
S PRV="" F S PRV=$O(^AUPNVPRV("AD",VIEN,PRV)) Q:'PRV D Q:FOUND
.I $$GET1^DIQ(9000010.06,PRV_",",.04,"I")="P" S PRV=FOUND
Q FOUND
;FOR ANY GIVEN VISIT IS THERE A DISCHARGE DATE
;'V HOSPITALIZATION' FILE FIELD 'DATE OF DISCHARGE'
DISCHARG(VIEN) ;EP - IS THIS VISIT AN IN PATIENT? IS SO RETURN DISCHARGE DATE
S DISCHARG=$O(^AUPNVINP("AD",VIEN,""))
Q:DISCHARG="" 0
S DISCHARG=$$GET1^DIQ(9000010.02,DISCHARG_",",.01,"I")
Q DISCHARG
;INITIALIZE COUNTERS USED IN CALCULATIONS
INITVIS ;EP - INITIALIZE COUNTERS
K CREDAYS,REVDAYS,TPBAPP,TPBEXP,NUMVISIT,NUMBILLS,BILLAMT,AMTBILLD,BILLNUM,DYSTOPAY
K EARLYPAY,LASTPAY,TOTPOST,WITBILLS,PACKREJ,NOBILLS,AVGCHKIN,BILLREJT,DAYSAPP
S (DONE,NUMVISIT,CREDAYS,REVDAYS,TPBAPP,TPBEXP,NUMBILLS,BILLAMT,AMTBILLD,BILLNUM)=0
S (EARLYPAY,LASTPAY,DYSTOPAY,TOTPOST,WITBILLS,PACKREJ,NOBILLS,AVGCHKIN,BILLREJT)=0
K NOARIEN,DATEREJT
S NOARIEN=0,DATEREJT=0,DAYSAPP=0
Q
;THIS SUBROUTINE WAS TAKEN FROM ROUTINE ABMDVST2
;GIVEN V PROVIDER IEN
PRVCHK(X) ;Subrtn to find attending and operating
S X=$O(^AUPNPRV("AD",X,""))
Q:X="" 0
Q:'$D(^AUPNVPRV(X,0)) 0
;If provider Attending or Primary set ABMAT to ien otherwise 0
I 'BARAT S BARAT=$S($P(^AUPNVPRV(X,0),U,5)="A":X,$P(^(0),U,4)="P":X,1:0)
;If provider Operating set ABMOP to ien otherwise 0
I 'BAROP S BAROP=$S($P(^AUPNVPRV(X,0),U,5)="O":X,1:0)
Q BARAT_U_BAROP
;THIS SUB IS USED TO INVESTIGATE WHAT THE TRUE PRIMARY BILL IS
;I.E. WHAT IS THE ACTUAL BEGINNING CHARGE AND COST OF SERVICE
;CHECKING A/R TRANSACTION FILE
CHKARTR(FROM,TO) ;EP -
S TRANIEN=0,OFFSET=0
S:$G(FROM)'="" TRANIEN=FROM-.01
S:$G(TO)="" TO=99999999999999999
F S TRANIEN=$O(^BARTR(DUZ(2),TRANIEN)) Q:'TRANIEN!(TRANIEN>TO) D
.S TRANIENS=TRANIEN_","
.S BILL=$$GET1^DIQ(90050.03,TRANIENS,4)
.S DEBIT=$$GET1^DIQ(90050.03,TRANIENS,3)
.S BILLTYPE=$$GET1^DIQ(90050.03,TRANIENS,16,"I")
.S TRANTYPE=$$GET1^DIQ(90050.03,TRANIENS,101)
.S TRANERR=$$GET1^DIQ(90050.03,TRANIENS,103)
.I TRANERR[("ERROR"),(BILL[("A")) W !,"BILLED ERROR: ",TRANIEN
.Q:TRANERR["ERROR"
.Q:TRANTYPE'="BILL NEW"
.Q:BILLTYPE'="PRIMARY"
.Q:'DEBIT
.S BILLSTAG=$P(BILL,"-")
.S BILLSTAG=$E(BILLSTAG,$L(BILLSTAG))
.Q:BILLSTAG="A"
.W !!,"BILL: ",BILL
.W !,"TRAN IEN: ",TRANIEN
.W !,"TRAN TYPE: ",TRANTYPE
.W !,"BILL TYPE: ",BILLTYPE
.W !,"DEBIT: ",DEBIT
.;B:DUZ=724&(BILL["492776A") "S+"
Q
;LIST POSSIBLE VALUES FOR A/R BILL FILE 'CURRENT BILL STATUS'
CURBIL ;EP
K ARRAY
S BILLIEN=0
F S BILLIEN=$O(^BARBL(DUZ(2),BILLIEN)) Q:'BILLIEN D
.S CURSTAT=$$GET1^DIQ(90050.01,BILLIEN_",",16)
.S:CURSTAT="" CURSTAT="UNDEF"
.S ARRAY(CURSTAT)=$G(ARRAY(CURSTAT))+1
S STAT=""
F S STAT=$O(ARRAY(STAT)) Q:STAT="" D
.W !,"THERE WERE ",$G(ARRAY(STAT)),?25," BILLS FOUND WITH 'CURRENT BILL STATUS' = ",STAT
Q
;THIS SUB IS USED TO INVESTIGATE WHAT THE TRUE PRIMARY BILL IS
;I.E. WHAT IS THE ACTUAL BEGINNING CHARGE AND COST OF SERVICE
;CHECKING 3P BILL FILE
CHK3PBL ;EP
S TPBIEN=0
F S TPBIEN=$O(^ABMDBILL(DUZ(2),TPBIEN)) Q:'TPBIEN D
.S BILLSTAT=$$GET1^DIQ(9002274.4,TPBIEN_",",.04,"E")
.
;LIST POSSIBLE VALUES FOR 3P BILL FILE 'BILL STATUS'
CURTPB ;EP
K ARRAY
S TPBIEN=0
F S TPBIEN=$O(^ABMDBILL(DUZ(2),TPBIEN)) Q:'TPBIEN D
.S BILLSTAT=$$GET1^DIQ(9002274.4,TPBIEN_",",.04,"E")
.S:BILLSTAT="" BILLSTAT="UNDEF"
.S ARRAY(BILLSTAT)=$G(ARRAY(BILLSTAT))+1
S STAT=""
F S STAT=$O(ARRAY(STAT)) Q:STAT="" D
.W !,"THERE WERE ",$G(ARRAY(STAT)),?25," 3P BILLS FOUND WITH 'BILL STATUS' = ",STAT
Q
BARDYSUT ; IHS/SD/TPF - DAYS IN A/R REPORT UTILS ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1**;AUG 16, 2006
+2 ;
+3 QUIT
+4 ;FOR ANY GIVEN VISIT RETURN THE PRIMARY PROVIDER FOR THE VISIT/ENCOUNTER
+5 ;'V PROVIDER' FILE FIELD 'PRIMARY/SECONDARY'
GETVPROV(VIEN) ;EP - PRIMARY PROVIDER
+1 NEW PRV,FOUND
+2 SET FOUND=0
+3 SET PRV=""
FOR
SET PRV=$ORDER(^AUPNVPRV("AD",VIEN,PRV))
IF 'PRV
QUIT
Begin DoDot:1
+4 IF $$GET1^DIQ(9000010.06,PRV_",",.04,"I")="P"
SET PRV=FOUND
End DoDot:1
IF FOUND
QUIT
+5 QUIT FOUND
+6 ;FOR ANY GIVEN VISIT IS THERE A DISCHARGE DATE
+7 ;'V HOSPITALIZATION' FILE FIELD 'DATE OF DISCHARGE'
DISCHARG(VIEN) ;EP - IS THIS VISIT AN IN PATIENT? IS SO RETURN DISCHARGE DATE
+1 SET DISCHARG=$ORDER(^AUPNVINP("AD",VIEN,""))
+2 IF DISCHARG=""
QUIT 0
+3 SET DISCHARG=$$GET1^DIQ(9000010.02,DISCHARG_",",.01,"I")
+4 QUIT DISCHARG
+5 ;INITIALIZE COUNTERS USED IN CALCULATIONS
INITVIS ;EP - INITIALIZE COUNTERS
+1 KILL CREDAYS,REVDAYS,TPBAPP,TPBEXP,NUMVISIT,NUMBILLS,BILLAMT,AMTBILLD,BILLNUM,DYSTOPAY
+2 KILL EARLYPAY,LASTPAY,TOTPOST,WITBILLS,PACKREJ,NOBILLS,AVGCHKIN,BILLREJT,DAYSAPP
+3 SET (DONE,NUMVISIT,CREDAYS,REVDAYS,TPBAPP,TPBEXP,NUMBILLS,BILLAMT,AMTBILLD,BILLNUM)=0
+4 SET (EARLYPAY,LASTPAY,DYSTOPAY,TOTPOST,WITBILLS,PACKREJ,NOBILLS,AVGCHKIN,BILLREJT)=0
+5 KILL NOARIEN,DATEREJT
+6 SET NOARIEN=0
SET DATEREJT=0
SET DAYSAPP=0
+7 QUIT
+8 ;THIS SUBROUTINE WAS TAKEN FROM ROUTINE ABMDVST2
+9 ;GIVEN V PROVIDER IEN
PRVCHK(X) ;Subrtn to find attending and operating
+1 SET X=$ORDER(^AUPNPRV("AD",X,""))
+2 IF X=""
QUIT 0
+3 IF '$DATA(^AUPNVPRV(X,0))
QUIT 0
+4 ;If provider Attending or Primary set ABMAT to ien otherwise 0
+5 IF 'BARAT
SET BARAT=$SELECT($PIECE(^AUPNVPRV(X,0),U,5)="A":X,$PIECE(^(0),U,4)="P":X,1:0)
+6 ;If provider Operating set ABMOP to ien otherwise 0
+7 IF 'BAROP
SET BAROP=$SELECT($PIECE(^AUPNVPRV(X,0),U,5)="O":X,1:0)
+8 QUIT BARAT_U_BAROP
+9 ;THIS SUB IS USED TO INVESTIGATE WHAT THE TRUE PRIMARY BILL IS
+10 ;I.E. WHAT IS THE ACTUAL BEGINNING CHARGE AND COST OF SERVICE
+11 ;CHECKING A/R TRANSACTION FILE
CHKARTR(FROM,TO) ;EP -
+1 SET TRANIEN=0
SET OFFSET=0
+2 IF $GET(FROM)'=""
SET TRANIEN=FROM-.01
+3 IF $GET(TO)=""
SET TO=99999999999999999
+4 FOR
SET TRANIEN=$ORDER(^BARTR(DUZ(2),TRANIEN))
IF 'TRANIEN!(TRANIEN>TO)
QUIT
Begin DoDot:1
+5 SET TRANIENS=TRANIEN_","
+6 SET BILL=$$GET1^DIQ(90050.03,TRANIENS,4)
+7 SET DEBIT=$$GET1^DIQ(90050.03,TRANIENS,3)
+8 SET BILLTYPE=$$GET1^DIQ(90050.03,TRANIENS,16,"I")
+9 SET TRANTYPE=$$GET1^DIQ(90050.03,TRANIENS,101)
+10 SET TRANERR=$$GET1^DIQ(90050.03,TRANIENS,103)
+11 IF TRANERR[("ERROR")
IF (BILL[("A"))
WRITE !,"BILLED ERROR: ",TRANIEN
+12 IF TRANERR["ERROR"
QUIT
+13 IF TRANTYPE'="BILL NEW"
QUIT
+14 IF BILLTYPE'="PRIMARY"
QUIT
+15 IF 'DEBIT
QUIT
+16 SET BILLSTAG=$PIECE(BILL,"-")
+17 SET BILLSTAG=$EXTRACT(BILLSTAG,$LENGTH(BILLSTAG))
+18 IF BILLSTAG="A"
QUIT
+19 WRITE !!,"BILL: ",BILL
+20 WRITE !,"TRAN IEN: ",TRANIEN
+21 WRITE !,"TRAN TYPE: ",TRANTYPE
+22 WRITE !,"BILL TYPE: ",BILLTYPE
+23 WRITE !,"DEBIT: ",DEBIT
+24 ;B:DUZ=724&(BILL["492776A") "S+"
End DoDot:1
+25 QUIT
+26 ;LIST POSSIBLE VALUES FOR A/R BILL FILE 'CURRENT BILL STATUS'
CURBIL ;EP
+1 KILL ARRAY
+2 SET BILLIEN=0
+3 FOR
SET BILLIEN=$ORDER(^BARBL(DUZ(2),BILLIEN))
IF 'BILLIEN
QUIT
Begin DoDot:1
+4 SET CURSTAT=$$GET1^DIQ(90050.01,BILLIEN_",",16)
+5 IF CURSTAT=""
SET CURSTAT="UNDEF"
+6 SET ARRAY(CURSTAT)=$GET(ARRAY(CURSTAT))+1
End DoDot:1
+7 SET STAT=""
+8 FOR
SET STAT=$ORDER(ARRAY(STAT))
IF STAT=""
QUIT
Begin DoDot:1
+9 WRITE !,"THERE WERE ",$GET(ARRAY(STAT)),?25," BILLS FOUND WITH 'CURRENT BILL STATUS' = ",STAT
End DoDot:1
+10 QUIT
+11 ;THIS SUB IS USED TO INVESTIGATE WHAT THE TRUE PRIMARY BILL IS
+12 ;I.E. WHAT IS THE ACTUAL BEGINNING CHARGE AND COST OF SERVICE
+13 ;CHECKING 3P BILL FILE
CHK3PBL ;EP
+1 SET TPBIEN=0
+2 FOR
SET TPBIEN=$ORDER(^ABMDBILL(DUZ(2),TPBIEN))
IF 'TPBIEN
QUIT
Begin DoDot:1
+3 SET BILLSTAT=$$GET1^DIQ(9002274.4,TPBIEN_",",.04,"E")
+4 End DoDot:1
+5 ;LIST POSSIBLE VALUES FOR 3P BILL FILE 'BILL STATUS'
CURTPB ;EP
+1 KILL ARRAY
+2 SET TPBIEN=0
+3 FOR
SET TPBIEN=$ORDER(^ABMDBILL(DUZ(2),TPBIEN))
IF 'TPBIEN
QUIT
Begin DoDot:1
+4 SET BILLSTAT=$$GET1^DIQ(9002274.4,TPBIEN_",",.04,"E")
+5 IF BILLSTAT=""
SET BILLSTAT="UNDEF"
+6 SET ARRAY(BILLSTAT)=$GET(ARRAY(BILLSTAT))+1
End DoDot:1
+7 SET STAT=""
+8 FOR
SET STAT=$ORDER(ARRAY(STAT))
IF STAT=""
QUIT
Begin DoDot:1
+9 WRITE !,"THERE WERE ",$GET(ARRAY(STAT)),?25," 3P BILLS FOUND WITH 'BILL STATUS' = ",STAT
End DoDot:1
+10 QUIT
