IBRREL ;ALB/CPM - RELEASE MEANS TEST CHARGES 'ON HOLD' ; 03-MAR-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; Entry point for stand-alone 'release' option
I '$D(^IB("AH")) W !!,"There are no patients with charges 'on hold' at this time.",! Q
;
D HOME^%ZIS
W !!,"This option is used to release Means Test/Category C charges which have been"
W !,"placed 'on hold.' Please enter a patient with charges 'on hold,' and these"
W !,"charges will be displayed and may be selected to be released to Accounts",!,"Receivable.",!
;
ASK ;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBRREL" D T1^%ZOSV ;stop rt clock
;S XRTL=$ZU(0),XRTN="IBRREL-1" D T0^%ZOSV ;start rt clock
;
R !,"Select PATIENT NAME: ",X:DTIME G END:"^"[$E(X)
I $E(X,1,2)="??" D HLP1 G ASK
I $E(X)="?" D HLP G ASK
S DIC="^DPT(",DIC(0)="QME" D ^DIC K DIC G ASK:Y<1 S DFN=+Y
;
K IBA,PRCABN
S IBI=0 F IBNUM=1:1 S IBI=$O(^IB("AH",DFN,IBI)) Q:'IBI S IBA(IBNUM)=IBI
I '$D(IBA) W !!,"This patient does not have any charges 'on hold.'",! G ASK
;
S IBPT=$$PT^IBEFUNC(DFN) W @IOF,$P(IBPT,"^")," Pt ID: ",$P(IBPT,"^",2),! S I="",$P(I,"-",80)="" W I K I
;
; - display header and list charges
RESUME W !!,"The following IB Actions ",$S($D(PRCABN):"associated with this bill",1:"for this patient")," are ON HOLD:" D HDR
S IBQ=0 F IBNUM=1:1 Q:'$D(IBA(IBNUM)) D:'(IBNUM#15) Q:IBQ S IBN=IBA(IBNUM) D LST
. R !,"Enter RETURN to continue or '^' to stop: ",X:DTIME S:X["^"!('$T) IBQ=1 Q
;
; - prompt user to select IB Actions
S DIR(0)="LA^1:"_(IBNUM-1)_"^K:X[""."" X",DIR("A")="Select IB Action"_$E("s",IBNUM>2)_" (REF #) to release (or '^' to exit): ",DIR("?")="^D HELP^IBRREL"
W ! D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) G END:$D(PRCABN) D END W ! G ASK
;
S IBRANGE=Y,IBSEQNO=1,IBDUZ=DUZ
;
S DIR(0)="Y",DIR("A")="OK to pass "_$S($P(Y,",",2):"these charges",1:"this charge")_" to Accounts Receivable"
D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G END:$D(PRCABN) D END W ! G ASK
;
; - pass charges to Accounts Receivable
W !!,"Passing charges to Accounts Receivable...",! D HDR
F IBCTR=1:1 S IBNUM=$P(IBRANGE,",",IBCTR) Q:'IBNUM I $D(IBA(IBNUM)) S IBNOS=IBA(IBNUM) D ^IBR,ERR:Y<1 I Y>0 S IBN=IBA(IBNUM) D LST
W !!,"The charge"_$E("s",$P(IBRANGE,",",2)>0)_" listed above "_$S($P(IBRANGE,",",2):"have",1:"has")_" been passed to Accounts Receivable.",!
;
I '$D(PRCABN) W !! S DIR(0)="E" D ^DIR K DIR D END W ! G ASK
;
END K DIC,DIRUT,DUOUT,DTOUT,IBA,IBAFY,IBARTYP,IBATYP,IBCTR,IBN,IBDA,IBDUZ
K IBFAC,IBI,IBIL,IBRANGE,IBNOS,IBNUM,IBPT,IBQ,IBSEQNO,IBSERV,IBSITE
K IBTOTL,IBTRAN,IBWHER,VA,VAERR,VADM
K:'$D(PRCABN) DFN
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBRREL" D T1^%ZOSV ;stop rt clock
Q
;
;
HDR ; Display charge header.
N IBLINE S $P(IBLINE,"=",81)=""
W !,IBLINE,!," REF Action ID Bill Type",?42,"Bill #",?53,"From",?64,"To",?73,"Charge"
W !,IBLINE Q
;
LST ; Display individual IB Action.
N IBND S IBND=$G(^IB(IBN,0))
W !?1,$J(IBNUM,2),?7,$J(+IBND,9),?18,$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",8)
W ?42,$P($P(IBND,"^",11),"-",2),?51,$$DAT1^IBOUTL($P(IBND,"^",14)),?61,$$DAT1^IBOUTL($P(IBND,"^",15))
W ?70,$J(+$P(IBND,"^",7),9,2)
Q
;
ERR ; Display error message.
W !?1,$J(IBNUM,2),?7,"Error encountered - a separate bulletin has been posted"
Q
;
HLP ; Display basic help message.
W !!,"Enter: the name of a patient with charges 'on hold,' or"
W !?10,"'??' -- to see all patients with charges 'on hold,' or"
W !?10,"'^' -- to quit this option.",!
Q
;
HLP1 ; Display all patients with charges 'on hold.'
N DFN,I,IBQ,PID
W !!,"The following patients have charges 'on hold:'"
S (DFN,IBQ)=0 F I=1:1 S DFN=$O(^IB("AH",DFN)) Q:'DFN D:'(I#15) Q:IBQ S PID=$$PT^IBEFUNC(DFN) W !?3,$P(PID,"^"),$J("",10),$P(PID,"^",2)
. R !,"Enter RETURN to continue or '^' to stop: ",X:DTIME S:X["^"!('$T) IBQ=1 Q
W ! Q
;
HELP ; Help for the 'Select' prompt.
W !!?4,"Please enter a list or range of IB Actions (i.e. 1,3,5 or 2-4,8), none"
W !?4,"greater than ",IBNUM-1,", to be passed to Accounts Receivable, or '^' to quit."
Q
;
;
AR ; Accounts Receivable entry point to release charges.
; Input: PRCABN -- ien of Bill/Accounts Receivable
Q:$D(PRCABN)[0 Q:'$$IB^IBRUTL(PRCABN,1) G RESUME
IBRREL ;ALB/CPM - RELEASE MEANS TEST CHARGES 'ON HOLD' ; 03-MAR-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; Entry point for stand-alone 'release' option
+1 IF '$DATA(^IB("AH"))
WRITE !!,"There are no patients with charges 'on hold' at this time.",!
QUIT
+2 ;
+3 DO HOME^%ZIS
+4 WRITE !!,"This option is used to release Means Test/Category C charges which have been"
+5 WRITE !,"placed 'on hold.' Please enter a patient with charges 'on hold,' and these"
+6 WRITE !,"charges will be displayed and may be selected to be released to Accounts",!,"Receivable.",!
+7 ;
ASK ;
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBRREL" D T1^%ZOSV ;stop rt clock
+3 ;S XRTL=$ZU(0),XRTN="IBRREL-1" D T0^%ZOSV ;start rt clock
+4 ;
+5 READ !,"Select PATIENT NAME: ",X:DTIME
IF "^"[$EXTRACT(X)
GOTO END
+6 IF $EXTRACT(X,1,2)="??"
DO HLP1
GOTO ASK
+7 IF $EXTRACT(X)="?"
DO HLP
GOTO ASK
+8 SET DIC="^DPT("
SET DIC(0)="QME"
DO ^DIC
KILL DIC
IF Y<1
GOTO ASK
SET DFN=+Y
+9 ;
+10 KILL IBA,PRCABN
+11 SET IBI=0
FOR IBNUM=1:1
SET IBI=$ORDER(^IB("AH",DFN,IBI))
IF 'IBI
QUIT
SET IBA(IBNUM)=IBI
+12 IF '$DATA(IBA)
WRITE !!,"This patient does not have any charges 'on hold.'",!
GOTO ASK
+13 ;
+14 SET IBPT=$$PT^IBEFUNC(DFN)
WRITE @IOF,$PIECE(IBPT,"^")," Pt ID: ",$PIECE(IBPT,"^",2),!
SET I=""
SET $PIECE(I,"-",80)=""
WRITE I
KILL I
+15 ;
+16 ; - display header and list charges
RESUME WRITE !!,"The following IB Actions ",$SELECT($DATA(PRCABN):"associated with this bill",1:"for this patient")," are ON HOLD:"
DO HDR
+1 SET IBQ=0
FOR IBNUM=1:1
IF '$DATA(IBA(IBNUM))
QUIT
IF '(IBNUM#15)
Begin DoDot:1
+2 READ !,"Enter RETURN to continue or '^' to stop: ",X:DTIME
IF X["^"!('$TEST)
SET IBQ=1
QUIT
End DoDot:1
IF IBQ
QUIT
SET IBN=IBA(IBNUM)
DO LST
+3 ;
+4 ; - prompt user to select IB Actions
+5 SET DIR(0)="LA^1:"_(IBNUM-1)_"^K:X[""."" X"
SET DIR("A")="Select IB Action"_$EXTRACT("s",IBNUM>2)_" (REF #) to release (or '^' to exit): "
SET DIR("?")="^D HELP^IBRREL"
+6 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
IF $DATA(PRCABN)
GOTO END
DO END
WRITE !
GOTO ASK
+7 ;
+8 SET IBRANGE=Y
SET IBSEQNO=1
SET IBDUZ=DUZ
+9 ;
+10 SET DIR(0)="Y"
SET DIR("A")="OK to pass "_$SELECT($PIECE(Y,",",2):"these charges",1:"this charge")_" to Accounts Receivable"
+11 DO ^DIR
KILL DIR
IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
IF $DATA(PRCABN)
GOTO END
DO END
WRITE !
GOTO ASK
+12 ;
+13 ; - pass charges to Accounts Receivable
+14 WRITE !!,"Passing charges to Accounts Receivable...",!
DO HDR
+15 FOR IBCTR=1:1
SET IBNUM=$PIECE(IBRANGE,",",IBCTR)
IF 'IBNUM
QUIT
IF $DATA(IBA(IBNUM))
SET IBNOS=IBA(IBNUM)
DO ^IBR
IF Y<1
DO ERR
IF Y>0
SET IBN=IBA(IBNUM)
DO LST
+16 WRITE !!,"The charge"_$EXTRACT("s",$PIECE(IBRANGE,",",2)>0)_" listed above "_$SELECT($PIECE(IBRANGE,",",2):"have",1:"has")_" been passed to Accounts Receivable.",!
+17 ;
+18 IF '$DATA(PRCABN)
WRITE !!
SET DIR(0)="E"
DO ^DIR
KILL DIR
DO END
WRITE !
GOTO ASK
+19 ;
END KILL DIC,DIRUT,DUOUT,DTOUT,IBA,IBAFY,IBARTYP,IBATYP,IBCTR,IBN,IBDA,IBDUZ
+1 KILL IBFAC,IBI,IBIL,IBRANGE,IBNOS,IBNUM,IBPT,IBQ,IBSEQNO,IBSERV,IBSITE
+2 KILL IBTOTL,IBTRAN,IBWHER,VA,VAERR,VADM
+3 IF '$DATA(PRCABN)
KILL DFN
+4 ;***
+5 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBRREL" D T1^%ZOSV ;stop rt clock
+6 QUIT
+7 ;
+8 ;
HDR ; Display charge header.
+1 NEW IBLINE
SET $PIECE(IBLINE,"=",81)=""
+2 WRITE !,IBLINE,!," REF Action ID Bill Type",?42,"Bill #",?53,"From",?64,"To",?73,"Charge"
+3 WRITE !,IBLINE
QUIT
+4 ;
LST ; Display individual IB Action.
+1 NEW IBND
SET IBND=$GET(^IB(IBN,0))
+2 WRITE !?1,$JUSTIFY(IBNUM,2),?7,$JUSTIFY(+IBND,9),?18,$PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^",8)
+3 WRITE ?42,$PIECE($PIECE(IBND,"^",11),"-",2),?51,$$DAT1^IBOUTL($PIECE(IBND,"^",14)),?61,$$DAT1^IBOUTL($PIECE(IBND,"^",15))
+4 WRITE ?70,$JUSTIFY(+$PIECE(IBND,"^",7),9,2)
+5 QUIT
+6 ;
ERR ; Display error message.
+1 WRITE !?1,$JUSTIFY(IBNUM,2),?7,"Error encountered - a separate bulletin has been posted"
+2 QUIT
+3 ;
HLP ; Display basic help message.
+1 WRITE !!,"Enter: the name of a patient with charges 'on hold,' or"
+2 WRITE !?10,"'??' -- to see all patients with charges 'on hold,' or"
+3 WRITE !?10,"'^' -- to quit this option.",!
+4 QUIT
+5 ;
HLP1 ; Display all patients with charges 'on hold.'
+1 NEW DFN,I,IBQ,PID
+2 WRITE !!,"The following patients have charges 'on hold:'"
+3 SET (DFN,IBQ)=0
FOR I=1:1
SET DFN=$ORDER(^IB("AH",DFN))
IF 'DFN
QUIT
IF '(I#15)
Begin DoDot:1
+4 READ !,"Enter RETURN to continue or '^' to stop: ",X:DTIME
IF X["^"!('$TEST)
SET IBQ=1
QUIT
End DoDot:1
IF IBQ
QUIT
SET PID=$$PT^IBEFUNC(DFN)
WRITE !?3,$PIECE(PID,"^"),$JUSTIFY("",10),$PIECE(PID,"^",2)
+5 WRITE !
QUIT
+6 ;
HELP ; Help for the 'Select' prompt.
+1 WRITE !!?4,"Please enter a list or range of IB Actions (i.e. 1,3,5 or 2-4,8), none"
+2 WRITE !?4,"greater than ",IBNUM-1,", to be passed to Accounts Receivable, or '^' to quit."
+3 QUIT
+4 ;
+5 ;
AR ; Accounts Receivable entry point to release charges.
+1 ; Input: PRCABN -- ien of Bill/Accounts Receivable
+2 IF $DATA(PRCABN)[0
QUIT
IF '$$IB^IBRUTL(PRCABN,1)
QUIT
GOTO RESUME
