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

IBTRKR5.m

Go to the documentation of this file. 
  1. IBTRKR5	;ALB/AAS - CLAIMS TRACKING - ADD/TRACK PROSTHETICS ; 13-JAN-94
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. 	;
  1. %	; -- entry point for nightly background job
  1. 	N IBTSBDT,IBTSEDT
  1. 	S IBTSBDT=$$FMADD^XLFDT(DT,-30)-.1
  1. 	S IBTSEDT=$$FMADD^XLFDT(DT,-3)+.9
  1. 	D EN1
  1. 	Q
  1. 	;
  1. EN	; -- entry point to ask date range
  1. 	N IBBDT,IBEDT,IBTSBDT,IBTSEDT,IBTALK
  1. 	S IBTALK=1
  1. 	I '$P($G(^IBE(350.9,1,6)),"^",4) W !!,"I'm sorry, Tracking of Prosthetics is currrently turned off." G ENQ
  1. 	W !!!,"Select the Date Range of Prosthetics to Add to Claims Tracking.",!
  1. 	D DATE^IBOUTL
  1. 	I IBBDT<1!(IBEDT<1) G ENQ
  1. 	S IBTSBDT=IBBDT,IBTSEDT=IBEDT
  1. 	;
  1. 	; -- check selected dates
  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,-3) W !!,"I'll automatically change the end date to 3 days prior to the date queued to run."
  1. 	;
  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^IBTRKR5",ZTSAVE("IB*")="",ZTDESC="IB - Add Prosthetics 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 prostethics to claims tracking file
  1. 	N I,J,X,Y,IBTRKR,IBDT,DFN,IBDATA,IBCNT,IBCNT1,IBCNT2
  1. 	;
  1. 	; -- check parameters
  1. 	S IBTRKR=$G(^IBE(350.9,1,6))
  1. 	G:'$P(IBTRKR,"^",5) EN1Q ; quit if prothetics 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>$$FMADD^XLFDT(DT,-3) S IBMESS="(Selected end date of "_$$DAT1^IBOUTL(IBTSEDT)_" automatically changed to "_$$DAT1^IBOUTL($$FMADD^XLFDT(DT,-3))_".)",IBTSEDT=$$FMADD^XLFDT(DT,-3)
  1. 	;
  1. 	;S IBPRTYP=$O(^IBE(356.6,"AC",3,0)) ; this is the event type pointer for prosthetics
  1. 	;
  1. 	; -- cnt= total count, cnt1=count added nsc, cnt2=count of pending
  1. 	S (IBCNT,IBCNT1,IBCNT2)=0
  1. 	S IBDT=IBTSBDT-.0001
  1. 	F  S IBDT=$O(^RMPR(660,"B",IBDT)) Q:'IBDT!(IBDT>IBTSEDT)  S IBDA="" F  S IBDA=$O(^RMPR(660,"B",IBDT,IBDA)) Q:'IBDA  D PRCHK
  1. 	;
  1. 	I $G(IBTALK) D BULL ;^IBTRKR51
  1. EN1Q	I $D(ZTQUEUED) S ZTREQ="@"
  1. 	Q
  1. 	;
  1. PRCHK	; -- check and add item
  1. 	S IBCNT=IBCNT+1
  1. 	I '$D(ZTQUEUED),($G(IBTALK)) W "."
  1. 	;
  1. 	S IBDATA=$G(^RMPR(660,+IBDA,0)) Q:IBDATA=""
  1. 	S DFN=$P(IBDATA,"^",2)
  1. 	;
  1. 	; -- checks copied from rmprbil v2.0 /feb 2, 1994
  1. 	Q:'$D(^RMPR(660,+IBDA,"AM"))
  1. 	Q:$P(^RMPR(660,+IBDA,0),U,9)=""!($P(^(0),U,12)="")!($P(^(0),U,6)="")!($P(^(0),U,14)="V")!($P(^(0),U,2)="")!($P(^(0),U,15)="*")
  1. 	Q:($P(^RMPR(660,+IBDA,"AM"),U,3)=2)!($P(^("AM"),U,3)=3)
  1. 	;
  1. 	;
  1. 	I $O(^IBT(356,"APRO",IBDA,0)) G PRCHKQ ; already in claims tracking
  1. 	;
  1. 	; -- see if tracking only insured and pt is insured
  1. 	I $P(IBTRKR,"^",5)=1,'$$INSURED^IBCNS1(DFN,IBDT) G PRCHKQ ; patient not insure
  1. 	;
  1. 	; -- check sc status
  1. 	D ELIG^VADPT
  1. 	I +VAEL(3) S IBRMARK="NEEDS SC DETERMINATION"
  1. 	;
  1. 	; -- ok to add to tracking module
  1. 	D PRO^IBTUTL1(DFN,IBDT,IBDA,$G(IBRMARK)) I '$D(ZTQUEUED),$G(IBTALK) W "+"
  1. 	I $G(IBRMARK)'="" S IBCNT2=IBCNT2+1
  1. 	I $G(IBRMARK)="" S IBCNT1=IBCNT1+1
  1. 	K IBRMARK,VAEL,VA,IBDATA,DFN,X,Y
  1. PRCHKQ	Q
  1. 	;
  1. BULL	; -- send bulletin
  1. 	;
  1. 	S XMSUB="Prothetic Items added to Claims Tracking Complete"
  1. 	S IBT(1)="The process to automatically add Prosthetic Items has successfully completed."
  1. 	S IBT(1.1)=""
  1. 	S IBT(2)="                      Start Date: "_$$DAT1^IBOUTL(IBTSBDT)
  1. 	S IBT(3)="                        End Date: "_$$DAT1^IBOUTL(IBTSEDT)
  1. 	I $D(IBMESS) S IBT(3.1)=IBMESS
  1. 	S IBT(4)=""
  1. 	S IBT(5)=" Total Prosthetics Items checked: "_$G(IBCNT)
  1. 	S IBT(6)="Total NSC Prosthetic Items Added: "_$G(IBCNT1)
  1. 	S IBT(7)=" Total SC Prosthetic Items Added: "_$G(IBCNT2)
  1. 	S IBT(8)=""
  1. 	S IBT(9)="*The items added as SC require determination and editing to be billed"
  1. 	D SEND^IBTRKR31
  1. BULLQ	Q