IBRCON1 ;ALB/RJS - PASS CONVERTED INPATIENT CHARGES ; 28-APR-92
;;2.0;INTEGRATED BILLING;**153**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;Selection is by patient name
;
EN ; Entry point for stand-alone 'pass' option
I '$D(^IB("AI")) W !!,"There are no patients with converted charges at this time.",! Q
;
D HOME^%ZIS
W !!,"This option is used to pass Means Test charges which have been"
W !,"converted. Please enter a patient with converted charges and these"
W !,"charges will be displayed and may be selected to be released to Accounts",!,"Receivable.",!
;
ASK S IBRHOLD=0
R !!,"Select PATIENT NAME: ",X:DTIME G END:"^"[X
I $E(X,1,2)="??" D HLP1 G ASK
I $E(X)="?" D HLP G ASK
S DIC("S")="I $D(^IB(""AI"",+Y))"
S DIC="^DPT(",DIC(0)="MQE" D ^DIC K DIC G ASK:Y<1 S DFN=+Y
;
K IBA
S IBRRJS=0 F IBNUM=1:1 S IBRRJS=$O(^IB("AI",DFN,IBRRJS)) Q:'IBRRJS S IBA(IBNUM)=IBRRJS
I '$D(IBA) W !!,"This patient does not have any converted charges",! G ASK
;
D DEM^VADPT W @IOF,VADM(1)," Pt ID: ",VA("PID"),! F I=1:1:79 W "-"
;
; - display header and list charges
RESUME W !!,"The following IB Actions for this patient, are CONVERTED CHARGES:" D HDR1
S IBQ=0 F IBNUM=1:1 Q:'$D(IBA(IBNUM)) D:'(IBNUM#15) Q:IBQ S IBN=IBA(IBNUM) D LST1
. 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)="LAO^1:"_(IBNUM-1)_"^K:X[""."" X",DIR("A")="Select IB Action"_$E("s",IBNUM>2)_" (REF #) to pass (or '^' to exit): ",DIR("?")="^D HELP^IBRCON1"
W ! D ^DIR K DIR I $D(DUOUT) G END
I $D(DIRUT) G LOOP
;
S IBRANGE=Y,IBSEQNO=1,IBDUZ=DUZ
;
S DIR("B")="YES"
S DIR(0)="YOA",DIR("A")="OK to pass "_$S($P(Y,",",2):"these charges",1:"this charge")_" to Accounts Receivable: "
D ^DIR K DIR I $D(DUOUT) G END
I 'Y!($D(DIRUT)) G LOOP
;
; - pass charges to Accounts Receivable
W !!,"Passing charges to Accounts Receivable...",! D HDR2
F IBRRJS=1:1 S IBNUM=$P(IBRANGE,",",IBRRJS) Q:'IBNUM S IBNOS=IBA(IBNUM) D ^IBR,ERR:Y<1 I Y>0 S IBN=IBA(IBNUM) D LST2
W !!,"The charge"_$E("s",$P(IBRANGE,",",2)>0)_" listed above "_$S($P(IBRANGE,",",2):"have",1:"has")_" been passed to Accounts Receivable",!
W:IBRHOLD=1 !,"* Please note that charges placed 'On Hold' are still",!," pending release from Integrated Billing."
;
LOOP ;
G ASK
;
END K DIRUT,DUOUT,DTOUT,IBA,IBAFY,IBARTYP,IBATYP,IBN,IBDA,IBDUZ,IBFAC,IBRRJSL,IBRANGE,IBNOS,IBNUM,IBQ,IBSEQNO,IBSERV,IBSITE,IBTOTL,IBTRAN,IBWHER,VA,VADM,VAERR
K DFN,DIC,DIR,I,IBA,IBLINE,IBND,IBRRJS,VA,VADM,X,Y,IBRHOLD
Q
;
;
HDR1 ; Display charge header.
N IBLINE S $P(IBLINE,"=",81)=""
W !,IBLINE,!," REF Action ID Bill Type",?44,"From",?54,"To",?64,"Charge"
W !,IBLINE Q
;
HDR2 ; Display charge header.
N IBLINE S $P(IBLINE,"=",81)=""
W !,IBLINE,!,?42,"Bill # or"
W !," REF Action ID Bill Type",?42,"On Hold",?53,"From",?64,"To",?73,"Charge"
W !,IBLINE Q
;
LST1 ; 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,$$DAT1^IBOUTL($P(IBND,"^",14)),?52,$$DAT1^IBOUTL($P(IBND,"^",15))
W ?61,$J(+$P(IBND,"^",7),9,2)
Q
;
LST2 ; 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)
I $P(IBND,U,5)=8 W ?42,"On Hold" S IBRHOLD=1
E W ?42,$P($P(IBND,"^",11),"-",2)
W ?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 converted charges or"
W !?10,"'??' -- to see all patients with converted charges or"
W !?10,"'^' -- to quit this option.",!
Q
;
HLP1 ; Display all patients with converted charges
N DFN,I,IBQ,VA,VAERR
W !!,"The following patients have converted charges"
S (DFN,IBQ)=0 F I=1:1 S DFN=$O(^IB("AI",DFN)) Q:'DFN D:'(I#15) Q:IBQ D PID^VADPT6 W !?3,$P($G(^DPT(DFN,0)),"^"),$J("",10),VA("PID")
. 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRCON1 4527 printed Nov 22, 2024@17:36:45 Page 2
IBRCON1 ;ALB/RJS - PASS CONVERTED INPATIENT CHARGES ; 28-APR-92
+1 ;;2.0;INTEGRATED BILLING;**153**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;Selection is by patient name
+5 ;
EN ; Entry point for stand-alone 'pass' option
+1 IF '$DATA(^IB("AI"))
WRITE !!,"There are no patients with converted charges at this time.",!
QUIT
+2 ;
+3 DO HOME^%ZIS
+4 WRITE !!,"This option is used to pass Means Test charges which have been"
+5 WRITE !,"converted. Please enter a patient with converted charges and these"
+6 WRITE !,"charges will be displayed and may be selected to be released to Accounts",!,"Receivable.",!
+7 ;
ASK SET IBRHOLD=0
+1 READ !!,"Select PATIENT NAME: ",X:DTIME
if "^"[X
GOTO END
+2 IF $EXTRACT(X,1,2)="??"
DO HLP1
GOTO ASK
+3 IF $EXTRACT(X)="?"
DO HLP
GOTO ASK
+4 SET DIC("S")="I $D(^IB(""AI"",+Y))"
+5 SET DIC="^DPT("
SET DIC(0)="MQE"
DO ^DIC
KILL DIC
if Y<1
GOTO ASK
SET DFN=+Y
+6 ;
+7 KILL IBA
+8 SET IBRRJS=0
FOR IBNUM=1:1
SET IBRRJS=$ORDER(^IB("AI",DFN,IBRRJS))
if 'IBRRJS
QUIT
SET IBA(IBNUM)=IBRRJS
+9 IF '$DATA(IBA)
WRITE !!,"This patient does not have any converted charges",!
GOTO ASK
+10 ;
+11 DO DEM^VADPT
WRITE @IOF,VADM(1)," Pt ID: ",VA("PID"),!
FOR I=1:1:79
WRITE "-"
+12 ;
+13 ; - display header and list charges
RESUME WRITE !!,"The following IB Actions for this patient, are CONVERTED CHARGES:"
DO HDR1
+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 LST1
+3 ;
+4 ; - prompt user to select IB Actions
+5 SET DIR(0)="LAO^1:"_(IBNUM-1)_"^K:X[""."" X"
SET DIR("A")="Select IB Action"_$EXTRACT("s",IBNUM>2)_" (REF #) to pass (or '^' to exit): "
SET DIR("?")="^D HELP^IBRCON1"
+6 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
GOTO END
+7 IF $DATA(DIRUT)
GOTO LOOP
+8 ;
+9 SET IBRANGE=Y
SET IBSEQNO=1
SET IBDUZ=DUZ
+10 ;
+11 SET DIR("B")="YES"
+12 SET DIR(0)="YOA"
SET DIR("A")="OK to pass "_$SELECT($PIECE(Y,",",2):"these charges",1:"this charge")_" to Accounts Receivable: "
+13 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
GOTO END
+14 IF 'Y!($DATA(DIRUT))
GOTO LOOP
+15 ;
+16 ; - pass charges to Accounts Receivable
+17 WRITE !!,"Passing charges to Accounts Receivable...",!
DO HDR2
+18 FOR IBRRJS=1:1
SET IBNUM=$PIECE(IBRANGE,",",IBRRJS)
if 'IBNUM
QUIT
SET IBNOS=IBA(IBNUM)
DO ^IBR
if Y<1
DO ERR
IF Y>0
SET IBN=IBA(IBNUM)
DO LST2
+19 WRITE !!,"The charge"_$EXTRACT("s",$PIECE(IBRANGE,",",2)>0)_" listed above "_$SELECT($PIECE(IBRANGE,",",2):"have",1:"has")_" been passed to Accounts Receivable",!
+20 if IBRHOLD=1
WRITE !,"* Please note that charges placed 'On Hold' are still",!," pending release from Integrated Billing."
+21 ;
LOOP ;
+1 GOTO ASK
+2 ;
END KILL DIRUT,DUOUT,DTOUT,IBA,IBAFY,IBARTYP,IBATYP,IBN,IBDA,IBDUZ,IBFAC,IBRRJSL,IBRANGE,IBNOS,IBNUM,IBQ,IBSEQNO,IBSERV,IBSITE,IBTOTL,IBTRAN,IBWHER,VA,VADM,VAERR
+1 KILL DFN,DIC,DIR,I,IBA,IBLINE,IBND,IBRRJS,VA,VADM,X,Y,IBRHOLD
+2 QUIT
+3 ;
+4 ;
HDR1 ; Display charge header.
+1 NEW IBLINE
SET $PIECE(IBLINE,"=",81)=""
+2 WRITE !,IBLINE,!," REF Action ID Bill Type",?44,"From",?54,"To",?64,"Charge"
+3 WRITE !,IBLINE
QUIT
+4 ;
HDR2 ; Display charge header.
+1 NEW IBLINE
SET $PIECE(IBLINE,"=",81)=""
+2 WRITE !,IBLINE,!,?42,"Bill # or"
+3 WRITE !," REF Action ID Bill Type",?42,"On Hold",?53,"From",?64,"To",?73,"Charge"
+4 WRITE !,IBLINE
QUIT
+5 ;
LST1 ; 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,$$DAT1^IBOUTL($PIECE(IBND,"^",14)),?52,$$DAT1^IBOUTL($PIECE(IBND,"^",15))
+4 WRITE ?61,$JUSTIFY(+$PIECE(IBND,"^",7),9,2)
+5 QUIT
+6 ;
LST2 ; 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 IF $PIECE(IBND,U,5)=8
WRITE ?42,"On Hold"
SET IBRHOLD=1
+4 IF '$TEST
WRITE ?42,$PIECE($PIECE(IBND,"^",11),"-",2)
+5 WRITE ?51,$$DAT1^IBOUTL($PIECE(IBND,"^",14)),?61,$$DAT1^IBOUTL($PIECE(IBND,"^",15))
+6 WRITE ?70,$JUSTIFY(+$PIECE(IBND,"^",7),9,2)
+7 QUIT
+8 ;
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 converted charges or"
+2 WRITE !?10,"'??' -- to see all patients with converted charges or"
+3 WRITE !?10,"'^' -- to quit this option.",!
+4 QUIT
+5 ;
HLP1 ; Display all patients with converted charges
+1 NEW DFN,I,IBQ,VA,VAERR
+2 WRITE !!,"The following patients have converted charges"
+3 SET (DFN,IBQ)=0
FOR I=1:1
SET DFN=$ORDER(^IB("AI",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
DO PID^VADPT6
WRITE !?3,$PIECE($GET(^DPT(DFN,0)),"^"),$JUSTIFY("",10),VA("PID")
+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
