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

IBCNQ.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;MAP TO DGCRNQ
  1. ;
  1. D HOME^%ZIS
  1. ASKPAT S DIC="^DGCR(399,",DIC(0)="AEMQZ",DIC("A")="Enter BILL NUMBER or PATIENT NAME: " W !! D ^DIC G:X=""!(X["^") Q
  1. ;
  1. S IBIFN=+Y,IBQUIT=0,IBAC=7
  1. VIEW ;
  1. ;***
  1. F I=0,"S","U","U1" S IB(I)=$G(^DGCR(399,IBIFN,I))
  1. 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),"^"))
  1. ;
  1. D NOW^%DTC S Y=$E(%,1,12) D D^DIQ S IBNOW=Y,IBPT=$$PT^IBEFUNC(DFN) D HDR1
  1. ;
  1. S IBUN="UNSPECIFIED",IBUK="UNKNOWN USER"
  1. 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"
  1. 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),"^"))
  1. 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)
  1. W:IBSTAT=7 !,"Reason Canceled",?15,": ",$S($P(IB("S"),"^",19)]"":$P(IB("S"),"^",19),1:IBUN)
  1. I $$INPAT^IBCEF(IBIFN) S Y=$P(IB(0),"^",3) D D^DIQ W !!,"Admission Date : ",Y
  1. E D OPDATE
  1. W !!,"Charges",?15,": " S X=$P(IB("U1"),U,1),X2="2$" D:X]"" COMMA^%DTC W $S(X]"":X,1:IBUN)
  1. 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
  1. S X=$$TPR^PRCAFN(IBIFN) I X>0 S X2="2$" D COMMA^%DTC W !,"Amount Paid",?15,": ",X
  1. S X=$$STA^PRCAFN(IBIFN) I X>0 W !,"AR Status",?15,": ",$P(X,"^",2)
  1. 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,!
  1. I $P(IB("U"),U)']"" W !!,"Statement From",?15,": ",IBUN,!,"Statement To",?15,": ",IBUN,!
  1. D DISP I IBQUIT Q:IBAC[8 G Q
  1. I IBSTAT<5 D NOPTF^IBCB2 I 'IBAC1 D:$Y>(IOSL-6) HDR Q:IBQUIT&(IBAC[8) G Q:IBQUIT D NOPTF1^IBCB2
  1. D PAUSE,^IBOLK1:$G(IBFULL)&('IBQUIT) Q:IBAC[8 ; Called from Outpatient Visit Date Inquiry
  1. G Q:IBQUIT,ASKPAT
  1. ;
  1. DISP ; The variable IBAC must be defined as input to this sub-routine.
  1. G:'$D(IBAC) DISPQ
  1. S IBUN="UNSPECIFIED",IBUK="UNKNOWN USER"
  1. I IB("S")']"" W !,"Past actions of this billing record unspecified." G DISPQ
  1. S IBX="Entered^^^^^^MRA Requested^^^Authorized^^First Printed^^Last Printed^^^Cancelled"
  1. 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
  1. ;
  1. ;Patch 320 - Added call to retrieve claim clone history.
  1. N IBCCR,IBCURR,IBNEXT,IBBCH,IBINDENT
  1. S IBINDENT=0
  1. D EN^IBCCR(IBIFN,.IBCCR) ; utility to pull cloning history
  1. ;
  1. ; attempt to go one claim forward from the current claim
  1. S IBCURR="IBCCR("_+$P(IB("S"),U,1)_","_IBIFN_")"
  1. S IBNEXT=$Q(@IBCURR)
  1. I IBNEXT'="" D
  1. . N IBX S IBX=@IBNEXT
  1. . W !,"Copied"
  1. . W ?15,": ",$$FMTE^XLFDT($P(IBX,U,1),"1Z")_" by "_$P(IBX,U,3)
  1. . W !,"Copied To",?15,": ",$P(IBX,U,2)
  1. . S IBINDENT=1
  1. . Q
  1. ;
  1. ; now go backwards for claim cloning history all the way back
  1. S IBBCH=IBCURR
  1. F S IBBCH=$Q(@IBBCH,-1) Q:IBBCH="" D
  1. . N IBX,TS1,TS2 S IBX=@IBBCH
  1. . I IBINDENT S TS1=4,TS2=19 ; set tab stops
  1. . E S TS1=0,TS2=15
  1. . W !?TS1,"Copied",?TS2,": "
  1. . W $$FMTE^XLFDT($P(IBX,U,1),"1Z")_" by "_$P(IBX,U,3)
  1. . W !?TS1,"Copied From",?TS2,": ",$P(IBX,U,2)
  1. . W !?TS1,"Reason Copied",?TS2,": ",$P(IBX,U,4)
  1. . S IBINDENT=1
  1. . Q
  1. ;
  1. 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
  1. DISPQ Q
  1. ;
  1. 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)
  1. Q
  1. ;
  1. Q K DFN,IB,IBAC,IBBNO,IBN,IBNOW,IBPAGE,IBPT,IBU,IBQUIT,IBUK,IBUN,IBX,IBSTAT,IBAC1,IBIFN,IBOPD,DIC,X,X2,Y
  1. Q
  1. ;
  1. 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),"^")
  1. Q
  1. ;
  1. HDR D PAUSE Q:IBQUIT
  1. HDR1 S L="",$P(L,"=",80)="",IBPAGE=IBPAGE+1
  1. W:$E(IOST,1,2)["C-"!(IBPAGE>1) @IOF
  1. ;W $E($P(IBPT,"^"),1,20)," ",$P(IBPT,"^",2),?38,IBBNO,?51,IBNOW,?72,"PAGE: ",IBPAGE,!,L
  1. W $E($P(IBPT,"^"),1,20)," ",$P(IBPT,"^",2),?36,IBBNO,?51,IBNOW,?72,"PAGE: ",IBPAGE,!,L
  1. K L Q
  1. ;
  1. OPDATE ; List Outpatient Visit Dates.
  1. Q:'$O(^DGCR(399,IBIFN,"OP",0))
  1. W !!,"OP Visit Dates :" S IBOPD=0
  1. F I=1:1 S IBOPD=$O(^DGCR(399,IBIFN,"OP",IBOPD)) Q:'IBOPD D
  1. . W:'((I-1)#4)&(I>1) !
  1. . S Y=IBOPD D D^DIQ W ?($S(I#4:I#4,1:4)*14+3),Y
  1. Q
  1. ;
  1. PAUSE Q:$E(IOST,1,2)'="C-"
  1. F I=$Y:1:(IOSL-3) W !
  1. S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT
  1. Q