- 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 Feb 18, 2025@23:20:05 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 ;