EASBTBUL ;ALB/DHS,LMD - Beneficiary Travel Bulletin - Create and Send ;10/30/2014 8:43am
;;1.0;ENROLLMENT APPLICATION SYSTEM;**113**;OCT 31, 2014;Build 53
;;Per VA Directive 6402, this routine should not be modified.
;
; EAS*1*113 Send Bulletin if BTFI is different than what is on file
;
; this routine will send the Beneficiary Travel Bulletin for the specified conditions:
; When a converted/reversal Rx Copay Test is received from IVM, a check will be done to
; see if the new copay exemption status is different than the old copay exemption status.
; If the status has changed, Beneficiary Travel Eligible indicator a bulletin will be sent
; to the BT CLAIMS PROCESSING mail group.
;
; This routine is called from EASPREC6 and EASPREC7 at the end of ORU-Z06 processing ;EASPREC6
;
SET(DFN,DT,DGCAT,IVMCEB,IVM10) ; Create and Send BT Bulletin
;
; Input:
; DFN = IEN of Patient
; DT = Today's Date
; DGCAT = Current Means Test Status
; IVMCEB = Previous Means Test Status
; IVM10 = Date/Time Test Completed
;
N IFN,DATA,SSN,X
;
;SSN
I $D(^DPT(DFN,.36)) S X=^DPT(DFN,.36) I +X S SSN=$P(X,"^",4)
I SSN="" S X=$P(^DPT(DFN,0),"^",9) I X]"" S SSN=$E(X,6,10)
;
; External Reference to ^DGBT(392.2 supported by DBIA #6015 ;DS THIS FILE DATA DOESNT EXIST
S IFN=$$FIND1^DIC(392.2,"","MXQ",DFN,"","","ERR")
; Check if Beneficiary Travel Date Certified is within the last year
;I $$GET1^DIQ(392.2,IFN,"DATE CERTIFIED","I")<($P(DT,".",1)-10000) Q
;
; Input raw data into DATA array to set variables in Bulletin
;
; Patient DFN number
S DATA(10)=DFN
; Patient Name
S DATA(1)=$$GET1^DIQ(2,DFN,"NAME","I")
; Last 4 of SSN
S DATA(2)=SSN
; Patient VPID
S DATA(3)=$$GETICN^MPIF001(DFN)
; Patient IEN
S DATA(4)=DFN
; Station Number
S DATA(5)=$P($$SITE^VASITE(),"^",3)
; Previous Category
S DATA(6)=IVMCEB
; New Category
S DATA(7)=DGCAT
; Date of Test
S Y=$P(IVM10,".") X ^DD("DD")
S DATA(8)=Y
; Converted Income Year
S Y=$$LYR^DGMTSCU1(IVM10) X ^DD("DD")
S DATA(9)=Y
;
D SENDBUL
;
Q
;
KILL ; Remove RX Bulletin - Not used at this time
;
; This is a placeholder should it be found in the future that any data from the SET
; needs cleaned up.
;
Q
;
SENDBUL ; transmit bulletin
;
; Protect Fileman from Mailman call
N DIC,DIX,DIY,DO,DD,DFN,VSITE,XMINSTR
N DICRREC,DIDATA,DIEFAR,DIEFCNOD,DIEFDAS,DIEFECNT,DIEFF,DIEFFLAG
N DIEFFLD,DIEFFLST,DIEFFREF,DIEFFVAL,DIEFFXR,DIEFI,DIEFIEN,DIEFLEV
N DIEFNODE,DIEFNVAL,DIEFOUT,DIEFOVAL,DIEFRFLD,DIEFRLST,DIEFSORK
N DIEFSPOT,DIEFTMP,DIEFTREF,DIFLD,DIFM,DIQUIET,DISYS,D,D0,DA
;
; Set From Line of Email
S XMINSTR("FROM")=.5
;
; Send email
;D SENDBULL^XMXAPI(DUZ,"RX COPAY TEST",.DATA,,,.XMINSTR)
D SENDBULL^XMXAPI(DUZ,"EAS BT CLAIMS PROCESSING",.DATA,,,.XMINSTR) ;EAS BT CLAIMS PROCESSING
;
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASBTBUL 2890 printed Oct 16, 2024@17:54:28 Page 2
EASBTBUL ;ALB/DHS,LMD - Beneficiary Travel Bulletin - Create and Send ;10/30/2014 8:43am
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**113**;OCT 31, 2014;Build 53
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; EAS*1*113 Send Bulletin if BTFI is different than what is on file
+5 ;
+6 ; this routine will send the Beneficiary Travel Bulletin for the specified conditions:
+7 ; When a converted/reversal Rx Copay Test is received from IVM, a check will be done to
+8 ; see if the new copay exemption status is different than the old copay exemption status.
+9 ; If the status has changed, Beneficiary Travel Eligible indicator a bulletin will be sent
+10 ; to the BT CLAIMS PROCESSING mail group.
+11 ;
+12 ; This routine is called from EASPREC6 and EASPREC7 at the end of ORU-Z06 processing ;EASPREC6
+13 ;
SET(DFN,DT,DGCAT,IVMCEB,IVM10) ; Create and Send BT Bulletin
+1 ;
+2 ; Input:
+3 ; DFN = IEN of Patient
+4 ; DT = Today's Date
+5 ; DGCAT = Current Means Test Status
+6 ; IVMCEB = Previous Means Test Status
+7 ; IVM10 = Date/Time Test Completed
+8 ;
+9 NEW IFN,DATA,SSN,X
+10 ;
+11 ;SSN
+12 IF $DATA(^DPT(DFN,.36))
SET X=^DPT(DFN,.36)
IF +X
SET SSN=$PIECE(X,"^",4)
+13 IF SSN=""
SET X=$PIECE(^DPT(DFN,0),"^",9)
IF X]""
SET SSN=$EXTRACT(X,6,10)
+14 ;
+15 ; External Reference to ^DGBT(392.2 supported by DBIA #6015 ;DS THIS FILE DATA DOESNT EXIST
+16 SET IFN=$$FIND1^DIC(392.2,"","MXQ",DFN,"","","ERR")
+17 ; Check if Beneficiary Travel Date Certified is within the last year
+18 ;I $$GET1^DIQ(392.2,IFN,"DATE CERTIFIED","I")<($P(DT,".",1)-10000) Q
+19 ;
+20 ; Input raw data into DATA array to set variables in Bulletin
+21 ;
+22 ; Patient DFN number
+23 SET DATA(10)=DFN
+24 ; Patient Name
+25 SET DATA(1)=$$GET1^DIQ(2,DFN,"NAME","I")
+26 ; Last 4 of SSN
+27 SET DATA(2)=SSN
+28 ; Patient VPID
+29 SET DATA(3)=$$GETICN^MPIF001(DFN)
+30 ; Patient IEN
+31 SET DATA(4)=DFN
+32 ; Station Number
+33 SET DATA(5)=$PIECE($$SITE^VASITE(),"^",3)
+34 ; Previous Category
+35 SET DATA(6)=IVMCEB
+36 ; New Category
+37 SET DATA(7)=DGCAT
+38 ; Date of Test
+39 SET Y=$PIECE(IVM10,".")
XECUTE ^DD("DD")
+40 SET DATA(8)=Y
+41 ; Converted Income Year
+42 SET Y=$$LYR^DGMTSCU1(IVM10)
XECUTE ^DD("DD")
+43 SET DATA(9)=Y
+44 ;
+45 DO SENDBUL
+46 ;
+47 QUIT
+48 ;
KILL ; Remove RX Bulletin - Not used at this time
+1 ;
+2 ; This is a placeholder should it be found in the future that any data from the SET
+3 ; needs cleaned up.
+4 ;
+5 QUIT
+6 ;
SENDBUL ; transmit bulletin
+1 ;
+2 ; Protect Fileman from Mailman call
+3 NEW DIC,DIX,DIY,DO,DD,DFN,VSITE,XMINSTR
+4 NEW DICRREC,DIDATA,DIEFAR,DIEFCNOD,DIEFDAS,DIEFECNT,DIEFF,DIEFFLAG
+5 NEW DIEFFLD,DIEFFLST,DIEFFREF,DIEFFVAL,DIEFFXR,DIEFI,DIEFIEN,DIEFLEV
+6 NEW DIEFNODE,DIEFNVAL,DIEFOUT,DIEFOVAL,DIEFRFLD,DIEFRLST,DIEFSORK
+7 NEW DIEFSPOT,DIEFTMP,DIEFTREF,DIFLD,DIFM,DIQUIET,DISYS,D,D0,DA
+8 ;
+9 ; Set From Line of Email
+10 SET XMINSTR("FROM")=.5
+11 ;
+12 ; Send email
+13 ;D SENDBULL^XMXAPI(DUZ,"RX COPAY TEST",.DATA,,,.XMINSTR)
+14 ;EAS BT CLAIMS PROCESSING
DO SENDBULL^XMXAPI(DUZ,"EAS BT CLAIMS PROCESSING",.DATA,,,.XMINSTR)
+15 ;
+16 ;
+17 QUIT
+18 ;
