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

IBAMTD.m

Go to the documentation of this file.
  1. IBAMTD ;ALB/CPM - MOVEMENT EVENT DRIVER INTERFACE ; 21-OCT-91
  1. ;;2.0;INTEGRATED BILLING;**45,52,93,115,132,153,164,156,234,312,339,704**;21-MAR-94;Build 49
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. I $G(DGPMA)="",$G(DGPMP)="" Q
  1. ;
  1. EN ; Process events from the Movement Event Driver.
  1. ;
  1. ;S XRTL=$ZU(0),XRTN="IBAMTD-1" D T0^%ZOSV ;start rt clock
  1. ;
  1. Q:+$$SWSTAT^IBBAPI() ;IB*2.0*312
  1. ;
  1. ; -- add admissions to claims tracking
  1. D INP^IBTRKR
  1. ;
  1. ; -- run billing clock query
  1. D ADM^IBECECQ1
  1. ;
  1. ; -- update Transfer Pricing
  1. D ^IBATEI
  1. ;
  1. ; -- check for Long Term Care
  1. N IBALTC D EN^IBAECI Q:IBALTC
  1. ;
  1. ; - process billing for CHAMPVA patients
  1. I $$CVA^IBAUTL5(DFN) D PROC^IBACVA G END
  1. ;
  1. ; - unflag continuous patients
  1. S IBASIH=$$ASIH^IBAUTL5(DGPMA)
  1. I DGPMP="",($P(DGPMA,"^",2)=3!(IBASIH)),$O(^IBE(351.1,"B",DFN,0)),$D(^IBE(351.1,+$O(^(0)),0)),'$P(^(0),"^",2) D UNFLAG^IBAMTD1
  1. ;
  1. ; - update case record on discharge for special inpatient episodes
  1. S IBA=$P($S(DGPMA="":DGPMP,1:DGPMA),"^",14)
  1. I $O(^IBE(351.2,"AC",IBA,0)),DGPMP="",($P(DGPMA,"^",2)=3!(IBASIH)) D DIS^IBAMTI(IBA) G END
  1. ;
  1. ; - quit if patient was last Means Test copay patient before adm. date
  1. S IBLC=$$BILST^DGMTUB(DFN) G:'IBLC END I DGPMA="",$P(DGPMP,"^",2)=1,IBLC<$P(+DGPMP,".") G END
  1. D ORIG^IBAMTC I IBLC<$P(IBADMDT,".") G END
  1. ;
  1. ; - if editing or deleting a movement, send bulletin; delete
  1. ; case record in #351.2 for deleted admissions
  1. I DGPMP]"" S IBJOB=3 D G END
  1. .D ^IBAMTBU
  1. .I DGPMA="",$P(DGPMP,"^",2)=1,$O(^IBE(351.2,"AC",IBA,0)) S DA=$O(^(0)),DIK="^IBE(351.2," D ^DIK K DA,DIK
  1. ;
  1. ; - add a case record for admission of special (ao/ir/swa/mst/hnc/shad/cv) inpatients
  1. I $P(DGPMA,"^",2)=1 D G END
  1. .N IBCLSF D CL^IBACV(DFN,IBADMDT,"",.IBCLSF)
  1. .S IBCLSF=$O(IBCLSF(0)) I IBCLSF,(IBCLSF<5) D ADM^IBAMTI(DFN,IBA,IBCLSF) Q
  1. .I $P($$GETSTAT^DGMSTAPI(DFN,IBADMDT),U,2)="Y" S IBCLSF=5,IBCLSF(5)="" D ADM^IBAMTI(DFN,IBA,IBCLSF) Q
  1. .I IBCLSF=6 D ADM^IBAMTI(DFN,IBA,IBCLSF) ; hnc
  1. .I IBCLSF=8 D ADM^IBAMTI(DFN,IBA,IBCLSF) ; shad
  1. .I IBCLSF=7 D ADM^IBAMTI(DFN,IBA,IBCLSF) ; CV has the lowest priority
  1. ;
  1. ; - if adding a retro-active transfer or spec. transfer, send bulletin
  1. I ($P(DGPMA,"^",2)=2!($P(DGPMA,"^",2)=6)),+DGPMA<DT S IBJOB=6 D ^IBAMTBU
  1. ;
  1. ; - process discharges and ASIH movements only
  1. I $P(DGPMA,"^",2)'=3,'IBASIH G END
  1. ;
  1. W:'$G(DGQUIET) !,"Billing Means Test charges...."
  1. S (IBY,Y)=1,IBEVOLD=0,IBJOB=2,IBWHER=1,IBDISDT=+DGPMA\1,IBAFY=$$FY^IBOUTL(DT)
  1. D SITE^IBAUTL I Y<1 S IBY=Y G END1
  1. D SERV^IBAUTL2 G:IBY<1 END1
  1. S IBWHER=24 D CLOCK^IBAUTL3 G:IBY<1 END1
  1. ;
  1. ; - Create an Outpat Copay for discharge with Observation Speciality
  1. I $$MVT^DGPMOBS(IBA) D OBS^IBECEAU5 G:IBY<1 END1 G END
  1. ;
  1. ; - handle the variations on the basis of the event record
  1. D EVFIND^IBAUTL3 ; sets IBEVDA to IEN of event record, or to 0 if none
  1. S IBWHER=25 D @$S(IBEVDA:"EVT",1:"NOEVT")
  1. ;
  1. ; - kill variables and close
  1. END1 I IBY<1 S IBDUZ=DUZ D ^IBAERR1 K IBDUZ
  1. W:'$G(DGQUIET) "completed."
  1. END D KILL1^IBAMTC
  1. ;
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBAMTD" D T1^%ZOSV ;stop rt clock
  1. ;
  1. Q
  1. ;
  1. EVT ; Billable admission event on record.
  1. ; I +$$MVT^DGPMOBS(IBA) S IBDT=IBDISDT D OE^IBAMTBU1,CLOSE1 G EVTQ
  1. I IBEVCAL'<IBDISDT S IBY="-1^IB033" G EVTQ
  1. I IBEVCAL S X1=IBEVCAL,X2=1 D C^%DTC S IBBDT=%H I X=IBDISDT S IBDT=IBEVCAL D PASS^IBAUTL5,CLOSE1:IBY>0 G EVTQ
  1. I 'IBEVCAL S X=IBEVDT D H^%DTC S IBBDT=%H
  1. S X=IBDISDT D H^%DTC S IBEDT=%H-1
  1. I IBCLDA S %H=IBBDT D YMD^%DTC S IBDT=X D COUNT
  1. D ^IBAUTL4,CLOSE:IBY>0
  1. EVTQ Q
  1. ;
  1. NOEVT ; No billable event on record since admission date.
  1. ; I +$$MVT^DGPMOBS(IBA) W:'$G(DGQUIET) " patient not billed (adm. for O&E)... " G NOEVTQ ; admitted for Observation & Examination
  1. S (IBCUR,VAIP("D"))=+$G(^DGPM(IBA,0)) D IN5^VADPT S IBBS=$$SECT^IBAUTL5(+VAIP(8))
  1. I 'IBASIH,'IBBS G NOEVTQ ; not in billable bedsection
  1. I 'IBASIH,IBCUR\1=IBDISDT S IBDT=IBDISDT D:IBBS ^IBAMTD1 G NOEVTQ
  1. S X=IBADMDT\1 D H^%DTC S IBBDT=%H
  1. I IBASIH S VAIP("D")=IBADMDT,IBSAVBS=IBBS D IN5^VADPT S IBBS=$$SECT^IBAUTL5(+VAIP(8)) I 'IBBS S X=IBCUR D H^%DTC S IBBDT=%H I IBCUR\1=IBDISDT S IBDT=IBDISDT,IBBS=IBSAVBS D:IBBS ^IBAMTD1 G NOEVTQ
  1. D LAST^IBAUTL5
  1. S X=IBDISDT D H^%DTC S IBEDT=%H-1
  1. I IBCLDA S %H=IBBDT D YMD^%DTC S IBDT=X D COUNT
  1. D ^IBAUTL4,CLOSE:IBY>0
  1. NOEVTQ Q
  1. ;
  1. COUNT ; Find number of days on clock. Input: IBDT
  1. S X1=IBDT,X2=IBCLDT D ^%DTC S IBCLCT=X Q
  1. ;
  1. CLOSE ; Close out charges, events; update clocks (at discharge: tag CLOSE1)
  1. I $G(IBCHPDA) S IBNOS=IBCHPDA D FILER^IBAUTL5 G:IBY<1 CLOSEQ
  1. I $G(IBCHCDA) S IBNOS=IBCHCDA D FILER^IBAUTL5 G:IBY<1 CLOSEQ
  1. I IBCLDA D CLUPD^IBAUTL3
  1. CLOSE1 I IBEVDA,$D(IBDT) S IBEVCLD=IBDT D EVCLOSE^IBAUTL3
  1. CLOSEQ Q