IBOTR ;ALB/CPM - INSURANCE PAYMENT TREND REPORT - USER INTERFACE; 5-JUN-91
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
;MAP TO DGCROTR
;
;***
;S XRTL=$ZU(0),XRTN="IBOTR-1" D T0^%ZOSV ;start rt clock
D DT^DICRW,HOME^%ZIS
S DIC="^DGCR(399.3,",DIC(0)="AEQMN",DIC("S")="I $P(^(0),U,7)=""i"""
D ^DIC K DIC G END:Y<1 S IBRT=+Y,IBRTN=$P(Y,"^",2)
;
; Issue Selection field decision prompt
W !!,"You may select a field from the BILL/CLAIMS file which you may use"
W !,"to limit the selection of records to appear on the report.",!
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"
D ^DIR K DIR G END:$D(DIRUT),CONT:'Y
;
; Issue Selection field prompts
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)"
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"
;
FD1 W !," START WITH "_IBAFN_": FIRST// " R X:DTIME G END:'$T!(X["^")
I $E(X,1,2)="??" S IBOFF=6 D HELP1,HELP2,HELP W ! G FD1
I $E(X)="?" S IBOFF=6 D HELP2,HELP W ! G FD1
I "@"[X S IBAFF=$S(IBAFD&(X=""):0,1:X) G FD2
I IBAFD D ^%DT K %DT S IBAFF=Y I Y<0 K IBAFF W ! S IBOFF=6 D HELP W ! G FD1
S:'IBAFD IBAFF=X
;
FD2 W !," GO TO "_IBAFN_": LAST// " R X:DTIME G END:'$T!(X["^")
I $E(X,1,2)="??" S IBOFF=12 D HELP1,HELP2,HELP W ! G FD2
I $E(X)="?" S IBOFF=12 D HELP2,HELP W ! G FD2
I X="" S IBAFL=$S(IBAFD:9999999,1:"") S:IBAFF="" IBAFZ="ALL" G CONT
I X="@",IBAFF="@" S IBAFL="@",IBAFZ="NULL" G CONT
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
I 'IBAFD,+IBAFF=IBAFF,+X=X G:X'<IBAFF FD21 W !!," The LAST value must follow the FIRST.",! G FD2
I 'IBAFD,IBAFF'="@",IBAFF]X W !!," The LAST value must follow the FIRST.",! G FD2
FD21 S:'IBAFD IBAFL=X
;
CONT D ^IBOTR1 ; Continue user interface; compile and print report.
;
END K IBRT,IBRTN,IBADFREF,IBAF,IBAFN,IBAFD,IBAFF,IBAFL,IBAFZ,IBBRT,IBBRN
K IBDF,IBDFN,IBBDT,IBEDT,IBICF,IBICL,IBIC,IBBRTY,IBOFF,IBTEXT,IBARST
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOTR" D T1^%ZOSV ;stop rt clock
Q
;
;
HELP F S IBTEXT=$P($T(TEXT+IBOFF),";",3) Q:IBTEXT="" W !,IBTEXT S IBOFF=IBOFF+1
Q
;
HELP1 W ! S IBX=0 F S IBX=$O(^DD(399,IBAF,21,IBX)) Q:'IBX W:$D(^(IBX,0)) !,^(0)
K IBX Q
;
HELP2 W:$D(^DD(399,IBAF,3)) !!,^(3),! Q
;
TEXT ; 'Additional Field' prompt
;; Enter: 'Y' - To select a field from the BILL/CLAIMS file
;; 'N' - To skip this prompt and continue with this option
;; '^' - To quit this option
;
; 'Start with FIELD NAME' prompt
;; Enter a valid field value, or
;; '@' - To include null values
;; '<CR>' - To start from the 'first' value for this field
;; '^' - To quit this option
;
; 'Go to FIELD NAME' prompt
;; Enter a valid field value, or
;; '@' - To include only null values, if 'Start with' value is @
;; '<CR>' - To go to the 'last' value for this field
;; '^' - To quit this option
;
IBOTR ;ALB/CPM - INSURANCE PAYMENT TREND REPORT - USER INTERFACE; 5-JUN-91
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
+3 ;MAP TO DGCROTR
+4 ;
+5 ;***
+6 ;S XRTL=$ZU(0),XRTN="IBOTR-1" D T0^%ZOSV ;start rt clock
+7 DO DT^DICRW
DO HOME^%ZIS
+8 SET DIC="^DGCR(399.3,"
SET DIC(0)="AEQMN"
SET DIC("S")="I $P(^(0),U,7)=""i"""
+9 DO ^DIC
KILL DIC
IF Y<1
GOTO END
SET IBRT=+Y
SET IBRTN=$PIECE(Y,"^",2)
+10 ;
+11 ; Issue Selection field decision prompt
+12 WRITE !!,"You may select a field from the BILL/CLAIMS file which you may use"
+13 WRITE !,"to limit the selection of records to appear on the report.",!
+14 SET DIR(0)="Y"
SET DIR("A")="Do you wish to choose such a field"
SET DIR("B")="NO"
SET DIR("?")="^S IBOFF=1 W ! D HELP^IBOTR"
+15 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO END
IF 'Y
GOTO CONT
+16 ;
+17 ; Issue Selection field prompts
+18 SET DIC="^DD(399,"
SET DIC(0)="AEQM"
SET DIC("A")="Select BILL/CLAIMS FIELD: "
SET DIC("S")="S IBX=$P(^(0),U,2) I $S('$D(^DD(+IBX,.01,0)):1,$P(^(0),U,2)[""M"":0,1:1)"
+19 DO ^DIC
KILL DIC,IBX
IF Y<0
GOTO END
SET IBAF=+Y
SET IBAFN=$PIECE(Y,"^",2)
SET IBAFD=$PIECE($GET(^DD(399,IBAF,0)),"^",2)["D"
+20 ;
FD1 WRITE !," START WITH "_IBAFN_": FIRST// "
READ X:DTIME
IF '$TEST!(X["^")
GOTO END
+1 IF $EXTRACT(X,1,2)="??"
SET IBOFF=6
DO HELP1
DO HELP2
DO HELP
WRITE !
GOTO FD1
+2 IF $EXTRACT(X)="?"
SET IBOFF=6
DO HELP2
DO HELP
WRITE !
GOTO FD1
+3 IF "@"[X
SET IBAFF=$SELECT(IBAFD&(X=""):0,1:X)
GOTO FD2
+4 IF IBAFD
DO ^%DT
KILL %DT
SET IBAFF=Y
IF Y<0
KILL IBAFF
WRITE !
SET IBOFF=6
DO HELP
WRITE !
GOTO FD1
+5 IF 'IBAFD
SET IBAFF=X
+6 ;
FD2 WRITE !," GO TO "_IBAFN_": LAST// "
READ X:DTIME
IF '$TEST!(X["^")
GOTO END
+1 IF $EXTRACT(X,1,2)="??"
SET IBOFF=12
DO HELP1
DO HELP2
DO HELP
WRITE !
GOTO FD2
+2 IF $EXTRACT(X)="?"
SET IBOFF=12
DO HELP2
DO HELP
WRITE !
GOTO FD2
+3 IF X=""
SET IBAFL=$SELECT(IBAFD:9999999,1:"")
IF IBAFF=""
SET IBAFZ="ALL"
GOTO CONT
+4 IF X="@"
IF IBAFF="@"
SET IBAFL="@"
SET IBAFZ="NULL"
GOTO CONT
+5 IF IBAFD
DO ^%DT
KILL %DT
SET IBAFL=Y
IF Y<0!(IBAFF'="@"&(Y<IBAFF))
KILL IBAFL
WRITE !!," LAST DATE must follow the BEGIN DATE.",!
GOTO FD2
+6 IF 'IBAFD
IF +IBAFF=IBAFF
IF +X=X
IF X'<IBAFF
GOTO FD21
WRITE !!," The LAST value must follow the FIRST.",!
GOTO FD2
+7 IF 'IBAFD
IF IBAFF'="@"
IF IBAFF]X
WRITE !!," The LAST value must follow the FIRST.",!
GOTO FD2
FD21 IF 'IBAFD
SET IBAFL=X
+1 ;
CONT ; Continue user interface; compile and print report.
DO ^IBOTR1
+1 ;
END KILL IBRT,IBRTN,IBADFREF,IBAF,IBAFN,IBAFD,IBAFF,IBAFL,IBAFZ,IBBRT,IBBRN
+1 KILL IBDF,IBDFN,IBBDT,IBEDT,IBICF,IBICL,IBIC,IBBRTY,IBOFF,IBTEXT,IBARST
+2 ;***
+3 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOTR" D T1^%ZOSV ;stop rt clock
+4 QUIT
+5 ;
+6 ;
HELP FOR
SET IBTEXT=$PIECE($TEXT(TEXT+IBOFF),";",3)
IF IBTEXT=""
QUIT
WRITE !,IBTEXT
SET IBOFF=IBOFF+1
+1 QUIT
+2 ;
HELP1 WRITE !
SET IBX=0
FOR
SET IBX=$ORDER(^DD(399,IBAF,21,IBX))
IF 'IBX
QUIT
IF $DATA(^(IBX,0))
WRITE !,^(0)
+1 KILL IBX
QUIT
+2 ;
HELP2 IF $DATA(^DD(399,IBAF,3))
WRITE !!,^(3),!
QUIT
+1 ;
TEXT ; 'Additional Field' prompt
+1 ;; Enter: 'Y' - To select a field from the BILL/CLAIMS file
+2 ;; 'N' - To skip this prompt and continue with this option
+3 ;; '^' - To quit this option
+4 ;
+5 ; 'Start with FIELD NAME' prompt
+6 ;; Enter a valid field value, or
+7 ;; '@' - To include null values
+8 ;; '<CR>' - To start from the 'first' value for this field
+9 ;; '^' - To quit this option
+10 ;
+11 ; 'Go to FIELD NAME' prompt
+12 ;; Enter a valid field value, or
+13 ;; '@' - To include only null values, if 'Start with' value is @
+14 ;; '<CR>' - To go to the 'last' value for this field
+15 ;; '^' - To quit this option
+16 ;
