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

IBAMTS3.m

Go to the documentation of this file.
  1. IBAMTS3 ;LIBERTY/RED - HRfS API's for SHRPE/Nightly process for recent Activations ; 23-DEC-17
  1. ;;2.0;INTEGRATED BILLING;**614,653**;14-jun-17;Build 19
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; ICR 5491 - $$GETFLAG^DGPFAPIU
  1. ; ICR 4903 - $$GETINF^DGPFAPIH
  1. ; ICR 2056 - GETS^DIQ,$$GET1^DIQ
  1. ; ICR 10103 - $$FMADD^XLFDT,$$FMTE^XLFDT
  1. ;
  1. Q ;No direct access
  1. ;
  1. CHKHRFS(IBDFN,IBSTDT,IBENDDT) ; Function to determine Visit Copay exemption based on HRfS flag (IB*2.0*614/653)
  1. ; Also check for the activation of the function in field 70.02 in file 350.9 (IB SITE PARAMETERS)
  1. ; Also used to verify date of issue for Rx's, if flag was present
  1. ;input: IBDFN - Patient IEN
  1. ; IBSTDT - (optional) date to begin looking for the flag
  1. ; IBENDDT - (optional) End date to look for Flag, defaults to start date if not entered.
  1. ;
  1. ;Output: 1 - HRfS flag active on date of service
  1. ; 0 - HRfS not active on date of service or SHRPE activation date is NULL
  1. N IBFLAG,RESULT,IBREF,SHRPEDT,IBARR
  1. ;Due to legislative requirements, this function is active only after approved, when IB*2.0*614 is released the SHRPE activation date will be null
  1. S SHRPEDT=$$GET1^DIQ(350.9,1,70.02,"I") ; Activation date for SHRPE HRfS copayment calculations/waivers
  1. ;
  1. I $G(SHRPEDT)="" Q 0_"^SHRPE copayment adjustments have not been activated yet!" ; Quit if date not active
  1. S IBSTDT=$G(IBSTDT),IBSTDT=$S(IBSTDT="":DT,1:IBSTDT),IBENDDT=$S($G(IBENDDT)="":IBSTDT,1:IBENDDT)
  1. I IBSTDT<SHRPEDT Q 0_"^HRfS Flag wasn't active on date of service" ; Date of service is before activation date, quit
  1. S IBFLAG="HIGH RISK FOR SUICIDE",IBREF=$$GETFLAG^DGPFAPIU(IBFLAG,"N")
  1. I $G(IBREF)="" Q 0_"^Pt doesn't have the HRfS flag" ; Natl flag not found
  1. I $G(IBDFN)="" Q 0 ; No Pt entered
  1. S RESULT=$$GETINF^DGPFAPIH(IBDFN,IBREF,IBSTDT,IBENDDT,"IBARR")
  1. I RESULT=0 Q 0_"^HRfS flag NOT active for this Pt at date of service"
  1. Q 1_"^HRfS flag is active at date of service"
  1. ;
  1. ;Ran nightly as part of ^IBAMTS to see if a patient was assigned the CAT I National HRfS flag the date of service (yesterday),
  1. ; or if the same flag was active the day before yesterday and inactivated on the date of service. This generates the bulletin below
  1. NIGHTLY ; called by ^IBAMTC
  1. N IBDFN,IBBILL,IBDT,IBCDT,IBBILLA,IBDATA,IBBILLI,IBBILLP,IBBILLR,IBREF,IBCANC,IBPASTD,IBCNT,IBSTATUS
  1. S (IBCNT,IBDFN)=0,(IBDT,IBCDT)=$$FMADD^XLFDT(DT,-1) ;Use today-1 for the date
  1. S IBCDT=$P(IBCDT,".")_.9999,IBPASTD=$$FMADD^XLFDT(DT,-2) ;Set end of the day and a value for day before
  1. F S IBDT=$O(^IB("D",IBDT)) Q:'IBDT!(IBDT>IBCDT) D
  1. . S IBBILLI=0 F S IBBILLI=$O(^IB("D",IBDT,IBBILLI)) Q:'IBBILLI D
  1. .. K IBDATA D GETS^DIQ(350,IBBILLI_",",".01;.02;.04;.05;.08;.1;.11;.16","IE","IBDATA") S IBDATA=$NA(IBDATA(350,IBBILLI_","))
  1. .. S IBDFN=@IBDATA@(.02,"I"),IBSTATUS=$G(@IBDATA@(.05,"I")),IBBILLR=$G(@IBDATA@(.08,"I"))
  1. .. S IBBILLR=IBBILLR_" : "_$S(@IBDATA@(.11,"I")'="":@IBDATA@(.11,"I"),IBSTATUS=8:@IBDATA@(.05,"E"),1:"Pending"),IBBILLP=@IBDATA@(.16,"I")
  1. .. ; If the Patient had the flag yesterday, but didn't have it the day before, or had it previously and didn't have it yesterday do the bulletin
  1. .. I $$CHKHRFS(IBDFN,IBCDT)&'$$CHKHRFS(IBDFN,IBPASTD)!('$$CHKHRFS(IBDFN,IBCDT)&$$CHKHRFS(IBDFN,IBPASTD)) D
  1. ... S IBCANC=$G(@IBDATA@(.1,"I")),IBREF=$G(@IBDATA@(.11,"I"))
  1. ... Q:IBCANC'="" ;Claim was cancelled, quit
  1. ... I $P($G(@IBDATA@(.04,"I")),":")="52",$P(@IBDATA@(.04,"I"),";",2)'="" S $P(IBBILLR,":")=$P(IBBILLR,":")_"(r)" ;Check for a refilled Rx
  1. ... I $P($G(@IBDATA@(.04,"I")),":")=350,$P($G(@IBDATA@(.04,"I")),":",2)'=IBBILLI D Q ;Claim was cancelled
  1. ... S IBBILLA(IBDFN,IBBILLI)=IBBILLR ;build the array by DFN
  1. S (IBDFN,IBBILLI)=0 F S IBDFN=$O(IBBILLA(IBDFN)) Q:'IBDFN D
  1. . S IBCNT=1,IBBILLI=0 K IBBILL F S IBBILLI=$O(IBBILLA(IBDFN,IBBILLI)) Q:IBBILLI="" S IBBILL(IBCNT)=IBBILLA(IBDFN,IBBILLI),IBCNT=IBCNT+1
  1. . D BULL(IBDFN) ;send the bulletin for each patient individually
  1. Q
  1. ;
  1. ;Send bulletin to mailgroup: 'IB MEANS TEST' when HRfS patients are billed on the date of service or were active the day before service
  1. ; but deactivated on date of service to allow IB Revenue users to review
  1. BULL(IBDFN) ; Bulletin generation
  1. N IBT,IBC,IBPT,IBDUZ,XMSUB,IBCLAIM
  1. S IBPT=$$PT^IBEFUNC(IBDFN),IBPT=$P(IBPT,U)_U_$P($E(IBPT,1),U)_$P($P(IBPT,U,2),"-",3) ;Pt name (terminal digit)
  1. S XMSUB="IB SHRPE 'HRfS' IB charges review for "_$$FMTE^XLFDT(DT,5)
  1. S IBT(1)=" "
  1. S IBT(2)="The following patient had the HRfS (Cat I) flag activated/inactivated,"
  1. S IBT(3)="and the following charges created on "_$$FMTE^XLFDT($P(IBCDT,"."),5)_" should be reviewed by"
  1. S IBT(4)="IB revenue staff: "
  1. S IBT(5)=" ",IBC=5
  1. S IBDUZ=".5" D PAT^IBAERR1
  1. S IBCLAIM=0 F S IBCLAIM=$O(IBBILL(IBCLAIM)) Q:'IBCLAIM D
  1. . S IBC=IBC+1,IBT(IBC)=" "_IBBILL(IBCLAIM)
  1. D MAIL^IBAERR1
  1. K X,Y,XMSUB,XMY,XMTEXT,XMDUZ
  1. Q
  1. ;
  1. ;END OF IBAMTS3 routine