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. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  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. 	S DIC="^DGCR(399.3,",DIC(0)="AEQMN",DIC("S")="I $P(^(0),U,7)=""i"""
  1. 	D ^DIC K DIC G END:Y<1 S IBRT=+Y,IBRTN=$P(Y,"^",2)
  1. 	;
  1. 	; Issue Selection field decision prompt
  1. 	W !!,"You may select a field from the BILL/CLAIMS file which you may use"
  1. 	W !,"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",DIR("B")="NO",DIR("?")="^S IBOFF=1 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: ",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 G:Y<0 END S IBAF=+Y,IBAFN=$P(Y,"^",2),IBAFD=$P($G(^DD(399,IBAF,0)),"^",2)["D"
  1. 	;
  1. FD1	W !,"   START WITH "_IBAFN_": FIRST// " R X:DTIME G END:'$T!(X["^")
  1. 	I $E(X,1,2)="??" S IBOFF=6 D HELP1,HELP2,HELP W ! G FD1
  1. 	I $E(X)="?" S IBOFF=6 D HELP2,HELP W ! G FD1
  1. 	I "@"[X S IBAFF=$S(IBAFD&(X=""):0,1:X) G FD2
  1. 	I IBAFD D ^%DT K %DT S IBAFF=Y I Y<0 K IBAFF W ! S IBOFF=6 D HELP W ! G FD1
  1. 	S:'IBAFD IBAFF=X
  1. 	;
  1. FD2	W !,"   GO TO "_IBAFN_": LAST// " R X:DTIME G END:'$T!(X["^")
  1. 	I $E(X,1,2)="??" S IBOFF=12 D HELP1,HELP2,HELP W ! G FD2
  1. 	I $E(X)="?" S IBOFF=12 D HELP2,HELP W ! G FD2
  1. 	I X="" S IBAFL=$S(IBAFD:9999999,1:"") S:IBAFF="" IBAFZ="ALL" G CONT
  1. 	I X="@",IBAFF="@" S IBAFL="@",IBAFZ="NULL" G CONT
  1. 	I IBAFD D ^%DT K %DT S IBAFL=Y I Y<0!(IBAFF'="@"&(Y<IBAFF)) K IBAFL W !!,"       LAST DATE must follow the BEGIN DATE.",! G FD2
  1. 	I 'IBAFD,+IBAFF=IBAFF,+X=X G:X'<IBAFF FD21 W !!,"       The LAST value must follow the FIRST.",! G FD2
  1. 	I 'IBAFD,IBAFF'="@",IBAFF]X W !!,"       The LAST value must follow the FIRST.",! G FD2
  1. FD21	S:'IBAFD IBAFL=X
  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
  1. 	K IBDF,IBDFN,IBBDT,IBEDT,IBICF,IBICL,IBIC,IBBRTY,IBOFF,IBTEXT,IBARST
  1. 	;***
  1. 	;I $D(XRT0) S:'$D(XRTN) XRTN="IBOTR" D T1^%ZOSV ;stop rt clock
  1. 	Q
  1. 	;
  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	;  '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 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. 	;;              '<CR>' -  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' value is @
  1. 	;;              '<CR>' -  To go to the 'last' value for this field
  1. 	;;              '^'    -  To quit this option
  1. 	;