IBCNQ ;ALB/MJB - MCCR PATIENT BILLING INQUIRY ;13 JUN 88 13:52
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;MAP TO DGCRNQ
;
D HOME^%ZIS
ASKPAT S DIC="^DGCR(399,",DIC(0)="AEMQZ",DIC("A")="Enter BILL NUMBER or PATIENT NAME: " W !! D ^DIC G:X=""!(X["^") Q
;
S IBIFN=+Y,IBQUIT=0,IBAC=7
VIEW ;
;***
;S XRTL=$ZU(0),XRTN="IBCNQ-2" D T0^%ZOSV ;start rt clock
F I=0,"S","U","U1" S IB(I)=$G(^DGCR(399,IBIFN,I))
S DFN=$P(IB(0),"^",2),IBSTAT=$P(IB(0),"^",13),IBBNO=$$BN^PRCAFN(IBIFN),IBPAGE=0 S:IBBNO=-1 IBBNO=$S($D(IBIL):IBIL,1:$P(IB(0),"^"))
;
D NOW^%DTC S Y=$E(%,1,12) D D^DIQ S IBNOW=Y,IBPT=$$PT^IBEFUNC(DFN) D HDR1
;
S IBUN="UNSPECIFIED",IBUK="UNKNOWN USER"
W !,"Bill Status",?15,": ",$S(IBSTAT=1:"ENTERED/NOT REVIEWED",IBSTAT=2:"REVIEWED",IBSTAT=3:"AUTHORIZED",IBSTAT=4:"PRINTED",IBSTAT=7:"CANCELLED",1:IBUN)," - RECORD IS ",$S(IBSTAT<3:"",1:"UN"),"EDITABLE"
W !,"Rate Type",?15,": ",$S($P(IB(0),"^",7)="":IBUN,'$D(^DGCR(399.3,$P(IB(0),"^",7),0)):IBUN,1:$P(^DGCR(399.3,$P(IB(0),"^",7),0),"^"))
W:+$P(^IBE(350.9,1,1),"^",22) !,"Form Type",?15,": ",$S($P($G(^IBE(353,+$P(IB(0),"^",19),0)),"^")]"":$P(^(0),"^"),1:IBUN)
W:IBSTAT=7 !,"Reason Canceled",?15,": ",$S($P(IB("S"),"^",19)]"":$P(IB("S"),"^",19),1:IBUN)
I $P(IB(0),"^",5)<3 S Y=$P(IB(0),"^",3) D D^DIQ W !!,"Admission Date : ",Y
E D OPDATE
W !!,"Charges",?15,": " S X=$P(IB("U1"),U,1),X2="2$" D:X]"" COMMA^%DTC W $S(X]"":X,1:IBUN)
I $P(IB("U1"),U,2)]"" W !,"LESS Offset",?15,": " S X=$P(IB("U1"),U,2),X2="2$" D COMMA^%DTC W X," [",$P(IB("U1"),U,3),"]",!,"Bill Total",?15,": " S X=($P(IB("U1"),U,1)-$P(IB("U1"),U,2)),X2="2$" D COMMA^%DTC W X
S X=$$TPR^PRCAFN(IBIFN) I X>0 S X2="2$" D COMMA^%DTC W !,"Amount Paid",?15,": ",X
S X=$$STA^PRCAFN(IBIFN) I X>0 W !,"AR Status",?15,": ",$P(X,"^",2)
I $P(IB("U"),U)]"" S Y=$P(IB("U"),U) D D^DIQ W !!,"Statement From",?15,": ",Y S Y=$P(IB("U"),"^",2) D D^DIQ W !,"Statement To",?15,": ",Y,!
I $P(IB("U"),U)']"" W !!,"Statement From",?15,": ",IBUN,!,"Statement To",?15,": ",IBUN,!
D DISP I IBQUIT Q:IBAC[8 G Q
I IBSTAT<5 D NOPTF^IBCB2 I 'IBAC1 D:$Y>(IOSL-6) HDR Q:IBQUIT&(IBAC[8) G Q:IBQUIT D NOPTF1^IBCB2
D PAUSE,^IBOLK1:$G(IBFULL)&('IBQUIT) Q:IBAC[8 ; Called from Outpatient Visit Date Inquiry
G Q:IBQUIT,ASKPAT
;
DISP ; The variable IBAC must be defined as input to this sub-routine.
S IBUN="UNSPECIFIED",IBUK="UNKNOWN USER"
I IB("S")']"" W !,"Past actions of this billing record unspecified." G DISPQ
S IBX="Entered^^^First Reviewed^^^Last Reviewed^^^Authorized^^^^Last Printed^^^Cancelled"
F I=1,4,7,10,14,17 I $P(IB("S"),U,I)]"" D:IBAC[7&($Y>(IOSL-4)) HDR Q:$S(IBAC'[7:0,1:IBQUIT) D DISP1
I $D(^DGCR(399,IBIFN,"R","AC",1)) S IB=0 F I=0:0 S IB=$O(^DGCR(399,IBIFN,"R","AC",1,IB)) Q:'IB D:IBAC[7&($Y>(IOSL-4)) HDR Q:$S(IBAC'[7:0,1:IBQUIT) W !,"Returned to AR : " D RETN
DISPQ Q
;
DISP1 W !,$P(IBX,U,I) S Y=$P(IB("S"),U,I) D D^DIQ W ?15,": ",Y,?28," by " S IBN=$P(IB("S"),U,(I+1)) W $S(IBN']"":IBUK,$D(^VA(200,IBN,0)):$P(^(0),U,1),1:IBUK)
Q
;
Q K DFN,IB,IBAC,IBBNO,IBN,IBNOW,IBPAGE,IBPT,IBU,IBQUIT,IBUK,IBUN,IBX,IBSTAT,IBAC1,IBIFN,IBOPD,DIC,X,X2,Y
Q
;
RETN I $D(^DGCR(399,IBIFN,"R",IB,0)) S IBN=^(0),Y=$P($P(IBN,"^"),".") D D^DIQ W Y,?28," by " S IBN=$P(IBN,"^",2) I IBN]"",$D(^VA(200,IBN,0)) W $P(^VA(200,IBN,0),"^")
Q
;
HDR D PAUSE Q:IBQUIT
HDR1 S L="",$P(L,"=",80)="",IBPAGE=IBPAGE+1
W:$E(IOST,1,2)["C-"!(IBPAGE>1) @IOF
W $E($P(IBPT,"^"),1,20)," ",$P(IBPT,"^",2),?38,IBBNO,?51,IBNOW,?72,"PAGE: ",IBPAGE,!,L
K L Q
;
OPDATE ; List Outpatient Visit Dates.
Q:'$O(^DGCR(399,IBIFN,"OP",0))
W !!,"OP Visit Dates :" S IBOPD=0
F I=1:1 S IBOPD=$O(^DGCR(399,IBIFN,"OP",IBOPD)) Q:'IBOPD D
. W:'((I-1)#4)&(I>1) !
. S Y=IBOPD D D^DIQ W ?($S(I#4:I#4,1:4)*14+3),Y
Q
;
PAUSE Q:$E(IOST,1,2)'="C-"
F I=$Y:1:(IOSL-3) W !
S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT
Q
IBCNQ ;ALB/MJB - MCCR PATIENT BILLING INQUIRY ;13 JUN 88 13:52
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCRNQ
+5 ;
+6 DO HOME^%ZIS
ASKPAT SET DIC="^DGCR(399,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Enter BILL NUMBER or PATIENT NAME: "
WRITE !!
DO ^DIC
IF X=""!(X["^")
GOTO Q
+1 ;
+2 SET IBIFN=+Y
SET IBQUIT=0
SET IBAC=7
VIEW ;
+1 ;***
+2 ;S XRTL=$ZU(0),XRTN="IBCNQ-2" D T0^%ZOSV ;start rt clock
+3 FOR I=0,"S","U","U1"
SET IB(I)=$GET(^DGCR(399,IBIFN,I))
+4 SET DFN=$PIECE(IB(0),"^",2)
SET IBSTAT=$PIECE(IB(0),"^",13)
SET IBBNO=$$BN^PRCAFN(IBIFN)
SET IBPAGE=0
IF IBBNO=-1
SET IBBNO=$SELECT($DATA(IBIL):IBIL,1:$PIECE(IB(0),"^"))
+5 ;
+6 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO D^DIQ
SET IBNOW=Y
SET IBPT=$$PT^IBEFUNC(DFN)
DO HDR1
+7 ;
+8 SET IBUN="UNSPECIFIED"
SET IBUK="UNKNOWN USER"
+9 WRITE !,"Bill Status",?15,": ",$SELECT(IBSTAT=1:"ENTERED/NOT REVIEWED",IBSTAT=2:"REVIEWED",IBSTAT=3:"AUTHORIZED",IBSTAT=4:"PRINTED",IBSTAT=7:"CANCELLED",1:IBUN)," - RECORD IS ",$SELECT(IBSTAT<3:"",1:"UN"),"EDITABLE"
+10 WRITE !,"Rate Type",?15,": ",$SELECT($PIECE(IB(0),"^",7)="":IBUN,'$DATA(^DGCR(399.3,$PIECE(IB(0),"^",7),0)):IBUN,1:$PIECE(^DGCR(399.3,$PIECE(IB(0),"^",7),0),"^"))
+11 IF +$PIECE(^IBE(350.9,1,1),"^",22)
WRITE !,"Form Type",?15,": ",$SELECT($PIECE($GET(^IBE(353,+$PIECE(IB(0),"^",19),0)),"^")]"":$PIECE(^(0),"^"),1:IBUN)
+12 IF IBSTAT=7
WRITE !,"Reason Canceled",?15,": ",$SELECT($PIECE(IB("S"),"^",19)]"":$PIECE(IB("S"),"^",19),1:IBUN)
+13 IF $PIECE(IB(0),"^",5)<3
SET Y=$PIECE(IB(0),"^",3)
DO D^DIQ
WRITE !!,"Admission Date : ",Y
+14 IF '$TEST
DO OPDATE
+15 WRITE !!,"Charges",?15,": "
SET X=$PIECE(IB("U1"),U,1)
SET X2="2$"
IF X]""
DO COMMA^%DTC
WRITE $SELECT(X]"":X,1:IBUN)
+16 IF $PIECE(IB("U1"),U,2)]""
WRITE !,"LESS Offset",?15,": "
SET X=$PIECE(IB("U1"),U,2)
SET X2="2$"
DO COMMA^%DTC
WRITE X," [",$PIECE(IB("U1"),U,3),"]",!,"Bill Total",?15,": "
SET X=($PIECE(IB("U1"),U,1)-$PIECE(IB("U1"),U,2))
SET X2="2$"
DO COMMA^%DTC
WRITE X
+17 SET X=$$TPR^PRCAFN(IBIFN)
IF X>0
SET X2="2$"
DO COMMA^%DTC
WRITE !,"Amount Paid",?15,": ",X
+18 SET X=$$STA^PRCAFN(IBIFN)
IF X>0
WRITE !,"AR Status",?15,": ",$PIECE(X,"^",2)
+19 IF $PIECE(IB("U"),U)]""
SET Y=$PIECE(IB("U"),U)
DO D^DIQ
WRITE !!,"Statement From",?15,": ",Y
SET Y=$PIECE(IB("U"),"^",2)
DO D^DIQ
WRITE !,"Statement To",?15,": ",Y,!
+20 IF $PIECE(IB("U"),U)']""
WRITE !!,"Statement From",?15,": ",IBUN,!,"Statement To",?15,": ",IBUN,!
+21 DO DISP
IF IBQUIT
IF IBAC[8
QUIT
GOTO Q
+22 IF IBSTAT<5
DO NOPTF^IBCB2
IF 'IBAC1
IF $Y>(IOSL-6)
DO HDR
IF IBQUIT&(IBAC[8)
QUIT
IF IBQUIT
GOTO Q
DO NOPTF1^IBCB2
+23 ; Called from Outpatient Visit Date Inquiry
DO PAUSE
IF $GET(IBFULL)&('IBQUIT)
DO ^IBOLK1
IF IBAC[8
QUIT
+24 IF IBQUIT
GOTO Q
GOTO ASKPAT
+25 ;
DISP ; The variable IBAC must be defined as input to this sub-routine.
+1 SET IBUN="UNSPECIFIED"
SET IBUK="UNKNOWN USER"
+2 IF IB("S")']""
WRITE !,"Past actions of this billing record unspecified."
GOTO DISPQ
+3 SET IBX="Entered^^^First Reviewed^^^Last Reviewed^^^Authorized^^^^Last Printed^^^Cancelled"
+4 FOR I=1,4,7,10,14,17
IF $PIECE(IB("S"),U,I)]""
IF IBAC[7&($Y>(IOSL-4))
DO HDR
IF $SELECT(IBAC'[7
QUIT
DO DISP1
+5 IF $DATA(^DGCR(399,IBIFN,"R","AC",1))
SET IB=0
FOR I=0:0
SET IB=$ORDER(^DGCR(399,IBIFN,"R","AC",1,IB))
IF 'IB
QUIT
IF IBAC[7&($Y>(IOSL-4))
DO HDR
IF $SELECT(IBAC'[7
QUIT
WRITE !,"Returned to AR : "
DO RETN
DISPQ QUIT
+1 ;
DISP1 WRITE !,$PIECE(IBX,U,I)
SET Y=$PIECE(IB("S"),U,I)
DO D^DIQ
WRITE ?15,": ",Y,?28," by "
SET IBN=$PIECE(IB("S"),U,(I+1))
WRITE $SELECT(IBN']"":IBUK,$DATA(^VA(200,IBN,0)):$PIECE(^(0),U,1),1:IBUK)
+1 QUIT
+2 ;
Q KILL DFN,IB,IBAC,IBBNO,IBN,IBNOW,IBPAGE,IBPT,IBU,IBQUIT,IBUK,IBUN,IBX,IBSTAT,IBAC1,IBIFN,IBOPD,DIC,X,X2,Y
+1 QUIT
+2 ;
RETN IF $DATA(^DGCR(399,IBIFN,"R",IB,0))
SET IBN=^(0)
SET Y=$PIECE($PIECE(IBN,"^"),".")
DO D^DIQ
WRITE Y,?28," by "
SET IBN=$PIECE(IBN,"^",2)
IF IBN]""
IF $DATA(^VA(200,IBN,0))
WRITE $PIECE(^VA(200,IBN,0),"^")
+1 QUIT
+2 ;
HDR DO PAUSE
IF IBQUIT
QUIT
HDR1 SET L=""
SET $PIECE(L,"=",80)=""
SET IBPAGE=IBPAGE+1
+1 IF $EXTRACT(IOST,1,2)["C-"!(IBPAGE>1)
WRITE @IOF
+2 WRITE $EXTRACT($PIECE(IBPT,"^"),1,20)," ",$PIECE(IBPT,"^",2),?38,IBBNO,?51,IBNOW,?72,"PAGE: ",IBPAGE,!,L
+3 KILL L
QUIT
+4 ;
OPDATE ; List Outpatient Visit Dates.
+1 IF '$ORDER(^DGCR(399,IBIFN,"OP",0))
QUIT
+2 WRITE !!,"OP Visit Dates :"
SET IBOPD=0
+3 FOR I=1:1
SET IBOPD=$ORDER(^DGCR(399,IBIFN,"OP",IBOPD))
IF 'IBOPD
QUIT
Begin DoDot:1
+4 IF '((I-1)#4)&(I>1)
WRITE !
+5 SET Y=IBOPD
DO D^DIQ
WRITE ?($SELECT(I#4:I#4,1:4)*14+3),Y
End DoDot:1
+6 QUIT
+7 ;
PAUSE IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+1 FOR I=$Y:1:(IOSL-3)
WRITE !
+2 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBQUIT=1
KILL DIRUT,DTOUT,DUOUT
+3 QUIT
