IBCNEDE ;DAOU/DAC - eIV DATA EXTRACTS ;07-MAY-2015
;;2.0;INTEGRATED BILLING;**184,271,300,416,438,497,549,593,595,621,659,664,668,687,737**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
;**Program Description**
; This program is the main driver for all data extracts associated
; with the electronic Insurance Verification interface.
; This program will run each extract in the specified order, which
; populates the eIV Transmission File (sometimes it creates/updates
; an entry in the insurance buffer as well). It then begins to
; process the inquiries in the eIV Transmission File.
; 08-08-2002
; As this program will run in the background the variable ZTSTOP
; can be returned from any of the extracts should a TaskMan stop
; request occur. Also, clear out the task record before exiting.
;
;IB*737/TAZ - Remove references to "~NO PAYER" and Most Popular Payer.
Q
;
EN ; Entry Point
; Prevent simultaneous runs
; Set error trap to ensure that lock is released
;
;/vd-IB*2.0*659 - Quit if VAMC Site is MANILA (#358) & EIV is disabled for MANILA.
I $P($$SITE^VASITE,U,3)=358,$$GET1^DIQ(350.9,"1,",51.33,"I")="N" Q
;
; IB*2.0*549 - Quit if Nightly Extract Master switch is off
Q:$$GET1^DIQ(350.9,"1,",51.28,"I")="N"
;
N $ES,$ET
S $ET="D ER^IBCNEDE"
; Check lock
L +^TMP("IBCNEDE"):1 I '$T D G ENX
. I '$D(ZTSK) W !!,"The eIV Nightly Task is already running, please retry later." D PAUSE^VALM1
;
; Reset reg ack flag
S $P(^IBE(350.9,1,51),U,22)=""
;
; IB**2.0*687/DW removed check for new person entries to routine IBCNINS & expanded it
; to include other non eIV related entries
;D CHKPER ; IB*2.0*595/DM Check for New Person (#200) EIV entries
;
; Confirm all necessary tables have been loaded before running extracts
I '$$TBLCHK() G EN1
;
;IB*2.0*593/TAZ/HAN - Add job to update Covered by Health Insurance flag
D EN^IBCNERTC($P($$NOW^XLFDT,"."))
;
D AMCHECK^IBCNEUT6 ; ensure Auto Match entries are valid
;
; *** RUN THE EXTRACTS - save entries to TQ file #365.1
D EXTRACTS ;IB*664/DJW - Moved code to a function
;
EN1 I $G(ZTSTOP) G ENX ;This allows processing of inquiries to stop
; if the background job was stopped.
;
; *** DAILY REGISTRATION - Ask FSC if we are allowed to send our 270s
D ^IBCNEHLM ; Send enrollment message / registration message
;
;IB*2.0*664/DJW - add IBLLIEN,IBMSGIEN, determine if 'IIV EC' logical link is working
N IBLLIEN,IBMSGIEN
S IBLLIEN=$O(^HLCS(870,"B","IIV EC","")) ;Get IEN for the 'IIV EC' Logical Link.
S IBMSGIEN=$O(^HLMA("AC","O",IBLLIEN,"")) ;Get IEN of next msg going to FSC
; ; if IBMSGIEN is null then the registration msg went out and IIV EC is fine
;
I $G(ZTSTOP) G ENX
I '$G(QFL) D
. ; Wait for 'AA' acknowledgement of the registration message (permission to send 270s)
. D WAIT Q:'+QFL
. KILL QFL
. ;
. D ^IBCNEDEP ; Inquiries Processing *** SEND 270s to FSC
;
D CKIIVEC(IBMSGIEN) ; Confirm messages are NOT stuck in the "IIV EC" HL7 logical link
;
; Check to see if background process has been stopped, if so quit.
I $G(ZTSTOP) G ENX
D MMQ ; Queue the Daily MailMan message (this is the one that FSC can read the stats)
D DSTQ ; queue daily statistical message to FSC
;
; Send MailMan message if first of month to report on records eligible to be purged
I +$E($P($$NOW^XLFDT(),"."),6,7)=1 D MMPURGE^IBCNEKI2
;
ENX ; Purge task record - if queued
I $D(ZTQUEUED) S ZTREQ="@"
L -^TMP("IBCNEDE")
Q
;====================================================
D EN^IBCNEDE1 ; Insurance Buffer Extract
I $G(ZTSTOP) Q ; If background process was stopped quit.
D EN^IBCNEDE2 ; Appointment Extract
I $G(ZTSTOP) Q ; If background process was stopped quit.
D EN^IBCNEDE4 ; IB*2.0*621/DM add the EICD extract (formerly No Insurance)
Q
;--------------------------------
;/vd IB*2*659 - Beginning of new code to check if the IIV EC Logical Link is running.
;IB*2*664/DJW - reworked code, waiting 20 seconds to check is not enough time
CKIIVEC(IBMSGIEN) ; Verifying that the IIV EC Logical Link is up and running.
N IEN,XMSUB,XMTEXT,XMY,XX,YY
I $$DOW^XLFDT(DT)="Sunday" Q ;Don't report stuck queues on Sunday.
;
; If IBMSGIEN is null then the registration msg went out immediately and 'IIV EC' is fine
Q:IBMSGIEN=""
;
; It can take time (hours) for a message to go out 'IIV EC' as FSC could be down.
; Plus several sites are sending messages to FSC at the same time. Therefore,
; we are checking this at the end of this routine which could be at least 6 hours
; from when we tried to send the initial registration message.
; Refer to the tag 'WAIT' for the timing.
;
S IEN=$O(^HLMA("AC","O",IBLLIEN,""))
I (IEN'=""),(IBMSGIEN=IEN) D ; The initial registration msg hasn't processed.
. ; Send a Mailman msg to notify e-Biz that the IIV EC Logical Link seems to be down.
. S XX=$$SITE^VASITE()
. S YY=$P(XX,"^",2)_" (#"_$P(XX,"^",3)_")"
. ; Send a MailMan message if link is not processing records
. I $$PROD^XUPROD(1) S XMY("VHAeInsuranceRapidResponse@domain.ext")="" ; Only send to eInsurance Rapid Response if in Production
. ;
. D MSG004^IBCNEMS1(.MSG,YY)
. ;
. D MSG^IBCNEUT5(,MSG(1),"MSG(",1,.XMY) ; sends to postmaster if XMY is empty
. ;
. Q
Q
;/vd-IB*2*659 - End of code added.
;--------------------------------------------
TBLCHK() ;
; Confirm that at least one eIV payer and that all X12 tables
; have been loaded
N PAY,PAYIEN,PAYOK,TBLOK,II
S (PAY,PAYIEN,PAYOK)="",TBLOK=1
F S PAY=$O(^IBE(365.12,"B",PAY)) Q:PAY="" D Q:PAYOK
. F S PAYIEN=$O(^IBE(365.12,"B",PAY,PAYIEN)) Q:PAYIEN="" D Q:PAYOK
.. ;IB*668/TAZ - Changed Payer Application from IIV to EIV
.. I $$PYRAPP^IBCNEUT5("EIV",PAYIEN) S PAYOK=1 Q
I PAYOK D
. F II=11:1:18,21 I $O(^IBE(II*.001+365,"B",""))="" S TBLOK="" Q
Q PAYOK&TBLOK
;----------------------------------------------
WAIT ; Wait for acknowledgement comes back from EC
; Hang for 60 seconds and check status again
; Try 360 times for a total of 21600 seconds (6 hours)
S QFL=0,CT=0
H 20 ;IB*2*664/DJW extra 20 seconds here helps w/ testing
F D Q:QFL'=""!(CT>360)
. S QFL=$$GET1^DIQ(350.9,"1,",51.22,"I")
. Q:QFL'=""
. HANG 60 S CT=CT+1
KILL CT
Q
;---------------------------------------------------
FRESHDT(EXT,STALEDYS) ; Calculate Freshness
; Ext - ien of extract for future purposes
; Staledys - # of days in the past in which an insurance verification
; is considered still valid/current
N STALEDT
S STALEDT=$$FMADD^XLFDT(DT,-STALEDYS)
Q STALEDT
; ---------------------------------------------------
MMQ ; This procedure is responsible for scheduling the creation and
; sending of the daily MailMan statistical message if the site has
; defined this appropriately in the eIV site parameters.
;
NEW IIV,CURRTIME,MTIME,MSG,Y,MGRP
NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
;
S IIV=$G(^IBE(350.9,1,51))
I '$P(IIV,U,2) G MMQX ; site does not want daily messages
I '$P(IIV,U,3) G MMQX ; MM message time is not defined
I '$P(IIV,U,4) G MMQX ; Mail Group is not defined
;
S CURRTIME=$P($H,",",2) ; current $H time
S MTIME=DT_"."_$P(IIV,U,3) ; build a FileMan date/time
S MTIME=$$FMTH^XLFDT(MTIME) ; convert to $H format
S MTIME=$P(MTIME,",",2) ; $H time of MM message
;
; If the current time is after the MailMan message time, then
; schedule the MM message for tomorrow at that time.
I CURRTIME>MTIME S ZTDTH=($H+1)_","_MTIME
;
; Otherwise, schedule it for later today
E S ZTDTH=+$H_","_MTIME
;
; Set up the other TaskManager variables
S ZTRTN="MAILMSG^IBCNERP7"
S ZTDESC="eIV Daily Statistics E-Mail"
S ZTIO=""
D ^%ZTLOAD ; Call TaskManager
I $G(ZTSK) G MMQX ; Task# is OK so get out
;
; Send a MailMan message if this Task could not get scheduled
S MSG(1)="TaskManager could not schedule the daily eIV MailMan message"
S MSG(2)="at the specified time of "_$E($P(IIV,U,3),1,2)_":"_$E($P(IIV,U,3),3,4)_"."
S MSG(3)="This is defined in the eIV Site Parameters option."
; Set to IB site parameter MAILGROUP
S MGRP=$$MGRP^IBCNEUT5()
D MSG^IBCNEUT5(MGRP,"eIV Statistical Message Not Sent","MSG(")
;
MMQX ;
Q
;----------------------------------------------------
ER ; Unlock the eIV Nightly Task and return to log error
L -^TMP("IBCNEDE")
D ^%ZTER
D UNWIND^%ZTER
Q
;-----------------------------------------------------
DSTQ ; This procedure is responsible for scheduling the creation and
; sending of the daily statistical message to FSC.
;
N IIV,CURRTIME,MTIME,MSG,MGRP
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
;
S IIV=$G(^IBE(350.9,1,51))
I '$P(IIV,U,3) G DSTQX ; MM message time is not defined
;
S CURRTIME=$P($H,",",2) ; current $H time
S MTIME=DT_"."_$P(IIV,U,3) ; build a FileMan date/time
S MTIME=$$FMTH^XLFDT(MTIME) ; convert to $H format
S MTIME=$P(MTIME,",",2) ; $H time of MM message
;
; If the current time is after the MailMan message time, then schedule the message for tomorrow at that time.
; Otherwise, schedule it for later today.
S ZTDTH=$S(CURRTIME>MTIME:$H+1,1:+$H)_","_MTIME
;
; Set up the other TaskManager variables
S ZTRTN="EN1^IBCNEHLM"
S ZTDESC="eIV Daily Statistics HL7 Message"
S ZTIO=""
D ^%ZTLOAD ; Call TaskManager
I $G(ZTSK) G DSTQX ; Task# is OK so get out
;
; Send a MailMan message if this Task could not get scheduled
S MSG(1)="TaskManager could not schedule the daily eIV Statistics HL7 message"
S MSG(2)="at the specified time of "_$E($P(IIV,U,3),1,2)_":"_$E($P(IIV,U,3),3,4)_"."
S MSG(3)="This is defined in the eIV Site Parameters option."
; Set to IB site parameter MAILGROUP
S MGRP=$$MGRP^IBCNEUT5() I MGRP'="" D MSG^IBCNEUT5(MGRP,"eIV Statistical HL7 Message Not Sent","MSG(")
;
DSTQX ;
Q
CHKPER ; IB*687 moved to routine IBCNINS as we had to check for other non-eIV non-human users
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEDE 10309 printed Apr 09, 2024@21:09:46 Page 2
IBCNEDE ;DAOU/DAC - eIV DATA EXTRACTS ;07-MAY-2015
+1 ;;2.0;INTEGRATED BILLING;**184,271,300,416,438,497,549,593,595,621,659,664,668,687,737**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;**Program Description**
+5 ; This program is the main driver for all data extracts associated
+6 ; with the electronic Insurance Verification interface.
+7 ; This program will run each extract in the specified order, which
+8 ; populates the eIV Transmission File (sometimes it creates/updates
+9 ; an entry in the insurance buffer as well). It then begins to
+10 ; process the inquiries in the eIV Transmission File.
+11 ; 08-08-2002
+12 ; As this program will run in the background the variable ZTSTOP
+13 ; can be returned from any of the extracts should a TaskMan stop
+14 ; request occur. Also, clear out the task record before exiting.
+15 ;
+16 ;IB*737/TAZ - Remove references to "~NO PAYER" and Most Popular Payer.
+17 QUIT
+18 ;
EN ; Entry Point
+1 ; Prevent simultaneous runs
+2 ; Set error trap to ensure that lock is released
+3 ;
+4 ;/vd-IB*2.0*659 - Quit if VAMC Site is MANILA (#358) & EIV is disabled for MANILA.
+5 IF $PIECE($$SITE^VASITE,U,3)=358
IF $$GET1^DIQ(350.9,"1,",51.33,"I")="N"
QUIT
+6 ;
+7 ; IB*2.0*549 - Quit if Nightly Extract Master switch is off
+8 if $$GET1^DIQ(350.9,"1,",51.28,"I")="N"
QUIT
+9 ;
+10 NEW $ESTACK,$ETRAP
+11 SET $ETRAP="D ER^IBCNEDE"
+12 ; Check lock
+13 LOCK +^TMP("IBCNEDE"):1
IF '$TEST
Begin DoDot:1
+14 IF '$DATA(ZTSK)
WRITE !!,"The eIV Nightly Task is already running, please retry later."
DO PAUSE^VALM1
End DoDot:1
GOTO ENX
+15 ;
+16 ; Reset reg ack flag
+17 SET $PIECE(^IBE(350.9,1,51),U,22)=""
+18 ;
+19 ; IB**2.0*687/DW removed check for new person entries to routine IBCNINS & expanded it
+20 ; to include other non eIV related entries
+21 ;D CHKPER ; IB*2.0*595/DM Check for New Person (#200) EIV entries
+22 ;
+23 ; Confirm all necessary tables have been loaded before running extracts
+24 IF '$$TBLCHK()
GOTO EN1
+25 ;
+26 ;IB*2.0*593/TAZ/HAN - Add job to update Covered by Health Insurance flag
+27 DO EN^IBCNERTC($PIECE($$NOW^XLFDT,"."))
+28 ;
+29 ; ensure Auto Match entries are valid
DO AMCHECK^IBCNEUT6
+30 ;
+31 ; *** RUN THE EXTRACTS - save entries to TQ file #365.1
+32 ;IB*664/DJW - Moved code to a function
DO EXTRACTS
+33 ;
EN1 ;This allows processing of inquiries to stop
IF $GET(ZTSTOP)
GOTO ENX
+1 ; if the background job was stopped.
+2 ;
+3 ; *** DAILY REGISTRATION - Ask FSC if we are allowed to send our 270s
+4 ; Send enrollment message / registration message
DO ^IBCNEHLM
+5 ;
+6 ;IB*2.0*664/DJW - add IBLLIEN,IBMSGIEN, determine if 'IIV EC' logical link is working
+7 NEW IBLLIEN,IBMSGIEN
+8 ;Get IEN for the 'IIV EC' Logical Link.
SET IBLLIEN=$ORDER(^HLCS(870,"B","IIV EC",""))
+9 ;Get IEN of next msg going to FSC
SET IBMSGIEN=$ORDER(^HLMA("AC","O",IBLLIEN,""))
+10 ; ; if IBMSGIEN is null then the registration msg went out and IIV EC is fine
+11 ;
+12 IF $GET(ZTSTOP)
GOTO ENX
+13 IF '$GET(QFL)
Begin DoDot:1
+14 ; Wait for 'AA' acknowledgement of the registration message (permission to send 270s)
+15 DO WAIT
if '+QFL
QUIT
+16 KILL QFL
+17 ;
+18 ; Inquiries Processing *** SEND 270s to FSC
DO ^IBCNEDEP
End DoDot:1
+19 ;
+20 ; Confirm messages are NOT stuck in the "IIV EC" HL7 logical link
DO CKIIVEC(IBMSGIEN)
+21 ;
+22 ; Check to see if background process has been stopped, if so quit.
+23 IF $GET(ZTSTOP)
GOTO ENX
+24 ; Queue the Daily MailMan message (this is the one that FSC can read the stats)
DO MMQ
+25 ; queue daily statistical message to FSC
DO DSTQ
+26 ;
+27 ; Send MailMan message if first of month to report on records eligible to be purged
+28 IF +$EXTRACT($PIECE($$NOW^XLFDT(),"."),6,7)=1
DO MMPURGE^IBCNEKI2
+29 ;
ENX ; Purge task record - if queued
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 LOCK -^TMP("IBCNEDE")
+3 QUIT
+4 ;====================================================
+1 ; Insurance Buffer Extract
DO EN^IBCNEDE1
+2 ; If background process was stopped quit.
IF $GET(ZTSTOP)
QUIT
+3 ; Appointment Extract
DO EN^IBCNEDE2
+4 ; If background process was stopped quit.
IF $GET(ZTSTOP)
QUIT
+5 ; IB*2.0*621/DM add the EICD extract (formerly No Insurance)
DO EN^IBCNEDE4
+6 QUIT
+7 ;--------------------------------
+8 ;/vd IB*2*659 - Beginning of new code to check if the IIV EC Logical Link is running.
+9 ;IB*2*664/DJW - reworked code, waiting 20 seconds to check is not enough time
CKIIVEC(IBMSGIEN) ; Verifying that the IIV EC Logical Link is up and running.
+1 NEW IEN,XMSUB,XMTEXT,XMY,XX,YY
+2 ;Don't report stuck queues on Sunday.
IF $$DOW^XLFDT(DT)="Sunday"
QUIT
+3 ;
+4 ; If IBMSGIEN is null then the registration msg went out immediately and 'IIV EC' is fine
+5 if IBMSGIEN=""
QUIT
+6 ;
+7 ; It can take time (hours) for a message to go out 'IIV EC' as FSC could be down.
+8 ; Plus several sites are sending messages to FSC at the same time. Therefore,
+9 ; we are checking this at the end of this routine which could be at least 6 hours
+10 ; from when we tried to send the initial registration message.
+11 ; Refer to the tag 'WAIT' for the timing.
+12 ;
+13 SET IEN=$ORDER(^HLMA("AC","O",IBLLIEN,""))
+14 ; The initial registration msg hasn't processed.
IF (IEN'="")
IF (IBMSGIEN=IEN)
Begin DoDot:1
+15 ; Send a Mailman msg to notify e-Biz that the IIV EC Logical Link seems to be down.
+16 SET XX=$$SITE^VASITE()
+17 SET YY=$PIECE(XX,"^",2)_" (#"_$PIECE(XX,"^",3)_")"
+18 ; Send a MailMan message if link is not processing records
+19 ; Only send to eInsurance Rapid Response if in Production
IF $$PROD^XUPROD(1)
SET XMY("VHAeInsuranceRapidResponse@domain.ext")=""
+20 ;
+21 DO MSG004^IBCNEMS1(.MSG,YY)
+22 ;
+23 ; sends to postmaster if XMY is empty
DO MSG^IBCNEUT5(,MSG(1),"MSG(",1,.XMY)
+24 ;
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;/vd-IB*2*659 - End of code added.
+28 ;--------------------------------------------
TBLCHK() ;
+1 ; Confirm that at least one eIV payer and that all X12 tables
+2 ; have been loaded
+3 NEW PAY,PAYIEN,PAYOK,TBLOK,II
+4 SET (PAY,PAYIEN,PAYOK)=""
SET TBLOK=1
+5 FOR
SET PAY=$ORDER(^IBE(365.12,"B",PAY))
if PAY=""
QUIT
Begin DoDot:1
+6 FOR
SET PAYIEN=$ORDER(^IBE(365.12,"B",PAY,PAYIEN))
if PAYIEN=""
QUIT
Begin DoDot:2
+7 ;IB*668/TAZ - Changed Payer Application from IIV to EIV
+8 IF $$PYRAPP^IBCNEUT5("EIV",PAYIEN)
SET PAYOK=1
QUIT
End DoDot:2
if PAYOK
QUIT
End DoDot:1
if PAYOK
QUIT
+9 IF PAYOK
Begin DoDot:1
+10 FOR II=11:1:18,21
IF $ORDER(^IBE(II*.001+365,"B",""))=""
SET TBLOK=""
QUIT
End DoDot:1
+11 QUIT PAYOK&TBLOK
+12 ;----------------------------------------------
WAIT ; Wait for acknowledgement comes back from EC
+1 ; Hang for 60 seconds and check status again
+2 ; Try 360 times for a total of 21600 seconds (6 hours)
+3 SET QFL=0
SET CT=0
+4 ;IB*2*664/DJW extra 20 seconds here helps w/ testing
HANG 20
+5 FOR
Begin DoDot:1
+6 SET QFL=$$GET1^DIQ(350.9,"1,",51.22,"I")
+7 if QFL'=""
QUIT
+8 HANG 60
SET CT=CT+1
End DoDot:1
if QFL'=""!(CT>360)
QUIT
+9 KILL CT
+10 QUIT
+11 ;---------------------------------------------------
FRESHDT(EXT,STALEDYS) ; Calculate Freshness
+1 ; Ext - ien of extract for future purposes
+2 ; Staledys - # of days in the past in which an insurance verification
+3 ; is considered still valid/current
+4 NEW STALEDT
+5 SET STALEDT=$$FMADD^XLFDT(DT,-STALEDYS)
+6 QUIT STALEDT
+7 ; ---------------------------------------------------
MMQ ; This procedure is responsible for scheduling the creation and
+1 ; sending of the daily MailMan statistical message if the site has
+2 ; defined this appropriately in the eIV site parameters.
+3 ;
+4 NEW IIV,CURRTIME,MTIME,MSG,Y,MGRP
+5 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
+6 ;
+7 SET IIV=$GET(^IBE(350.9,1,51))
+8 ; site does not want daily messages
IF '$PIECE(IIV,U,2)
GOTO MMQX
+9 ; MM message time is not defined
IF '$PIECE(IIV,U,3)
GOTO MMQX
+10 ; Mail Group is not defined
IF '$PIECE(IIV,U,4)
GOTO MMQX
+11 ;
+12 ; current $H time
SET CURRTIME=$PIECE($HOROLOG,",",2)
+13 ; build a FileMan date/time
SET MTIME=DT_"."_$PIECE(IIV,U,3)
+14 ; convert to $H format
SET MTIME=$$FMTH^XLFDT(MTIME)
+15 ; $H time of MM message
SET MTIME=$PIECE(MTIME,",",2)
+16 ;
+17 ; If the current time is after the MailMan message time, then
+18 ; schedule the MM message for tomorrow at that time.
+19 IF CURRTIME>MTIME
SET ZTDTH=($HOROLOG+1)_","_MTIME
+20 ;
+21 ; Otherwise, schedule it for later today
+22 IF '$TEST
SET ZTDTH=+$HOROLOG_","_MTIME
+23 ;
+24 ; Set up the other TaskManager variables
+25 SET ZTRTN="MAILMSG^IBCNERP7"
+26 SET ZTDESC="eIV Daily Statistics E-Mail"
+27 SET ZTIO=""
+28 ; Call TaskManager
DO ^%ZTLOAD
+29 ; Task# is OK so get out
IF $GET(ZTSK)
GOTO MMQX
+30 ;
+31 ; Send a MailMan message if this Task could not get scheduled
+32 SET MSG(1)="TaskManager could not schedule the daily eIV MailMan message"
+33 SET MSG(2)="at the specified time of "_$EXTRACT($PIECE(IIV,U,3),1,2)_":"_$EXTRACT($PIECE(IIV,U,3),3,4)_"."
+34 SET MSG(3)="This is defined in the eIV Site Parameters option."
+35 ; Set to IB site parameter MAILGROUP
+36 SET MGRP=$$MGRP^IBCNEUT5()
+37 DO MSG^IBCNEUT5(MGRP,"eIV Statistical Message Not Sent","MSG(")
+38 ;
MMQX ;
+1 QUIT
+2 ;----------------------------------------------------
ER ; Unlock the eIV Nightly Task and return to log error
+1 LOCK -^TMP("IBCNEDE")
+2 DO ^%ZTER
+3 DO UNWIND^%ZTER
+4 QUIT
+5 ;-----------------------------------------------------
DSTQ ; This procedure is responsible for scheduling the creation and
+1 ; sending of the daily statistical message to FSC.
+2 ;
+3 NEW IIV,CURRTIME,MTIME,MSG,MGRP
+4 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
+5 ;
+6 SET IIV=$GET(^IBE(350.9,1,51))
+7 ; MM message time is not defined
IF '$PIECE(IIV,U,3)
GOTO DSTQX
+8 ;
+9 ; current $H time
SET CURRTIME=$PIECE($HOROLOG,",",2)
+10 ; build a FileMan date/time
SET MTIME=DT_"."_$PIECE(IIV,U,3)
+11 ; convert to $H format
SET MTIME=$$FMTH^XLFDT(MTIME)
+12 ; $H time of MM message
SET MTIME=$PIECE(MTIME,",",2)
+13 ;
+14 ; If the current time is after the MailMan message time, then schedule the message for tomorrow at that time.
+15 ; Otherwise, schedule it for later today.
+16 SET ZTDTH=$SELECT(CURRTIME>MTIME:$HOROLOG+1,1:+$HOROLOG)_","_MTIME
+17 ;
+18 ; Set up the other TaskManager variables
+19 SET ZTRTN="EN1^IBCNEHLM"
+20 SET ZTDESC="eIV Daily Statistics HL7 Message"
+21 SET ZTIO=""
+22 ; Call TaskManager
DO ^%ZTLOAD
+23 ; Task# is OK so get out
IF $GET(ZTSK)
GOTO DSTQX
+24 ;
+25 ; Send a MailMan message if this Task could not get scheduled
+26 SET MSG(1)="TaskManager could not schedule the daily eIV Statistics HL7 message"
+27 SET MSG(2)="at the specified time of "_$EXTRACT($PIECE(IIV,U,3),1,2)_":"_$EXTRACT($PIECE(IIV,U,3),3,4)_"."
+28 SET MSG(3)="This is defined in the eIV Site Parameters option."
+29 ; Set to IB site parameter MAILGROUP
+30 SET MGRP=$$MGRP^IBCNEUT5()
IF MGRP'=""
DO MSG^IBCNEUT5(MGRP,"eIV Statistical HL7 Message Not Sent","MSG(")
+31 ;
DSTQX ;
+1 QUIT
CHKPER ; IB*687 moved to routine IBCNINS as we had to check for other non-eIV non-human users
+1 QUIT
