Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTUBO

IBTUBO.m

Go to the documentation of this file.
  1. IBTUBO ;ALB/AAS - UNBILLED AMOUNTS - GENERATE UNBILLED REPORTS ;29-SEP-94
  1. ;;2.0;INTEGRATED BILLING;**19,31,32,91,123,159,192,235,248,155,516,547,608,665**;21-MAR-94;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to 409.1 in ICR #4671
  1. ; Reference to 8 in ICR #427
  1. ;
  1. % ; - Entry point for manual option.
  1. N IBBDT,IBCOMP,IBDET,IBEDT,IBOPT,IBPRT,IBTIMON,IBQUIT,IBSEL,IBSBD
  1. S (IBQUIT,IBSBD)=0 D:'$D(DT) DT^DICRW
  1. W !!,"Re-Generate Unbilled Amounts Report",!
  1. ;
  1. ; - Ask to re-compile Unbilled Amounts data.
  1. S DIR(0)="Y",DIR("B")="NO"
  1. S DIR("A")="Do you want to store Unbilled Amounts figures"
  1. S DIR("?",1)="Enter 'YES' if you wish to store the Unbilled Amounts summary"
  1. S DIR("?",2)="figures in your system for a specific month/year in the past."
  1. S DIR("?",3)="Once stored, these figures will be available for inquiry through"
  1. S DIR("?",4)="the View Unbilled Amounts option [IBT VIEW UNBILLED AMOUNTS]."
  1. S DIR("?",5)="These summary figures are normally calculated and stored"
  1. S DIR("?",6)="automatically by the system at the beginning of each month for"
  1. S DIR("?",7)="the previous month."
  1. S DIR("?",8)=" "
  1. S DIR("?",9)="If you enter 'NO', the Unbilled Amounts summary figures will"
  1. S DIR("?",10)="NOT be stored in your system, and the report may be run for"
  1. S DIR("?")="any date range."
  1. D ^DIR K DIR G:$D(DIRUT) END S IBCOMP=Y
  1. ;
  1. ; IB*2.0*516 - Added ability to sort by Division
  1. ;
  1. K ^TMP($J,"IBTUB"),^TMP($J,"IBTUB-DIV")
  1. I IBCOMP G RDATE
  1. ;
  1. ;IB*2.0*547/TAZ - Add prompt to search by division. If NO bypass all division selection.
  1. S DIR(0)="Y",DIR("B")="NO" W !
  1. S DIR("A")="Search by Division?"
  1. S DIR("?",1)=" This opt allows you to search for all unbilled amounts"
  1. S DIR("?",2)=" or to search for unbilled amounts in only one or more"
  1. S DIR("?",3)=" divisions."
  1. S DIR("?",4)=""
  1. S DIR("?",5)="Choose from:"
  1. S DIR("?",6)=" N NO"
  1. S DIR("?")=" Y YES"
  1. D ^DIR K DIR G:$D(DIRUT) END
  1. S IBSBD=Y I 'IBSBD G DIVX
  1. ;
  1. DIV ; division
  1. W !!
  1. S DIR(0)="SA^A:All Divisions;S:Selected Divisions"
  1. S DIR("A")="Include All Divisions or Selected Divisions? "
  1. S DIR("B")="All"
  1. D ^DIR K DIR
  1. I $D(DIROUT)!$D(DIRUT) Q ;Timeout or User "^"
  1. I Y="A" G DIVX
  1. ;
  1. W !
  1. F D I IBQUIT S IBQUIT=IBQUIT-1 Q
  1. . S DIC=40.8,DIC(0)="AEMQ",DIC("A")=" Select Division: "
  1. . I $O(^TMP($J,"IBTUB-DIV","")) S DIC("A")=" Select Another Division: "
  1. . D ^DIC K DIC ; lookup
  1. . I X="^^" S IBQUIT=2 Q ; user entered ^^
  1. . I +Y'>0 S IBQUIT=1 Q ; user is done
  1. . S ^TMP($J,"IBTUB-DIV",+Y)=$P(Y,U,2)
  1. . Q
  1. ;
  1. I IBQUIT G END ;User "^" out of the selection
  1. ;
  1. I '$O(^TMP($J,"IBTUB-DIV","")) D G DIV
  1. . W *7,!!?3,"No divisions have been selected. Please try again."
  1. . Q
  1. ;
  1. DIVX ; Exit Division selection.
  1. ;
  1. ;JRA;IB*2.0*608 Ask to Search by MCCF, Non-MCCF or Both - Start
  1. N ARTIEN,ARTYP,ELIG,ELIGIEN,LN,X ;JRA;IB*2*665 Moved up from below and added LN
  1. ;
  1. ;JRA;IB*2*665 Set up array of non-MCCF Rate Types
  1. S ARTIEN="" F S ARTIEN=$O(^IBE(350.9,1,28,"B",ARTIEN)) Q:'ARTIEN D
  1. . S IBMCCF("RTYP",ARTIEN)=$$GET1^DIQ(399.3,ARTIEN_",",.01,"I")
  1. ;
  1. W !
  1. S DIR(0)="SA^M:MCCF;N:Non-MCCF (Outpatient Only);B:Both"
  1. S DIR("A")="Search by (M)CCF, (N)on-MCCF (Outpatient Only), or (B)oth? "
  1. S DIR("B")="M"
  1. S DIR("?",1)="Non-MCCF Eligibilities of Encounter are: 'CHAMPVA', 'INELIGIBLE',"
  1. S DIR("?",2)=" 'EMPLOYEE', 'TRICARE' and 'SHARING AGREEMENT'."
  1. S DIR("?",3)="Non-MCCF Appointment Types are: 'EMPLOYEE' and 'SHARING AGREEMENT'."
  1. ;S DIR("?",4)="Non-MCCF Rate Types are 'CHAMPVA REIMB. INS.', 'CHAMPVA'," ;JRA;IB*2*665 ';'
  1. ;S DIR("?",5)=" 'TRICARE REIMB. INS.', 'TRICARE', 'INELIGIBLE' and 'INTERAGENCY'." ;JRA;IB*2*665 ';'
  1. S DIR("?",4)="Non-MCCF Rate Types are:" ;JRA;IB*2*665
  1. S ARTIEN="",LN=5 F S ARTIEN=$O(IBMCCF("RTYP",ARTIEN)) Q:ARTIEN="" D ;JRA;IB*2*665
  1. . I $L($G(DIR("?",LN)))+($L(" '"_IBMCCF("RTYP",ARTIEN)_"',"))>80 S DIR("?",LN)=DIR("?",LN)_",",LN=LN+1 ;JRA;IB*2*665
  1. . S DIR("?",LN)=$S($G(DIR("?",LN))="":" '"_IBMCCF("RTYP",ARTIEN)_"'",1:DIR("?",LN)_", '"_IBMCCF("RTYP",ARTIEN)_"'") ;JRA;IB*2*665
  1. S DIR("?",LN)=DIR("?",LN)_"." ;JRA;IB*2*665
  1. S DIR("?")="All other Eligibilities/Types are MCCF."
  1. D ^DIR K DIR G:($D(DIROUT)!($D(DIRUT))) END
  1. S IBMCCF=Y
  1. ;Set up arrays of Non-MCCF Rate Types, Non-MCCF Appointment Types and Non-MCCF Eligibility of Encounter entries.
  1. ;N ARTIEN,ARTYP,ELIG,ELIGIEN,X ;JRA;IB*2*665 ';'
  1. ;F ARTYP="INTERAGENCY","CHAMPVA REIMB. INS.","CHAMPVA","TRICARE REIMB. INS.","TRICARE","INELIGIBLE" D ;Non-MCCF Rate Types ;JRA;IB*2*665 ';'
  1. ;. S ARTIEN=$O(^DGCR(399.3,"B",ARTYP,"")) I +ARTIEN S IBMCCF("RTYP",ARTIEN)="" ;JRA;IB*2*665 ';'
  1. F ARTYP="EMPLOYEE","SHARING AGREEMENT" D ;Non-MCCF Appointment Types
  1. . ;DBIA4671 for following FIND^DIC
  1. . K ^TMP("DILIST",$J) D FIND^DIC(409.1,,"@;.01","X",ARTYP) I $D(^TMP("DILIST",$J,2))>1 D
  1. . . S X=0 F S X=$O(^TMP("DILIST",$J,2,X)) Q:'X S ARTIEN=^TMP("DILIST",$J,2,X) S:+ARTIEN IBMCCF("ATYP",ARTIEN)=""
  1. F ELIG="CHAMPVA","INELIGIBLE","EMPLOYEE","TRICARE","SHARING AGREEMENT" D ;Non-MCCF "Eligibility of Encounter" Entries
  1. . ;DBIA427 for following FIND^DIC
  1. . K ^TMP("DILIST",$J) D FIND^DIC(8,,"@;.01","X",ELIG) I $D(^TMP("DILIST",$J,2))>1 D
  1. . . S X=0 F S X=$O(^TMP("DILIST",$J,2,X)) Q:'X S ELIGIEN=^TMP("DILIST",$J,2,X) S:+ELIGIEN IBMCCF("ELIG",ELIGIEN)=""
  1. ;JRA;IB*2.0*608 - End
  1. ;
  1. ; - Select date(s) to build report.
  1. W ! D DT1^IBTUBOU G:IBBDT="^" END
  1. ;
  1. ; - Select report(s).
  1. S IBPRT="Choose report type(s) to print:"
  1. ;S IBOPT(1)="INPATIENT UNBILLED" ;JRA;IB*2.0*608 ';'
  1. ;S IBOPT(2)="OUTPATIENT UNBILLED" ;JRA;IB*2.0*608 ';'
  1. ;S IBOPT(3)="PRESCRIPTION UNBILLED" ;JRA;IB*2.0*608 ';'
  1. ;S IBOPT(4)="ALL OF THE ABOVE" ;JRA;IB*2.0*608 ';'
  1. I $G(IBMCCF)="N" S IBOPT(1)="OUTPATIENT UNBILLED" ;JRA;IB*2.0*608
  1. E D ;JRA;IB*2.0*608
  1. . S IBOPT(1)="INPATIENT UNBILLED"
  1. . S IBOPT(2)="OUTPATIENT UNBILLED"
  1. . S IBOPT(3)="PRESCRIPTION UNBILLED"
  1. . S IBOPT(4)="ALL OF THE ABOVE"
  1. ;S IBSEL=$$MLTP^IBJD(IBPRT,.IBOPT,1) I 'IBSEL G END ;JRA;IB*2.0*608 ';'
  1. S IBSEL=$$MLTP^IBJD(IBPRT,.IBOPT,$S($G(IBMCCF)="N":"",1:1)) I 'IBSEL G END ;JRA;IB*2.0*608
  1. ;JRA;IB*2.0*608 For Non-MCCF set IBSEL="2," since the value of IBSEL drives the computations and '2' is for Outpatient.
  1. ; Since "OUTPATIENT UNBILLED" is the only choice for Non-MCCF, IBSEL will be set to '1,' so need to reset to '2,'.
  1. S:$G(IBMCCF)="N" IBSEL="2," ;JRA;IB*2.0*608
  1. S $E(IBSEL,$L(IBSEL))=""
  1. ;
  1. RDATE ; - Select re-compile date, if necessary.
  1. I IBCOMP D G END:IBTIMON="^",DET
  1. . W ! D DT2("Unbilled Amounts") Q:IBTIMON="^"
  1. . W !!,"NOTE: Just a reminder that by entering the above month/year this"
  1. . W !," report will re-calculate and update the Unbilled Amounts"
  1. . W !," data on file in your system.",*7
  1. . ;
  1. . ; - Initialize variables
  1. . I IBTIMON<3030900 N X S X=$$M2^IBJDE(IBTIMON,11,11) D
  1. .. S IBBDT=+X,IBEDT=$P(X,U,2)+.9,IBSEL="1,2,3"
  1. . I IBTIMON'<3030900 S IBBDT=$$M3^IBJDE($$LDATE^IBJDE(IBTIMON)+1),IBEDT=$$LDATE^IBJDE(IBTIMON)+.9,IBSEL="1,2,3"
  1. . D MSG W !
  1. ;
  1. S IBTIMON=IBEDT\100*100
  1. ;
  1. DET ; - Ask to print detail report.
  1. S DIR(0)="Y",DIR("B")="NO" W !
  1. S DIR("A")="Print detail report with the Unbilled Amounts summary"
  1. S DIR("?",1)="Answer YES if you want a detailed listing of the patients"
  1. S DIR("?",2)="and events that are unbilled. Answer NO if you just want"
  1. S DIR("?")="the summary, or '^' to quit this option."
  1. D ^DIR K DIR G:$D(DIRUT) END S IBDET=Y G:'IBDET QUE
  1. ;
  1. ; Ask to include REQUEST MRA Status
  1. S DIR(0)="YA",DIR("A")="Do you want to include MRA claims?: ",DIR("B")="NO" W ! D ^DIR K DIR G:$D(DIRUT) END
  1. S IBINMRA=+Y
  1. ;
  1. ;IB*2.0*547/TAZ - Add prompt to sort by Patient or Divsion if Division Search was selected.
  1. I $G(IBSBD) D G:$D(DIRUT) END
  1. . S DIR("A")="Sort by: ",DIR("B")="Patient Name" W !
  1. . S DIR(0)="SA^N:PATIENT NAME;D:DIVISION^S:X="""" X=""N"""
  1. . S DIR("?",1)=" This determines whether the unbilled amounts are displayed"
  1. . S DIR("?",2)=" in alphabetical order of patient name or in alphabetical "
  1. . S DIR("?")=" order of patient name within a division."
  1. . D ^DIR K DIR
  1. . S IBSBD=Y="D" ;IBSBD=0 - Sort by Patient Name, IBSBD=1, Sort by Patient Name within Division.
  1. ;
  1. ; - Select device to print.
  1. W !!,"This report takes a while to run, so you should queue it to run"
  1. W !,"after normal business hours."
  1. W !!,"You will need a 132 column printer for this report!",!
  1. S %ZIS="QM" D ^%ZIS G END:POP,QUE:$D(IO("Q"))
  1. ;
  1. U IO G STR
  1. ;
  1. QUE ; - Queue report/summary, if necessary.
  1. W ! I 'IBDET S ZTIO=""
  1. S ZTRTN="IBTUBOA",ZTSAVE("IB*")=""
  1. S ZTDESC="IB - Unbilled Amounts Report"
  1. D ^%ZTLOAD K IO("Q"),ZTSK
  1. D HOME^%ZIS G END
  1. ;
  1. AUTO ; - Entry point for scheduled option.
  1. Q ;;**NO LONGER USED**
  1. ;
  1. DQ ; - Entry point for DM extract.
  1. ; - If AUTO PRINT UNBILLED LIST=yes and default report printer then
  1. ; automatically requeue to device.
  1. I $P(^IBE(350.9,1,6),U,24) D G END:'$G(IBXTRACT)
  1. . N X S X=$O(^IBE(353,"B","IB REPORTS",0))
  1. . S ZTIO=$P($G(^IBE(353,+X,0)),U,2) Q:ZTIO=""
  1. . S IBDET=1,IBXTRACT=0,ZTDTH=$H,ZTRTN="IBTUBOA",ZTSAVE("IB*")=""
  1. . S ZTDESC="IB - Unbilled Amounts Report" D ^%ZTLOAD
  1. . S IBDET=0,IBXTRACT=1
  1. . K ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK
  1. ;
  1. STR D ^IBTUBOA ; Start report.
  1. ;
  1. END K DIRUT,IBMCCF Q ;JRA IB*2.0*608 Added IBMCCF
  1. ;
  1. MSG ; - Compile message.
  1. W !!,"NOTE: After this report is run, the Unbilled Amounts totals for"
  1. W !?6,"the month of "_$$DAT2^IBOUTL(IBTIMON)_" will be updated."
  1. Q
  1. ;
  1. DT2(STR) ; - Select re-compile date (returns variable IBTIMON).
  1. ; Input: STR - String that describe the type of data that will be
  1. ; re-compiled: "Unbilled Amounts", "Average Bill Amounts", etc...
  1. ;
  1. ; This code is very the same code as is in DT2^IBTUBOU... that is
  1. ; a utility routine, so code was copied and altered to accommodate
  1. ; EOAM changes.
  1. N DIRUT,DT0,DT1,DT2,Y
  1. ; - AUG 1993 is the first month on file with Unbilled Amounts data
  1. S DT0=2930800,DT1=$$DAT2^IBOUTL(DT0)
  1. I $E(DT,6,7)'>$E($$LDATE^IBJDE(DT),6,7) S DT2=DT
  1. I $E(DT,6,7)>$E($$LDATE^IBJDE(DT),6,7) S DT2=DT+100 I $E(DT2,4,5)=13 S DT2=DT+8900
  1. S DT2=$$M1^IBJDE(DT2,1),DIR("B")=$$DAT2^IBOUTL(DT2)
  1. S DIR(0)="DA^"_$E(DT0,1,5)_"00:"_DT2_":AE^K:$E(Y,6,7)'=""00"" X"
  1. S DIR("A")="Re-compile "_$G(STR)_" through MONTH/YEAR: "
  1. S DIR("?",1)="Enter a past month/year (ex. Oct 2000).",DIR("?",2)=""
  1. S DIR("?",3)="NOTE: The earliest month/year that can be entered is "_DT1_", and"
  1. S DIR("?")=" it is NOT possible to enter the current or a future month/year."
  1. D ^DIR K DIR I $D(DIRUT) S IBTIMON="^" G DT2Q
  1. I $E(Y,6,7)'="00"!($E(Y,4,7)="0000") W " ??" G DT2
  1. S IBTIMON=Y
  1. ;
  1. DT2Q Q