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

IBTRKR4.m

Go to the documentation of this file. 
  1. IBTRKR4 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK OUTPATIENT ENCOUNTERS ; 13-AUG-93
  1.  ;;2.0;INTEGRATED BILLING;**91,142,292,312,489**;21-MAR-94;Build 31
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. % ; -- entry point for nightly background job
  1.  N IBTSBDT,IBTSEDT
  1.  S IBTSBDT=$$FMADD^XLFDT(DT,$S($E(DT,6,7)=10:-730,1:-20))-.1
  1.  S IBTSEDT=$$FMADD^XLFDT(DT,-2)-.9
  1.  D EN1
  1.  Q
  1.  ;
  1. EN ; -- entry point to ask date range
  1.  N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI()                     ;IB*2.0*312
  1.  N IBBDT,IBEDT,IBTSBDT,IBTSEDT,IBTALK
  1.  S IBTALK=1
  1.  I '$P($G(^IBE(350.9,1,6)),"^",3) W !!,"I'm sorry, Tracking of Outpatient Encounters is currently turned off." G ENQ
  1.  W !!!,"Select the Date Range of Opt. Encounters to Add to Claims Tracking.",!
  1.  D DATE^IBOUTL
  1.  I IBBDT<1!(IBEDT<1) G ENQ
  1.  S IBTSBDT=IBBDT,IBTSEDT=IBEDT
  1.  ; Do NOT PROCESS on VistA if Start or End>=Switch Eff Dt    ;CCR-930
  1.  ; -- check selected dates                                   ;IB*2.0*312
  1.  I +IBSWINFO,((IBTSBDT+1)>$P(IBSWINFO,"^",2))!((IBTSEDT+1)>$P(IBSWINFO,"^",2)) D  G EN
  1.    .W !!,"The Begin OR End Date CANNOT be on or after"
  1.    .W !,"the PFSS Effective Date: ",$$FMTE^XLFDT($P(IBSWINFO,"^",2))
  1.  ;
  1.  S IBTRKR=$G(^IBE(350.9,1,6))
  1.  ; start date can't be before parameters
  1.  I +IBTRKR,IBTSBDT<+IBTRKR S IBTSBDT=IBTRKR W !!,"Begin date is before Claims Tracking Start Date, changed to ",$$DAT1^IBOUTL(IBTSBDT)
  1.  ; -- end date into future
  1.  I IBTSEDT>$$FMADD^XLFDT(DT,-1) W !!,"I'll automatically change the end date to 1 day prior to the date queued to run."
  1.  W !!!,"I'm going to automatically queue this off and send you a"
  1.  W !,"mail message when complete.",!
  1.  S ZTIO="",ZTRTN="EN1^IBTRKR4",ZTSAVE("IB*")="",ZTDESC="IB - Add Opt Encounters to Claims Tracking"
  1.  D ^%ZTLOAD I $G(ZTSK) K ZTSK W !,"Request Queued"
  1. ENQ K ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1. EN1 ; -- add outpatient encounters to claims tracking file
  1.  L +^IBTRKR4:$S($G(DILOCKTM)>600:DILOCKTM,1:600) I '$T G FLKMG
  1.  N I,J,X,Y,IBTRKR,IBDT,DFN,IBOETA,IBCNT,IBCNT1,IBCNT2
  1.  ;
  1.  ; -- check parameters
  1.  S IBTRKR=$G(^IBE(350.9,1,6))
  1.  G:'$P(IBTRKR,"^",3) EN1Q ; quit if opt tracking off
  1.  I +IBTRKR,IBTSBDT<+IBTRKR S IBTSBDT=IBTRKR ; start date can't be before parameters
  1.  ;
  1.  ; -- users can queue into future, make sure dates not after date run
  1.  ;I IBTSEDT>DT S IBTSEDT=DT
  1.  I IBTSEDT>$$FMADD^XLFDT(DT,-1) S IBMESS="(Selected end date of "_$$DAT1^IBOUTL(IBTSEDT)_" automatically changed to "_$$DAT1^IBOUTL($$FMADD^XLFDT(DT,-1))_".)",IBTSEDT=$$FMADD^XLFDT(DT,-1)
  1.  ;
  1.  S IBOETYP=$O(^IBE(356.6,"AC",2,0)) ;event type pointer for opt encounters
  1.  ;
  1.  ; -- cnt= total count, cnt1=count added nsc, cnt2=count of pending
  1.  S (IBCNT,IBCNT1,IBCNT2)=0
  1.  ;
  1.  N IBVAL,IBCBK,IBFILTER
  1.  S IBVAL("BDT")=IBTSBDT,IBVAL("EDT")=IBTSEDT+.9
  1.  ; Only parent encounters, status is checked out, check out date exists,
  1.  ;   not already in CT, not already an entry for the same encounter
  1.  S IBFILTER=""
  1.  ;S IBCBK="S IBCNT=IBCNT+1 I '$P(Y0,U,6),$P(Y0,U,12)=2,$P(Y0,U,7),'$O(^IBT(356,""AENC"",+$P(Y0,U,2),Y,0)),'$O(^IBT(356,""APTY"",+$P(Y0,U,2),IBOETYP,+Y0,0)) S IBDT=+Y0,IBOE=Y D OPCHK^IBTRKR41"
  1.  S IBCBK="S IBCNT=IBCNT+1 I '$P(Y0,U,6),$P(Y0,U,12)=2,$P(Y0,U,7),'$O(^IBT(356,""AENC"",+$P(Y0,U,2),Y,0)),$S($D(^IBE(356.6,""ACODE"",2,IBOETYP)):1,1:'$O(^IBT(356,""APTY"",+$P(Y0,U,2),IBOETYP,+Y0,0))) S IBDT=+Y0,IBOE=Y D OPCHK^IBTRKR41"
  1.  D SCAN^IBSDU("DATE/TIME",.IBVAL,IBFILTER,IBCBK,1) ;Scan,then close query
  1. MSG ;
  1.  I $G(IBTALK) D BULL^IBTRKR41
  1. EN1Q I $D(ZTQUEUED) S ZTREQ="@"
  1.  L -^IBTRKR4
  1.  Q
  1.  ;
  1. FLKMG ; send a message for interaction if lock failed
  1.  I '$G(IBTALK) G FLKMGQ
  1.  S XMSUB="Outpatient Encounters added to Claims Tracking Complete"
  1.  S IBT(1)="The process to automatically add Opt Encounters is currently locked by another user. Try again later."
  1.  S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
  1.  K XMY S XMN=0
  1.  S XMY(DUZ)=""
  1.  D ^XMD
  1.  K X,Y,IBI,IBT,IBGRP,XMDUZ,XMTEXT,XMY,XMSUB
  1. FLKMGQ I $D(ZTQUEUED) S ZTREQ="@"
  1.  Q
  1.  ;