IBEPTC1 ;ALB/CPM/ARH - TP FLAG STOP CODES AND CLINICS (CON'T.) ; 23-JUL-93
;;Version 2.0 ; INTEGRATED BILLING ;**55**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
REV ; Review selected entries and de-select if necessary.
W !!,"You have selected ",IBNUM," ",$P(IBINFO,";",3),"."
S DIR(0)="Y",DIR("A")="Would you like to review these selections",DIR("?")="^D HREV^IBEPTC1"
D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G REVQ
;
; - list selections and ask if user would like to de-select.
W ! D LIST W !
S DIR(0)="Y",DIR("A")="Would you like to de-select any entries"
S DIR("?")="Enter 'Y' to de-select entries, 'N' to continue, or '^' to quit."
D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G REVQ
;
; - allow de-selection and pull entries from the list.
S IBHIT=0 F D Q:Y<0
.S DIC=$P(IBINFO,";",5),DIC(0)="QEAMZ"
.S DIC("A")="De-select "_$S(IBHIT:"Next ",1:"")_$P(IBINFO,";",4)_": "
.S:$P(IBINFO,";",6)]"" DIC("S")=$P(IBINFO,";",6)
.D ^DIC K DIC Q:Y<0 S IBHIT=1
.I '$D(^TMP("IBEPTC",$J,+Y)) W !,"Please note that ",Y(0,0)," is not currently selected."
.E K ^TMP("IBEPTC",$J,+Y) S IBNUM=IBNUM-1
W !!,"You have selected a total of ",IBNUM," ",$P(IBINFO,";",$S(IBNUM=1:7,1:3)),"."
REVQ S:$D(DIRUT)!($D(DUOUT)) IBQ=1
Q
;
FILE ; File all selected entries.
N IBI,IBIN,IBALR
S IBI=0 F S IBI=$O(^TMP("IBEPTC",$J,IBI)) Q:'IBI S IBIN=^(IBI) D
.K DD,DO,DIC,DR
.S DIC=$P(IBINFO,";",8),DIC(0)="",X=IBI,DLAYGO=$P(IBINFO,";",9)
.;
.; - has this entry already been filed for this date?
.S IBALR=$O(@(DIC_"""AIVDTT2"","_IBI_","_-IBDAT_",0)"))
.;
.; - add new entry if not yet on file for the specified date
.I 'IBALR D FILE^DICN I Y<0 W !,"Unable to file ",IBIN,"..",! Q
.S DIE=$P(IBINFO,";",8),DA=$S(IBALR:IBALR,1:+Y),DR=".02////"_IBDAT_";.04////2;.05////"_IBFILE_";.06////"_IBTPAB
.D ^DIE K DA,DR,DIE W "."
W " done!"
Q
;
LIST ; List all selected entries.
W ! S I=0 F S I=$O(^TMP("IBEPTC",$J,I)) Q:'I W:$X>40 ! W:$X>2 ?40 W ^(I)
Q
;
HACT ; Help for the Billing action prompt.
W !!,"For Third Party Billing, please enter:"
W !," 'Y' to flag ",$S(IBNUM=1:"this",1:"these")," ",$P(IBINFO,";",$S(IBNUM=1:7,1:3))," as non-billable."
W !," 'N' to flag ",$S(IBNUM=1:"this",1:"these")," ",$P(IBINFO,";",$S(IBNUM=1:7,1:3))," as billable."
W !," '^' to quit this option."
Q
;
HAUTO ; Help for the Auto Biller action prompt.
W !!,"For the Third Party Auto Biller, please enter:"
W !," 'Y' if bills should be created for ",$S(IBNUM=1:"this",1:"these")," billable ",$P(IBINFO,";",$S(IBNUM=1:7,1:3))
W !," 'N' if bills should NOT be created for ",$S(IBNUM=1:"this",1:"these")," billable ",$P(IBINFO,";",$S(IBNUM=1:7,1:3))
W !," '^' to quit this option."
Q
;
HSEL ; Help for the Billing characteristic prompt.
W !!,"For Third Party Billing, please enter:"
W !," 'S' to flag some Stop Codes as (non) billable or (not) auto billed"
W !," 'C' to flag some Clinics as (non) billable or (not) auto billed"
W !," 'A' to flag ALL Clinics for the auto biller"
W !," '^' to quit this option."
Q
;
HREV ; Help for the Request to Review prompt.
W !!,"Enter 'Y' to review the selections, 'N' to continue, or '^' to quit."
W !,"Please note that, if you choose to review the selections, you will have"
W !,"the opportunity to de-select incorrect entries from the list."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEPTC1 3423 printed Dec 13, 2024@02:22:17 Page 2
IBEPTC1 ;ALB/CPM/ARH - TP FLAG STOP CODES AND CLINICS (CON'T.) ; 23-JUL-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**55**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
REV ; Review selected entries and de-select if necessary.
+1 WRITE !!,"You have selected ",IBNUM," ",$PIECE(IBINFO,";",3),"."
+2 SET DIR(0)="Y"
SET DIR("A")="Would you like to review these selections"
SET DIR("?")="^D HREV^IBEPTC1"
+3 DO ^DIR
KILL DIR
IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
GOTO REVQ
+4 ;
+5 ; - list selections and ask if user would like to de-select.
+6 WRITE !
DO LIST
WRITE !
+7 SET DIR(0)="Y"
SET DIR("A")="Would you like to de-select any entries"
+8 SET DIR("?")="Enter 'Y' to de-select entries, 'N' to continue, or '^' to quit."
+9 DO ^DIR
KILL DIR
IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
GOTO REVQ
+10 ;
+11 ; - allow de-selection and pull entries from the list.
+12 SET IBHIT=0
FOR
Begin DoDot:1
+13 SET DIC=$PIECE(IBINFO,";",5)
SET DIC(0)="QEAMZ"
+14 SET DIC("A")="De-select "_$SELECT(IBHIT:"Next ",1:"")_$PIECE(IBINFO,";",4)_": "
+15 if $PIECE(IBINFO,";",6)]""
SET DIC("S")=$PIECE(IBINFO,";",6)
+16 DO ^DIC
KILL DIC
if Y<0
QUIT
SET IBHIT=1
+17 IF '$DATA(^TMP("IBEPTC",$JOB,+Y))
WRITE !,"Please note that ",Y(0,0)," is not currently selected."
+18 IF '$TEST
KILL ^TMP("IBEPTC",$JOB,+Y)
SET IBNUM=IBNUM-1
End DoDot:1
if Y<0
QUIT
+19 WRITE !!,"You have selected a total of ",IBNUM," ",$PIECE(IBINFO,";",$SELECT(IBNUM=1:7,1:3)),"."
REVQ if $DATA(DIRUT)!($DATA(DUOUT))
SET IBQ=1
+1 QUIT
+2 ;
FILE ; File all selected entries.
+1 NEW IBI,IBIN,IBALR
+2 SET IBI=0
FOR
SET IBI=$ORDER(^TMP("IBEPTC",$JOB,IBI))
if 'IBI
QUIT
SET IBIN=^(IBI)
Begin DoDot:1
+3 KILL DD,DO,DIC,DR
+4 SET DIC=$PIECE(IBINFO,";",8)
SET DIC(0)=""
SET X=IBI
SET DLAYGO=$PIECE(IBINFO,";",9)
+5 ;
+6 ; - has this entry already been filed for this date?
+7 SET IBALR=$ORDER(@(DIC_"""AIVDTT2"","_IBI_","_-IBDAT_",0)"))
+8 ;
+9 ; - add new entry if not yet on file for the specified date
+10 IF 'IBALR
DO FILE^DICN
IF Y<0
WRITE !,"Unable to file ",IBIN,"..",!
QUIT
+11 SET DIE=$PIECE(IBINFO,";",8)
SET DA=$SELECT(IBALR:IBALR,1:+Y)
SET DR=".02////"_IBDAT_";.04////2;.05////"_IBFILE_";.06////"_IBTPAB
+12 DO ^DIE
KILL DA,DR,DIE
WRITE "."
End DoDot:1
+13 WRITE " done!"
+14 QUIT
+15 ;
LIST ; List all selected entries.
+1 WRITE !
SET I=0
FOR
SET I=$ORDER(^TMP("IBEPTC",$JOB,I))
if 'I
QUIT
if $X>40
WRITE !
if $X>2
WRITE ?40
WRITE ^(I)
+2 QUIT
+3 ;
HACT ; Help for the Billing action prompt.
+1 WRITE !!,"For Third Party Billing, please enter:"
+2 WRITE !," 'Y' to flag ",$SELECT(IBNUM=1:"this",1:"these")," ",$PIECE(IBINFO,";",$SELECT(IBNUM=1:7,1:3))," as non-billable."
+3 WRITE !," 'N' to flag ",$SELECT(IBNUM=1:"this",1:"these")," ",$PIECE(IBINFO,";",$SELECT(IBNUM=1:7,1:3))," as billable."
+4 WRITE !," '^' to quit this option."
+5 QUIT
+6 ;
HAUTO ; Help for the Auto Biller action prompt.
+1 WRITE !!,"For the Third Party Auto Biller, please enter:"
+2 WRITE !," 'Y' if bills should be created for ",$SELECT(IBNUM=1:"this",1:"these")," billable ",$PIECE(IBINFO,";",$SELECT(IBNUM=1:7,1:3))
+3 WRITE !," 'N' if bills should NOT be created for ",$SELECT(IBNUM=1:"this",1:"these")," billable ",$PIECE(IBINFO,";",$SELECT(IBNUM=1:7,1:3))
+4 WRITE !," '^' to quit this option."
+5 QUIT
+6 ;
HSEL ; Help for the Billing characteristic prompt.
+1 WRITE !!,"For Third Party Billing, please enter:"
+2 WRITE !," 'S' to flag some Stop Codes as (non) billable or (not) auto billed"
+3 WRITE !," 'C' to flag some Clinics as (non) billable or (not) auto billed"
+4 WRITE !," 'A' to flag ALL Clinics for the auto biller"
+5 WRITE !," '^' to quit this option."
+6 QUIT
+7 ;
HREV ; Help for the Request to Review prompt.
+1 WRITE !!,"Enter 'Y' to review the selections, 'N' to continue, or '^' to quit."
+2 WRITE !,"Please note that, if you choose to review the selections, you will have"
+3 WRITE !,"the opportunity to de-select incorrect entries from the list."
+4 QUIT
