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