Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBRCON1

IBRCON1.m

Go to the documentation of this file. 
  1. IBRCON1	;ALB/RJS - PASS CONVERTED INPATIENT CHARGES ; 28-APR-92
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. 	;
  1. 	;Selection is by patient name
  1. 	;
  1. EN	; Entry point for stand-alone 'pass' option
  1. 	I '$D(^IB("AI")) W !!,"There are no patients with converted charges at this time.",! Q
  1. 	;
  1. 	D HOME^%ZIS
  1. 	W !!,"This option is used to pass Means Test/Category C charges which have been"
  1. 	W !,"converted. Please enter a patient with converted charges and these"
  1. 	W !,"charges will be displayed and may be selected to be released to Accounts",!,"Receivable.",!
  1. 	;
  1. ASK	S IBRHOLD=0
  1. 	R !!,"Select PATIENT NAME: ",X:DTIME G END:"^"[X
  1. 	I $E(X,1,2)="??" D HLP1 G ASK
  1. 	I $E(X)="?" D HLP G ASK
  1. 	S DIC("S")="I $D(^IB(""AI"",+Y))"
  1. 	S DIC="^DPT(",DIC(0)="MQE" D ^DIC K DIC G ASK:Y<1 S DFN=+Y
  1. 	;
  1. 	K IBA
  1. 	S IBRRJS=0 F IBNUM=1:1 S IBRRJS=$O(^IB("AI",DFN,IBRRJS)) Q:'IBRRJS  S IBA(IBNUM)=IBRRJS
  1. 	I '$D(IBA) W !!,"This patient does not have any converted charges",! G ASK
  1. 	;
  1. 	D DEM^VADPT W @IOF,VADM(1),"      Pt ID: ",VA("PID"),! F I=1:1:79 W "-"
  1. 	;
  1. 	; - display header and list charges
  1. RESUME	W !!,"The following IB Actions for this patient, are CONVERTED CHARGES:" D HDR1
  1. 	S IBQ=0 F IBNUM=1:1 Q:'$D(IBA(IBNUM))  D:'(IBNUM#15)  Q:IBQ  S IBN=IBA(IBNUM) D LST1
  1. 	. R !,"Enter RETURN to continue or '^' to stop: ",X:DTIME S:X["^"!('$T) IBQ=1 Q
  1. 	;
  1. 	; - prompt user to select IB Actions
  1. 	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"
  1. 	W ! D ^DIR K DIR I $D(DUOUT) G END
  1. 	I $D(DIRUT) G LOOP
  1. 	;
  1. 	S IBRANGE=Y,IBSEQNO=1,IBDUZ=DUZ
  1. 	;
  1. 	S DIR("B")="YES"
  1. 	S DIR(0)="YOA",DIR("A")="OK to pass "_$S($P(Y,",",2):"these charges",1:"this charge")_" to Accounts Receivable: "
  1. 	D ^DIR K DIR I $D(DUOUT) G END
  1. 	I 'Y!($D(DIRUT)) G LOOP
  1. 	;
  1. 	; - pass charges to Accounts Receivable
  1. 	W !!,"Passing charges to Accounts Receivable...",! D HDR2
  1. 	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
  1. 	W !!,"The charge"_$E("s",$P(IBRANGE,",",2)>0)_" listed above "_$S($P(IBRANGE,",",2):"have",1:"has")_" been passed to Accounts Receivable",!
  1. 	W:IBRHOLD=1 !,"* Please note that charges placed 'On Hold' are still",!,"  pending release from Integrated Billing."
  1. 	;
  1. LOOP	;
  1. 	G ASK
  1. 	;
  1. 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
  1. 	K DFN,DIC,DIR,I,IBA,IBLINE,IBND,IBRRJS,VA,VADM,X,Y,IBRHOLD
  1. 	Q
  1. 	;
  1. 	;
  1. HDR1	; Display charge header.
  1. 	N IBLINE S $P(IBLINE,"=",81)=""
  1. 	W !,IBLINE,!," REF   Action ID  Bill Type",?44,"From",?54,"To",?64,"Charge"
  1. 	W !,IBLINE Q
  1. 	;
  1. HDR2	; Display charge header.
  1. 	N IBLINE S $P(IBLINE,"=",81)=""
  1. 	W !,IBLINE,!,?42,"Bill # or"
  1. 	W !," REF   Action ID  Bill Type",?42,"On Hold",?53,"From",?64,"To",?73,"Charge"
  1. 	W !,IBLINE Q
  1. 	;
  1. LST1	; Display individual IB Action.
  1. 	N IBND S IBND=$G(^IB(IBN,0))
  1. 	W !?1,$J(IBNUM,2),?7,$J(+IBND,9),?18,$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",8)
  1. 	W ?42,$$DAT1^IBOUTL($P(IBND,"^",14)),?52,$$DAT1^IBOUTL($P(IBND,"^",15))
  1. 	W ?61,$J(+$P(IBND,"^",7),9,2)
  1. 	Q
  1. 	;
  1. LST2	; Display individual IB Action.
  1. 	N IBND S IBND=$G(^IB(IBN,0))
  1. 	W !?1,$J(IBNUM,2),?7,$J(+IBND,9),?18,$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",8)
  1. 	I $P(IBND,U,5)=8 W ?42,"On Hold" S IBRHOLD=1
  1. 	E  W ?42,$P($P(IBND,"^",11),"-",2)
  1. 	W ?51,$$DAT1^IBOUTL($P(IBND,"^",14)),?61,$$DAT1^IBOUTL($P(IBND,"^",15))
  1. 	W ?70,$J(+$P(IBND,"^",7),9,2)
  1. 	Q
  1. 	;
  1. ERR	; Display error message.
  1. 	W !?1,$J(IBNUM,2),?7,"Error encountered - a separate bulletin has been posted"
  1. 	Q
  1. 	;
  1. HLP	; Display basic help message.
  1. 	W !!,"Enter:    the name of a patient with converted charges or"
  1. 	W !?10,"'??' --  to see all patients with converted charges or"
  1. 	W !?10,"'^'  --  to quit this option.",!
  1. 	Q
  1. 	;
  1. HLP1	; Display all patients with converted charges
  1. 	N DFN,I,IBQ,VA,VAERR
  1. 	W !!,"The following patients have converted charges"
  1. 	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")
  1. 	. R !,"Enter RETURN to continue or '^' to stop: ",X:DTIME S:X["^"!('$T) IBQ=1 Q
  1. 	W ! Q
  1. 	;
  1. HELP	; Help for the 'Select' prompt.
  1. 	W !!?4,"Please enter a list or range of IB Actions (i.e. 1,3,5 or 2-4,8), none"
  1. 	W !?4,"greater than ",IBNUM-1,", to be passed to Accounts Receivable, or '^' to quit."
  1. 	Q