BARDYSUT.m

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