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

IBOTR.m

Go to the documentation of this file.
  1. IBOTR ;ALB/CPM - INSURANCE PAYMENT TREND REPORT - USER INTERFACE; 5-JUN-91
  1. ;;2.0;INTEGRATED BILLING;**42,100,118,128,743,752**;21-MAR-94;Build 20
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;MAP TO DGCROTR
  1. ;
  1. ;***
  1. ;S XRTL=$ZU(0),XRTN="IBOTR-1" D T0^%ZOSV ;start rt clock
  1. D DT^DICRW,HOME^%ZIS
  1. ;
  1. N IBAF,IBAFD,IBAFF,IBAFL,IBAFN,IBARST,IBBC,IBBDT,IBBRN,IBBRT,IBBRTY,IBCANC,IBCFL,IBCNC,IBDA,IBDBC,IBDF,IBDFN,IBDIV,IBDP,IBEDT,IBEVT,IBICF,IBICL,IBINRC,IBPFLAG,IBPRNT,IBPTIN,IBQUIT,IBRT,IBRTN,IBSDIV,IBSORT
  1. N IBAFFO,IBAFLO,IBI,IBICFU,IBICLU,IBRET,IBSCR ;IB*752/DTG - New var's for upper/lower case
  1. S (IBAFFO,IBAFLO,IBICF,IBICFU,IBICL,IBICLU,IBSCR)=""
  1. ;
  1. ; - Sort by division.
  1. S DIR(0)="Y",DIR("B")="NO"
  1. S DIR("A")="Do you wish to sort this report by division"
  1. S DIR("?")="^S IBOFF=1 W ! D HELP^IBOTR"
  1. D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G END
  1. S IBSDIV=+Y K DIROUT,DTOUT,DUOUT,DIRUT
  1. ;
  1. ; - Issue prompt for division.
  1. I IBSDIV D PSDR^IBODIV G:Y<0 END
  1. ;
  1. ; - Select bill type to print.
  1. S DIC="^DGCR(399.3,",DIC(0)="AEQMN",DIC("S")="I $P(^(0),U,7)=""i"""
  1. W ! D ^DIC K DIC G END:Y<1 S IBRT=+Y,IBRTN=$P(Y,U,2)
  1. ;
  1. ; - Issue selection field decision prompt.
  1. W !!,"You may select a field from the BILL/CLAIMS file which you may"
  1. W !,"use to limit the selection of records to appear on the report.",!
  1. S DIR(0)="Y",DIR("A")="Do you wish to choose such a field"
  1. S DIR("B")="NO",DIR("?")="^S IBOFF=7 W ! D HELP^IBOTR"
  1. D ^DIR K DIR G END:$D(DIRUT),CONT:'Y
  1. ;
  1. ; - Issue selection field prompts.
  1. S DIC="^DD(399,",DIC(0)="AEQM",DIC("A")="Select BILL/CLAIMS FIELD: "
  1. S DIC("S")="S IBX=$P(^(0),U,2) I $S('$D(^DD(+IBX,.01,0)):1,$P(^(0),U,2)[""M"":0,1:1)"
  1. D ^DIC K DIC,IBX I Y<0 G CONT
  1. S IBAF=+Y,IBAFN=$P(Y,U,2),IBAFD=$P($G(^DD(399,IBAF,0)),U,2)["D"
  1. ;
  1. ;IB*743/TAZ - Updated FD1 to FileMan Read and to accept NULL to mean beginning of list.
  1. FD1 ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. W !!,"Enter Start With value or Press <ENTER> to start at the beginning of the list.",!
  1. S DIR(0)="FO"
  1. S DIR("A")="Start with "_IBAFN
  1. S DIR("?")="^S IBOFF=13 D HELP2^IBOTR,HELP^IBOTR"
  1. ; IB*743/DTG have '??' same as '?'
  1. ;S DIR("??")="^S IBOFF=7 D HELP1^IBOTR,HELP2^IBOTR,HELP^IBOTR"
  1. S DIR("??")="^S IBOFF=13 D HELP1^IBOTR,HELP2^IBOTR,HELP^IBOTR"
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) G END
  1. ;IB*752/DTG if name (#.02) make first name upper case
  1. ;I "@"[Y S IBAFF=$S(IBAFD&(Y=""):0,1:Y) G FD2
  1. I "@"[Y S IBAFF=$S(IBAFD&(Y=""):0,1:Y) S IBAFFO=IBAFF G FD2
  1. ;I IBAFD D ^%DT K %DT S IBAFF=Y I Y<0 K IBAFF W ! S IBOFF=7 D HELP W ! G FD1
  1. I IBAFD D ^%DT K %DT S IBAFF=Y,IBAFFO=IBAFF I Y<0 K IBAFF W ! S IBOFF=7 D HELP W ! G FD1
  1. I 'IBAFD S IBAFF=Y
  1. S IBAFFO=IBAFF I ($G(IBAF)=".02"&('IBAFF)&(IBAFF'="@")) S IBAFFO=$$UP^XLFSTR(IBAFF)
  1. ;
  1. ;IB*743/TAZ - Updated FD2 to FileMan Read and to accept NULL to mean end of list.
  1. FD2 ;
  1. W !!,"Enter Go To value or Press <ENTER> to finish at the end of the list.",!
  1. S DIR(0)="FO"
  1. S DIR("A")="Go to "_IBAFN
  1. S DIR("?")="^S IBOFF=19 D HELP2^IBOTR,HELP^IBOTR"
  1. S DIR("??")="^S IBOFF=19 D HELP1^IBOTR,HELP2^IBOTR,HELP^IBOTR"
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) G END
  1. ; IB*752/DTG if name (#.02) upper case
  1. ;I Y="" S IBAFL=$S(IBAFD:9999999,1:"") S:IBAFF="" IBAFZ="ALL" G CONT
  1. ;I Y="@",IBAFF="@" S IBAFL="@",IBAFZ="NULL" G CONT
  1. I Y="" S IBAFL=$S(IBAFD:9999999,1:"") S:IBAFF="" IBAFZ="ALL" S IBAFLO=IBAFL G CONT ;IB*752/DTG
  1. I Y="@",IBAFF="@" S IBAFL="@",IBAFZ="NULL" S IBAFLO=IBAFL G CONT ;IB*752/DTG
  1. I IBAFD D ^%DT K %DT S IBAFL=Y I Y<0!(IBAFF'="@"&(Y<IBAFF)) K IBAFL W !!?3,"The Go To "_IBAFN_" must follow the Start With "_IBAFN_".",! G FD1
  1. I 'IBAFD,+IBAFF=IBAFF,+Y=Y G:Y'<IBAFF FD21 W !!?3,"The Go To "_IBAFN_" must follow the Start With "_IBAFN_".",! G FD1
  1. ;IB*752/DTG
  1. ;I 'IBAFD,IBAFF'="@",IBAFF]Y W !!?3,"The Go To "_IBAFN_" must follow the Start With "_IBAFN_".",! G FD1
  1. I 'IBAFD,IBAFF'="@",IBAFF]Y,$G(IBAF)'=".02" W !!?3,"The Go To "_IBAFN_" must follow the Start With "_IBAFN_".",! G FD1
  1. I 'IBAFD,IBAFF'="@",$G(IBAF)=".02",IBAFFO]$$UP^XLFSTR(Y) W !!?3,"The Go To "_IBAFN_" must follow the Start With "_IBAFN_".",! G FD1
  1. FD21 I 'IBAFD S IBAFL=Y
  1. S IBAFLO=IBAFL I ($G(IBAF)=".02"&('IBAFL)&(IBAFL'="@")) S IBAFLO=$$UP^XLFSTR(IBAFL) ;IB*752/DTG
  1. ;
  1. CONT D ^IBOTR1 ; Continue user interface/compile and print report.
  1. ;
  1. END K IBRT,IBRTN,IBADFREF,IBAF,IBAFN,IBAFD,IBAFF,IBAFL,IBAFZ,IBBRT,IBBRN,IBG
  1. K IBDF,IBDFN,IBBDT,IBEDT,IBICF,IBICL,IBIC,IBBRTY,IBOFF,IBTEXT,IBARST
  1. K IBCANC,IBCNC,IBINRC,IBPRNT,IBSDIV,IBSORT,IBICPT,VAUTD
  1. K DIROUT,DTOUT,DUOUT,DIRUT
  1. K IBAFFO,IBAFLO,IBI,IBICFU,IBICLU,IBRET ;IB*752/DTG - New var's for upper/lower case
  1. ;***
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOTR" D T1^%ZOSV ;stop rt clock
  1. Q
  1. ;
  1. HELP F S IBTEXT=$P($T(TEXT+IBOFF),";",3) Q:IBTEXT="" W !,IBTEXT S IBOFF=IBOFF+1
  1. Q
  1. ;
  1. HELP1 W ! S IBX=0 F S IBX=$O(^DD(399,IBAF,21,IBX)) Q:'IBX W:$D(^(IBX,0)) !,^(0)
  1. K IBX Q
  1. ;
  1. HELP2 W:$D(^DD(399,IBAF,3)) !!,^(3),! Q
  1. ;
  1. TEXT ; - 'Sort by division' prompt.
  1. ;; Enter: '<CR>' - To print the report without regard to division
  1. ;; 'Y' - To select those divisions for which a separate
  1. ;; report should be created
  1. ;; '^' - To quit this option
  1. ;
  1. ; - 'Additional field' prompt.
  1. ;; Enter: 'Y' - To select a field from the BILL/CLAIMS file
  1. ;; 'N' - To skip this prompt and continue with this
  1. ;; option
  1. ;; '^' - To quit this option
  1. ;
  1. ; - 'Start with FIELD NAME' prompt.
  1. ;; Enter a valid field value, or
  1. ;; '@' - To include null values
  1. ;; '<ENTER>' - To start from the 'first' value for this field
  1. ;; '^' - To quit this option
  1. ;
  1. ; - 'Go to FIELD NAME' prompt.
  1. ;; Enter a valid field value, or
  1. ;; '@' - To include only null values, if 'Start with'
  1. ;; value is @
  1. ;; '<ENTER>' - To go to the 'last' value for this field
  1. ;; '^' - To quit this option
  1. ;