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

IBOA31.m

Go to the documentation of this file. 
  1. IBOA31	;ALB/AAS - PRINT ALL BILLS FOR A PATIENT ; 04/18/90
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;
  1. 	;MAP TO DGCRA31
  1. EN	;
  1. 	;***
  1. 	;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
  1. 	;S XRTL=$ZU(0),XRTN="IBOA31-1" D T0^%ZOSV ;start rt clock
  1. 	S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC Q:Y<1  S DFN=+Y
  1. 	S DIR(0)="Y",DIR("A")="Include Pharmacy Co-Pay charges on this report",DIR("B")="NO"
  1. 	S DIR("?",1)="    Enter:  'Y'  -  To include Pharmacy Co-pay charges on this report"
  1. 	S DIR("?",2)="            'N'  -  To exclude Pharmacy Co-pay charges on this report"
  1. 	S DIR("?")="            '^'  -  To select a new patient"
  1. 	D ^DIR K DIR G:$D(DIRUT) END S IBIBRX=Y
  1. 	W !,"You will need a 132 column printer for this report."
  1. 	S %ZIS="QM" D ^%ZIS G:POP ENQ
  1. 	I $D(IO("Q")) K IO("Q") D  G ENQ
  1. 	.S ZTDESC="IB - PRINT ALL BILLS FOR A PATIENT",ZTRTN="DQ^IBOA31",ZTSAVE("DFN")="",ZTSAVE("IB*")=""
  1. 	.D ^%ZTLOAD K ZTSK D HOME^%ZIS
  1. 	;
  1. 	;***
  1. 	;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
  1. DQ	;
  1. 	;***
  1. 	;S XRTL=$ZU(0),XRTN="IBOA31-2" D T0^%ZOSV ;start rt clock
  1. 	U IO S IBPAG=0 D NOW^%DTC S Y=% X ^DD("DD") S IBNOW=Y,$P(IBLINE,"-",IOM+1)=""
  1. 	S IBQUIT=0,IBN=$$PT^IBEFUNC(DFN) D UTIL^IBCA3,UTIL^IBOA32
  1. 	I '$D(^UTILITY($J)) W !,"No Bills On File for ",$P(IBN,"^"),"  SSN: ",$P(IBN,"^",2),"." G ENQ
  1. 	D HDR1 S (IBDT,IBIFN)=""
  1. 	; - loop through all bills
  1. 	F  S IBDT=$O(^UTILITY($J,IBDT)) Q:IBDT=""!(IBQUIT)  D
  1. 	. F  S IBIFN=$O(^UTILITY($J,IBDT,IBIFN)) Q:IBIFN=""!(IBQUIT)  D @($S($E(IBIFN,$L(IBIFN))="X":"^IBOA32",1:"ONE"))
  1. 	D:'IBQUIT PAUSE
  1. ENQ	W ! G END
  1. 	;
  1. ONE	D GVAR^IBCBB
  1. 	D:($Y>(IOSL-5)) HDR Q:IBQUIT
  1. 	W !,IBBNO,?8,$$DAT1^IBOUTL($P(IBNDS,"^",12)),?18,$P($G(^DGCR(399.3,+IBAT,0)),"^")
  1. 	W ?37,$S(IBCL=1:"INPATIENT",IBCL=2:"HUMANIT. (INPT)",IBCL=3:"OUTPATIENT",IBCL=4:"HUMANIT. (OPT)",1:""),?54
  1. 	F I=$S(IBCL<3!('$O(^DGCR(399,IBIFN,"OP",0))):IBEVDT,1:$O(^DGCR(399,IBIFN,"OP",0))),IBFDT,IBTDT W $S(I]"":$$DAT1^IBOUTL(I)_"  ",1:"          ")
  1. 	S X=+$$TPR^PRCAFN(IBIFN) W $J($S(X<0:0,1:X),8,2)
  1. 	W ?94,$S(IBST=1:"ENTERED/NOT REV.",IBST=2:"REVIEWED",IBST=3:"AUTHORIZED",IBST=4:"PRINTED",IBST=7:"CANCELLED",1:"")
  1. 	W ?112,$P("NON-PAYMENT/ZERO^ADMIT - DISCHARGE^INTERIM - FIRST^INTERIM - CONTINUING^INTERIM - LAST^LATE CHARGE(S) ONLY^ADJUSTMENT OF PRIOR^REPLACEMENT OF PRIOR","^",(IBTF+1))
  1. 	; - print remaining outpatient visit dates
  1. 	S IBOPD=$O(^DGCR(399,IBIFN,"OP",0)) Q:'IBOPD
  1. 	F  S IBOPD=$O(^DGCR(399,IBIFN,"OP",IBOPD)) Q:'IBOPD  D  Q:IBQUIT
  1. 	. D:($Y>(IOSL-5)) HDR Q:IBQUIT  W !?54,$$DAT1^IBOUTL(IBOPD)
  1. 	Q
  1. 	;
  1. HDR	I $E(IOST,1,2)["C-" D PAUSE Q:IBQUIT
  1. HDR1	S IBPAG=IBPAG+1 W:$E(IOST,1,2)["C-"!(IBPAG>1) @IOF
  1. 	W "List of all Bills for ",$P(IBN,"^"),"  SSN: ",$P(IBN,"^",2),"  ",?(IOM-31),IBNOW,"  PAGE ",IBPAG
  1. 	W !,"BILL",?10,"DATE",?54,"DATE OF",?63,"STATEMENT  STATEMENT  AMOUNT"
  1. 	W !,"NO.      PRINTED  ACTION/RATE TYPE   CLASSIFICATION    CARE    FROM DATE   TO DATE  COLLECTED STATUS            TIMEFRAME OF BILL"
  1. 	W !,IBLINE
  1. 	Q
  1. 	;
  1. PAUSE	S IBX1="" R:$E(IOST,1,2)["C-" !!!,"Enter ""^"" to quit, or return to continue",IBX1:DTIME S IBQUIT=$S(IBX1["^":1,1:0) Q
  1. 	;
  1. END	K ^UTILITY($J)
  1. 	;***
  1. 	;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
  1. 	I $D(ZTQUEUED) S ZTREQ="@" Q
  1. 	D END^IBCBB1
  1. 	K IBIFN1,IBQUIT,IBX1,IBDT,IBCNT,IBN,DFN,IBIFN,IBLINE,IBNOW,IBPAG,IBOPD,IBIBRX,DIRUT,DUOUT,DTOUT,X,Y
  1. 	D ^%ZISC G EN