- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNQ.m
r613 r623 1 IBCNQ ;ALB/MJB - MCCR PATIENT BILLING INQUIRY ;6:13 AM 4 Jan 2009 2 ;;2.0;INTEGRATED BILLING;**51,320,377**;21-MAR-94;Build 4;WorldVistA 30-Jan-08 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;Modified from FOIA VISTA, 6 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 7 ;General Public License See attached copy of the License. 8 ; 9 ;This program is free software; you can redistribute it and/or modify 10 ;it under the terms of the GNU General Public License as published by 11 ;the Free Software Foundation; either version 2 of the License, or 12 ;(at your option) any later version. 13 ; 14 ;This program is distributed in the hope that it will be useful, 15 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;GNU General Public License for more details. 18 ; 19 ;You should have received a copy of the GNU General Public License along 20 ;with this program; if not, write to the Free Software Foundation, Inc., 21 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 22 ; 23 ; 24 ;MAP TO DGCRNQ 25 ; 26 D HOME^%ZIS 27 ASKPAT S DIC="^DGCR(399,",DIC(0)="AEMQZ",DIC("A")="Enter BILL NUMBER or PATIENT NAME: " W !! D ^DIC G:X=""!(X["^") Q 28 ; 29 S IBIFN=+Y,IBQUIT=0,IBAC=7 30 VIEW ; 31 ;*** 32 F I=0,"S","U","U1" S IB(I)=$G(^DGCR(399,IBIFN,I)) 33 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),"^")) 34 ; 35 D NOW^%DTC S Y=$E(%,1,12) D D^DIQ S IBNOW=Y,IBPT=$$PT^IBEFUNC(DFN) D HDR1 36 ; 37 S IBUN="UNSPECIFIED",IBUK="UNKNOWN USER" 38 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" 39 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),"^")) 40 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) 41 W:IBSTAT=7 !,"Reason Canceled",?15,": ",$S($P(IB("S"),"^",19)]"":$P(IB("S"),"^",19),1:IBUN) 42 I $$INPAT^IBCEF(IBIFN) S Y=$P(IB(0),"^",3) D D^DIQ W !!,"Admission Date : ",Y 43 E D OPDATE 44 W !!,"Charges",?15,": " S X=$P(IB("U1"),U,1),X2="2$" D:X]"" COMMA^%DTC W $S(X]"":X,1:IBUN) 45 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 46 S X=$$TPR^PRCAFN(IBIFN) I X>0 S X2="2$" D COMMA^%DTC W !,"Amount Paid",?15,": ",X 47 S X=$$STA^PRCAFN(IBIFN) I X>0 W !,"AR Status",?15,": ",$P(X,"^",2) 48 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,! 49 I $P(IB("U"),U)']"" W !!,"Statement From",?15,": ",IBUN,!,"Statement To",?15,": ",IBUN,! 50 D DISP I IBQUIT Q:IBAC[8 G Q 51 I IBSTAT<5 D NOPTF^IBCB2 I 'IBAC1 D:$Y>(IOSL-6) HDR Q:IBQUIT&(IBAC[8) G Q:IBQUIT D NOPTF1^IBCB2 52 D PAUSE,^IBOLK1:$G(IBFULL)&('IBQUIT) Q:IBAC[8 ; Called from Outpatient Visit Date Inquiry 53 G Q:IBQUIT,ASKPAT 54 ; 55 DISP ; The variable IBAC must be defined as input to this sub-routine. 56 G:'$D(IBAC) DISPQ 57 S IBUN="UNSPECIFIED",IBUK="UNKNOWN USER" 58 I IB("S")']"" W !,"Past actions of this billing record unspecified." G DISPQ 59 S IBX="Entered^^^^^^MRA Requested^^^Authorized^^First Printed^^Last Printed^^^Cancelled" 60 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 61 ; 62 ;Patch 320 - Added call to retrieve claim clone history. 63 N IBCCR,IBCURR,IBNEXT,IBBCH,IBINDENT 64 S IBINDENT=0 65 D EN^IBCCR(IBIFN,.IBCCR) ; utility to pull cloning history 66 ; 67 ; attempt to go one claim forward from the current claim 68 S IBCURR="IBCCR("_+$P(IB("S"),U,1)_","_IBIFN_")" 69 S IBNEXT=$Q(@IBCURR) 70 I IBNEXT'="" D 71 . N IBX S IBX=@IBNEXT 72 . W !,"Copied" 73 . W ?15,": ",$$FMTE^XLFDT($P(IBX,U,1),"1Z")_" by "_$P(IBX,U,3) 74 . W !,"Copied To",?15,": ",$P(IBX,U,2) 75 . S IBINDENT=1 76 . Q 77 ; 78 ; now go backwards for claim cloning history all the way back 79 S IBBCH=IBCURR 80 ;WVEHR ;begin change 01/04/2009 81 ;F S IBBCH=$Q(@IBBCH,-1) Q:IBBCH="" D 82 F S IBBCH=$$Q^VWUTIL($NA(@IBBCH),-1) Q:IBBCH="" D 83 .;WVEHR ;end change 84 . N IBX,TS1,TS2 S IBX=@IBBCH 85 . I IBINDENT S TS1=4,TS2=19 ; set tab stops 86 . E S TS1=0,TS2=15 87 . W !?TS1,"Copied",?TS2,": " 88 . W $$FMTE^XLFDT($P(IBX,U,1),"1Z")_" by "_$P(IBX,U,3) 89 . W !?TS1,"Copied From",?TS2,": ",$P(IBX,U,2) 90 . W !?TS1,"Reason Copied",?TS2,": ",$P(IBX,U,4) 91 . S IBINDENT=1 92 . Q 93 ; 94 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 95 DISPQ Q 96 ; 97 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) 98 Q 99 ; 100 Q K DFN,IB,IBAC,IBBNO,IBN,IBNOW,IBPAGE,IBPT,IBU,IBQUIT,IBUK,IBUN,IBX,IBSTAT,IBAC1,IBIFN,IBOPD,DIC,X,X2,Y 101 Q 102 ; 103 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),"^") 104 Q 105 ; 106 HDR D PAUSE Q:IBQUIT 107 HDR1 S L="",$P(L,"=",80)="",IBPAGE=IBPAGE+1 108 W:$E(IOST,1,2)["C-"!(IBPAGE>1) @IOF 109 W $E($P(IBPT,"^"),1,20)," ",$P(IBPT,"^",2),?38,IBBNO,?51,IBNOW,?72,"PAGE: ",IBPAGE,!,L 110 K L Q 111 ; 112 OPDATE ; List Outpatient Visit Dates. 113 Q:'$O(^DGCR(399,IBIFN,"OP",0)) 114 W !!,"OP Visit Dates :" S IBOPD=0 115 F I=1:1 S IBOPD=$O(^DGCR(399,IBIFN,"OP",IBOPD)) Q:'IBOPD D 116 . W:'((I-1)#4)&(I>1) ! 117 . S Y=IBOPD D D^DIQ W ?($S(I#4:I#4,1:4)*14+3),Y 118 Q 119 ; 120 PAUSE Q:$E(IOST,1,2)'="C-" 121 F I=$Y:1:(IOSL-3) W ! 122 S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT 123 Q 1 IBCNQ ;ALB/MJB - MCCR PATIENT BILLING INQUIRY ;7:37 PM 30 Jan 2008 2 ;;2.0;INTEGRATED BILLING;**51,320;VWEHR1**;WorldVistA 30-Jan-08 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 ;Modified from FOIA VISTA, 6 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 7 ;General Public License See attached copy of the License. 8 ; 9 ;This program is free software; you can redistribute it and/or modify 10 ;it under the terms of the GNU General Public License as published by 11 ;the Free Software Foundation; either version 2 of the License, or 12 ;(at your option) any later version. 13 ; 14 ;This program is distributed in the hope that it will be useful, 15 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;GNU General Public License for more details. 18 ; 19 ;You should have received a copy of the GNU General Public License along 20 ;with this program; if not, write to the Free Software Foundation, Inc., 21 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 22 ; 23 ;MAP TO DGCRNQ 24 ; 25 D HOME^%ZIS 26 ASKPAT S DIC="^DGCR(399,",DIC(0)="AEMQZ",DIC("A")="Enter BILL NUMBER or PATIENT NAME: " W !! D ^DIC G:X=""!(X["^") Q 27 ; 28 S IBIFN=+Y,IBQUIT=0,IBAC=7 29 VIEW ; 30 ;*** 31 ;S XRTL=$ZU(0),XRTN="IBCNQ-2" D T0^%ZOSV ;start rt clock 32 F I=0,"S","U","U1" S IB(I)=$G(^DGCR(399,IBIFN,I)) 33 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),"^")) 34 ; 35 D NOW^%DTC S Y=$E(%,1,12) D D^DIQ S IBNOW=Y,IBPT=$$PT^IBEFUNC(DFN) D HDR1 36 ; 37 S IBUN="UNSPECIFIED",IBUK="UNKNOWN USER" 38 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<3:"",1:"UN"),"EDITABLE" 39 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),"^")) 40 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) 41 W:IBSTAT=7 !,"Reason Canceled",?15,": ",$S($P(IB("S"),"^",19)]"":$P(IB("S"),"^",19),1:IBUN) 42 I $$INPAT^IBCEF(IBIFN) S Y=$P(IB(0),"^",3) D D^DIQ W !!,"Admission Date : ",Y 43 E D OPDATE 44 W !!,"Charges",?15,": " S X=$P(IB("U1"),U,1),X2="2$" D:X]"" COMMA^%DTC W $S(X]"":X,1:IBUN) 45 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 46 S X=$$TPR^PRCAFN(IBIFN) I X>0 S X2="2$" D COMMA^%DTC W !,"Amount Paid",?15,": ",X 47 S X=$$STA^PRCAFN(IBIFN) I X>0 W !,"AR Status",?15,": ",$P(X,"^",2) 48 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,! 49 I $P(IB("U"),U)']"" W !!,"Statement From",?15,": ",IBUN,!,"Statement To",?15,": ",IBUN,! 50 D DISP I IBQUIT Q:IBAC[8 G Q 51 I IBSTAT<5 D NOPTF^IBCB2 I 'IBAC1 D:$Y>(IOSL-6) HDR Q:IBQUIT&(IBAC[8) G Q:IBQUIT D NOPTF1^IBCB2 52 D PAUSE,^IBOLK1:$G(IBFULL)&('IBQUIT) Q:IBAC[8 ; Called from Outpatient Visit Date Inquiry 53 G Q:IBQUIT,ASKPAT 54 ; 55 DISP ; The variable IBAC must be defined as input to this sub-routine. 56 G:'$D(IBAC) DISPQ 57 S IBUN="UNSPECIFIED",IBUK="UNKNOWN USER" 58 I IB("S")']"" W !,"Past actions of this billing record unspecified." G DISPQ 59 S IBX="Entered^^^^^^MRA Requested^^^Authorized^^^^Last Printed^^^Cancelled" 60 F I=1,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 61 ; 62 ;Patch 320 - Added call to retrieve claim clone history. 63 N IBCCR,IBCURR,IBNEXT,IBBCH,IBINDENT 64 S IBINDENT=0 65 D EN^IBCCR(IBIFN,.IBCCR) ; utility to pull cloning history 66 ; 67 ; attempt to go one claim forward from the current claim 68 S IBCURR="IBCCR("_+$P(IB("S"),U,1)_","_IBIFN_")" 69 S IBNEXT=$Q(@IBCURR) 70 I IBNEXT'="" D 71 . N IBX S IBX=@IBNEXT 72 . W !,"Copied" 73 . W ?15,": ",$$FMTE^XLFDT($P(IBX,U,1),"1Z")_" by "_$P(IBX,U,3) 74 . W !,"Copied To",?15,": ",$P(IBX,U,2) 75 . S IBINDENT=1 76 . Q 77 ; 78 ; now go backwards for claim cloning history all the way back 79 S IBBCH=IBCURR 80 ; 81 ;WV/EHR REVERSE $Q REPLACEMENT; SO 01/12/08 ;VWEHR1 82 ; 83 ;F S IBBCH=$Q(@IBBCH,-1) Q:IBBCH="" D 84 F S IBBCH=$$Q^VWUTIL($NA(@IBBCH),-1) Q:IBBCH="" D 85 . ; 86 . ;END CHANGE 87 . ; 88 . N IBX,TS1,TS2 S IBX=@IBBCH 89 . I IBINDENT S TS1=4,TS2=19 ; set tab stops 90 . E S TS1=0,TS2=15 91 . W !?TS1,"Copied",?TS2,": " 92 . W $$FMTE^XLFDT($P(IBX,U,1),"1Z")_" by "_$P(IBX,U,3) 93 . W !?TS1,"Copied From",?TS2,": ",$P(IBX,U,2) 94 . W !?TS1,"Reason Copied",?TS2,": ",$P(IBX,U,4) 95 . S IBINDENT=1 96 . Q 97 ; 98 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 99 DISPQ Q 100 ; 101 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) 102 Q 103 ; 104 Q K DFN,IB,IBAC,IBBNO,IBN,IBNOW,IBPAGE,IBPT,IBU,IBQUIT,IBUK,IBUN,IBX,IBSTAT,IBAC1,IBIFN,IBOPD,DIC,X,X2,Y 105 Q 106 ; 107 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),"^") 108 Q 109 ; 110 HDR D PAUSE Q:IBQUIT 111 HDR1 S L="",$P(L,"=",80)="",IBPAGE=IBPAGE+1 112 W:$E(IOST,1,2)["C-"!(IBPAGE>1) @IOF 113 W $E($P(IBPT,"^"),1,20)," ",$P(IBPT,"^",2),?38,IBBNO,?51,IBNOW,?72,"PAGE: ",IBPAGE,!,L 114 K L Q 115 ; 116 OPDATE ; List Outpatient Visit Dates. 117 Q:'$O(^DGCR(399,IBIFN,"OP",0)) 118 W !!,"OP Visit Dates :" S IBOPD=0 119 F I=1:1 S IBOPD=$O(^DGCR(399,IBIFN,"OP",IBOPD)) Q:'IBOPD D 120 . W:'((I-1)#4)&(I>1) ! 121 . S Y=IBOPD D D^DIQ W ?($S(I#4:I#4,1:4)*14+3),Y 122 Q 123 ; 124 PAUSE Q:$E(IOST,1,2)'="C-" 125 F I=$Y:1:(IOSL-3) W ! 126 S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT 127 Q
Note:
See TracChangeset
for help on using the changeset viewer.
