- IBCNQ ;ALB/MJB - MCCR PATIENT BILLING INQUIRY ;13 JUN 88 13:52
- ;;2.0;INTEGRATED BILLING;**51,320,377,433**;21-MAR-94;Build 36
- ;;Per VHA Directive 2004-038, 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 ;
- ;***
- 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:"MRA REQUESTED",IBSTAT=3:"AUTHORIZED",IBSTAT=4:"PRINTED/TRANSMITTED",IBSTAT=7:"CANCELLED",1:IBUN)," - RECORD IS ",$S(IBSTAT=1:"",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 $$INPAT^IBCEF(IBIFN) 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.
- G:'$D(IBAC) DISPQ
- S IBUN="UNSPECIFIED",IBUK="UNKNOWN USER"
- I IB("S")']"" W !,"Past actions of this billing record unspecified." G DISPQ
- S IBX="Entered^^^^^^MRA Requested^^^Authorized^^First Printed^^Last Printed^^^Cancelled"
- F I=1,7,10,12,14,17 I $P(IB("S"),U,I)]"" D:IBAC[7&($Y>(IOSL-4)) HDR Q:$S(IBAC'[7:0,1:IBQUIT) D DISP1
- ;
- ;Patch 320 - Added call to retrieve claim clone history.
- N IBCCR,IBCURR,IBNEXT,IBBCH,IBINDENT
- S IBINDENT=0
- D EN^IBCCR(IBIFN,.IBCCR) ; utility to pull cloning history
- ;
- ; attempt to go one claim forward from the current claim
- S IBCURR="IBCCR("_+$P(IB("S"),U,1)_","_IBIFN_")"
- S IBNEXT=$Q(@IBCURR)
- I IBNEXT'="" D
- . N IBX S IBX=@IBNEXT
- . W !,"Copied"
- . W ?15,": ",$$FMTE^XLFDT($P(IBX,U,1),"1Z")_" by "_$P(IBX,U,3)
- . W !,"Copied To",?15,": ",$P(IBX,U,2)
- . S IBINDENT=1
- . Q
- ;
- ; now go backwards for claim cloning history all the way back
- S IBBCH=IBCURR
- F S IBBCH=$Q(@IBBCH,-1) Q:IBBCH="" D
- . N IBX,TS1,TS2 S IBX=@IBBCH
- . I IBINDENT S TS1=4,TS2=19 ; set tab stops
- . E S TS1=0,TS2=15
- . W !?TS1,"Copied",?TS2,": "
- . W $$FMTE^XLFDT($P(IBX,U,1),"1Z")_" by "_$P(IBX,U,3)
- . W !?TS1,"Copied From",?TS2,": ",$P(IBX,U,2)
- . W !?TS1,"Reason Copied",?TS2,": ",$P(IBX,U,4)
- . S IBINDENT=1
- . Q
- ;
- 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
- W $E($P(IBPT,"^"),1,20)," ",$P(IBPT,"^",2),?36,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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNQ 5022 printed Feb 18, 2025@23:42:32 Page 2
- IBCNQ ;ALB/MJB - MCCR PATIENT BILLING INQUIRY ;13 JUN 88 13:52
- +1 ;;2.0;INTEGRATED BILLING;**51,320,377,433**;21-MAR-94;Build 36
- +2 ;;Per VHA Directive 2004-038, 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 FOR I=0,"S","U","U1"
- SET IB(I)=$GET(^DGCR(399,IBIFN,I))
- +3 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),"^"))
- +4 ;
- +5 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- DO D^DIQ
- SET IBNOW=Y
- SET IBPT=$$PT^IBEFUNC(DFN)
- DO HDR1
- +6 ;
- +7 SET IBUN="UNSPECIFIED"
- SET IBUK="UNKNOWN USER"
- +8 WRITE !,"Bill Status",?15,": ",$SELECT(IBSTAT=1:"ENTERED/NOT REVIEWED",IBSTAT=2:"MRA REQUESTED",IBSTAT=3:"AUTHORIZED",IBSTAT=4:"PRINTED/TRANSMITTED",IBSTAT=7:"CANCELLED",1:IBUN)," - RECORD IS ",$SELECT(IBSTAT=1:"",1:"UN"),"EDITABLE"
- +9 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),"^"))
- +10 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)
- +11 if IBSTAT=7
- WRITE !,"Reason Canceled",?15,": ",$SELECT($PIECE(IB("S"),"^",19)]"":$PIECE(IB("S"),"^",19),1:IBUN)
- +12 IF $$INPAT^IBCEF(IBIFN)
- SET Y=$PIECE(IB(0),"^",3)
- DO D^DIQ
- WRITE !!,"Admission Date : ",Y
- +13 IF '$TEST
- DO OPDATE
- +14 WRITE !!,"Charges",?15,": "
- SET X=$PIECE(IB("U1"),U,1)
- SET X2="2$"
- if X]""
- DO COMMA^%DTC
- WRITE $SELECT(X]"":X,1:IBUN)
- +15 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
- +16 SET X=$$TPR^PRCAFN(IBIFN)
- IF X>0
- SET X2="2$"
- DO COMMA^%DTC
- WRITE !,"Amount Paid",?15,": ",X
- +17 SET X=$$STA^PRCAFN(IBIFN)
- IF X>0
- WRITE !,"AR Status",?15,": ",$PIECE(X,"^",2)
- +18 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,!
- +19 IF $PIECE(IB("U"),U)']""
- WRITE !!,"Statement From",?15,": ",IBUN,!,"Statement To",?15,": ",IBUN,!
- +20 DO DISP
- IF IBQUIT
- if IBAC[8
- QUIT
- GOTO Q
- +21 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
- +22 ; Called from Outpatient Visit Date Inquiry
- DO PAUSE
- if $GET(IBFULL)&('IBQUIT)
- DO ^IBOLK1
- if IBAC[8
- QUIT
- +23 if IBQUIT
- GOTO Q
- GOTO ASKPAT
- +24 ;
- DISP ; The variable IBAC must be defined as input to this sub-routine.
- +1 if '$DATA(IBAC)
- GOTO DISPQ
- +2 SET IBUN="UNSPECIFIED"
- SET IBUK="UNKNOWN USER"
- +3 IF IB("S")']""
- WRITE !,"Past actions of this billing record unspecified."
- GOTO DISPQ
- +4 SET IBX="Entered^^^^^^MRA Requested^^^Authorized^^First Printed^^Last Printed^^^Cancelled"
- +5 FOR I=1,7,10,12,14,17
- IF $PIECE(IB("S"),U,I)]""
- if IBAC[7&($Y>(IOSL-4))
- DO HDR
- if $SELECT(IBAC'[7
- QUIT
- DO DISP1
- +6 ;
- +7 ;Patch 320 - Added call to retrieve claim clone history.
- +8 NEW IBCCR,IBCURR,IBNEXT,IBBCH,IBINDENT
- +9 SET IBINDENT=0
- +10 ; utility to pull cloning history
- DO EN^IBCCR(IBIFN,.IBCCR)
- +11 ;
- +12 ; attempt to go one claim forward from the current claim
- +13 SET IBCURR="IBCCR("_+$PIECE(IB("S"),U,1)_","_IBIFN_")"
- +14 SET IBNEXT=$QUERY(@IBCURR)
- +15 IF IBNEXT'=""
- Begin DoDot:1
- +16 NEW IBX
- SET IBX=@IBNEXT
- +17 WRITE !,"Copied"
- +18 WRITE ?15,": ",$$FMTE^XLFDT($PIECE(IBX,U,1),"1Z")_" by "_$PIECE(IBX,U,3)
- +19 WRITE !,"Copied To",?15,": ",$PIECE(IBX,U,2)
- +20 SET IBINDENT=1
- +21 QUIT
- End DoDot:1
- +22 ;
- +23 ; now go backwards for claim cloning history all the way back
- +24 SET IBBCH=IBCURR
- +25 FOR
- SET IBBCH=$QUERY(@IBBCH,-1)
- if IBBCH=""
- QUIT
- Begin DoDot:1
- +26 NEW IBX,TS1,TS2
- SET IBX=@IBBCH
- +27 ; set tab stops
- IF IBINDENT
- SET TS1=4
- SET TS2=19
- +28 IF '$TEST
- SET TS1=0
- SET TS2=15
- +29 WRITE !?TS1,"Copied",?TS2,": "
- +30 WRITE $$FMTE^XLFDT($PIECE(IBX,U,1),"1Z")_" by "_$PIECE(IBX,U,3)
- +31 WRITE !?TS1,"Copied From",?TS2,": ",$PIECE(IBX,U,2)
- +32 WRITE !?TS1,"Reason Copied",?TS2,": ",$PIECE(IBX,U,4)
- +33 SET IBINDENT=1
- +34 QUIT
- End DoDot:1
- +35 ;
- +36 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 ;W $E($P(IBPT,"^"),1,20)," ",$P(IBPT,"^",2),?38,IBBNO,?51,IBNOW,?72,"PAGE: ",IBPAGE,!,L
- +3 WRITE $EXTRACT($PIECE(IBPT,"^"),1,20)," ",$PIECE(IBPT,"^",2),?36,IBBNO,?51,IBNOW,?72,"PAGE: ",IBPAGE,!,L
- +4 KILL L
- QUIT
- +5 ;
- 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
