| 1 | IBCNEDE ;DAOU/DAC - IIV DATA EXTRACTS ;04-JUN-2002
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**184,271,300**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;**Program Description**
|
|---|
| 6 | ; This program is the main driver for all data extracts associated
|
|---|
| 7 | ; with the Insurance Identification and Verification interface.
|
|---|
| 8 | ; This program will run each extract in the specified order, which
|
|---|
| 9 | ; populates the IIV Transmission File (sometimes it creates/updates
|
|---|
| 10 | ; an entry in the insurance buffer as well). It then begins to
|
|---|
| 11 | ; process the inquiries in the IIV Transmission File.
|
|---|
| 12 | ; 08-08-2002
|
|---|
| 13 | ; As this program will run in the background the variable ZTSTOP
|
|---|
| 14 | ; can be returned from any of the extracts should a TaskMan stop
|
|---|
| 15 | ; request occur. Also, clear out the task record before exiting.
|
|---|
| 16 | ; 08-09-2002
|
|---|
| 17 | ; Added check for "~NO PAYER", if it does not exist, build it
|
|---|
| 18 | ;
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | EN ; Entry Point
|
|---|
| 22 | ; Prevent simultaneous runs
|
|---|
| 23 | ; Set error trap to ensure that lock is released
|
|---|
| 24 | N $ES,$ET
|
|---|
| 25 | S $ET="D ER^IBCNEDE"
|
|---|
| 26 | ; Check lock
|
|---|
| 27 | L +^TMP("IBCNEDE"):1 I '$T D G ENX
|
|---|
| 28 | . I '$D(ZTSK) W !!,"The IIV Nightly Task is already running, please retry later." D PAUSE^VALM1
|
|---|
| 29 | ; Reset reg ack flag
|
|---|
| 30 | S $P(^IBE(350.9,1,51),U,22)=""
|
|---|
| 31 | ; If "~NO PAYER" is not a valid Payer File entry, rebuild it from
|
|---|
| 32 | ; the existing utility
|
|---|
| 33 | I '$$FIND1^DIC(365.12,,"X","~NO PAYER") D PAYR^IBCNEUT2
|
|---|
| 34 | ;
|
|---|
| 35 | ; Confirm that all necessary tables have been loaded
|
|---|
| 36 | ; before the extract is run
|
|---|
| 37 | I '$$TBLCHK() G EN1
|
|---|
| 38 | ;
|
|---|
| 39 | D AMCHECK^IBCNEUT6 ; ensure Auto Match entries are valid
|
|---|
| 40 | ;
|
|---|
| 41 | ; Run All 4 extracts and launch IBCNEDEP(Inquiries)
|
|---|
| 42 | D EN^IBCNEDE1 ; Insurance Buffer Extract
|
|---|
| 43 | ; Check to see if background process has been stopped, if so quit.
|
|---|
| 44 | I $G(ZTSTOP) G ENX
|
|---|
| 45 | D EN^IBCNEDE2 ; Pre Reg Extract
|
|---|
| 46 | ; Check to see if background process has been stopped, if so quit.
|
|---|
| 47 | I $G(ZTSTOP) G ENX
|
|---|
| 48 | D EN^IBCNEDE3 ; Non Verified Extract
|
|---|
| 49 | ; Check to see if background process has been stopped, if so quit.
|
|---|
| 50 | I $G(ZTSTOP) G ENX
|
|---|
| 51 | D EN^IBCNEDE4 ; No Insurance Extract
|
|---|
| 52 | ; Check to see if background process has been stopped, if so quit.
|
|---|
| 53 | EN1 I $G(ZTSTOP) G ENX
|
|---|
| 54 | ; Send enrollment message
|
|---|
| 55 | D ^IBCNEHLM
|
|---|
| 56 | I $G(ZTSTOP) G ENX
|
|---|
| 57 | I '$G(QFL) D
|
|---|
| 58 | . ; Wait for 'AA' acknowledgement
|
|---|
| 59 | . D WAIT Q:'+QFL
|
|---|
| 60 | . KILL QFL
|
|---|
| 61 | . ;
|
|---|
| 62 | . D ^IBCNEDEP ; Inquiries Processing
|
|---|
| 63 | ;
|
|---|
| 64 | ; Check to see if background process has been stopped, if so quit.
|
|---|
| 65 | I $G(ZTSTOP) G ENX
|
|---|
| 66 | D MMQ ; Queue the Daily MailMan message
|
|---|
| 67 | ; Send MailMan message if first of month to report on records
|
|---|
| 68 | ; eligible to be purged
|
|---|
| 69 | I +$E($P($$NOW^XLFDT(),"."),6,7)=1 D MMPURGE^IBCNEKI2
|
|---|
| 70 | ;
|
|---|
| 71 | ENX ; Purge task record - if queued
|
|---|
| 72 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 73 | L -^TMP("IBCNEDE")
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
| 76 | TBLCHK() ;
|
|---|
| 77 | ; Confirm that at least one IIV payer and that all X12 tables
|
|---|
| 78 | ; have been loaded
|
|---|
| 79 | N PAY,PAYIEN,PAYOK,TBLOK,II
|
|---|
| 80 | S (PAY,PAYIEN,PAYOK)="",TBLOK=1
|
|---|
| 81 | F S PAY=$O(^IBE(365.12,"B",PAY)) Q:PAY=""!PAYOK I PAY'="~NO PAYER" D
|
|---|
| 82 | . F S PAYIEN=$O(^IBE(365.12,"B",PAY,PAYIEN)) Q:PAYIEN=""!PAYOK D
|
|---|
| 83 | .. I $$PYRAPP^IBCNEUT5("IIV",PAYIEN) S PAYOK=1 Q
|
|---|
| 84 | I PAYOK D
|
|---|
| 85 | . F II=11:1:18,21 I $O(^IBE(II*.001+365,"B",""))="" S TBLOK="" Q
|
|---|
| 86 | Q PAYOK&TBLOK
|
|---|
| 87 | ;
|
|---|
| 88 | WAIT ; Wait for acknowledgement comes back from EC
|
|---|
| 89 | ; Hang for 60 seconds and check status again
|
|---|
| 90 | ; Try 360 times for a total of 21600 seconds (6 hours)
|
|---|
| 91 | S QFL=0,CT=0
|
|---|
| 92 | F D Q:QFL'=""!(CT>360)
|
|---|
| 93 | . S QFL=$$GET1^DIQ(350.9,"1,",51.22,"I")
|
|---|
| 94 | . Q:QFL'=""
|
|---|
| 95 | . HANG 60 S CT=CT+1
|
|---|
| 96 | KILL CT
|
|---|
| 97 | Q
|
|---|
| 98 | ;
|
|---|
| 99 | FRESHDT(EXT,STALEDYS) ; Calculate Freshness
|
|---|
| 100 | ; Ext - ien of extract for future purposes
|
|---|
| 101 | ; Staledys - # of days in the past in which an insurance verification
|
|---|
| 102 | ; is considered still valid/current
|
|---|
| 103 | N STALEDT
|
|---|
| 104 | S STALEDT=$$FMADD^XLFDT(DT,-STALEDYS)
|
|---|
| 105 | Q STALEDT
|
|---|
| 106 | ;
|
|---|
| 107 | ; ---------------------------------------------------
|
|---|
| 108 | MMQ ; This procedure is responsible for scheduling the creation and
|
|---|
| 109 | ; sending of the daily MailMan statistical message if the site has
|
|---|
| 110 | ; defined this appropriately in the IIV site parameters.
|
|---|
| 111 | ;
|
|---|
| 112 | NEW IIV,CURRTIME,MTIME,MSG,Y,MGRP
|
|---|
| 113 | NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
|
|---|
| 114 | ;
|
|---|
| 115 | S IIV=$G(^IBE(350.9,1,51))
|
|---|
| 116 | I '$P(IIV,U,2) G MMQX ; site does not want daily messages
|
|---|
| 117 | I '$P(IIV,U,3) G MMQX ; MM message time is not defined
|
|---|
| 118 | I '$P(IIV,U,4) G MMQX ; Mail Group is not defined
|
|---|
| 119 | ;
|
|---|
| 120 | S CURRTIME=$P($H,",",2) ; current $H time
|
|---|
| 121 | S MTIME=DT_"."_$P(IIV,U,3) ; build a FileMan date/time
|
|---|
| 122 | S MTIME=$$FMTH^XLFDT(MTIME) ; convert to $H format
|
|---|
| 123 | S MTIME=$P(MTIME,",",2) ; $H time of MM message
|
|---|
| 124 | ;
|
|---|
| 125 | ; If the current time is after the MailMan message time, then
|
|---|
| 126 | ; schedule the MM message for tomorrow at that time.
|
|---|
| 127 | I CURRTIME>MTIME S ZTDTH=($H+1)_","_MTIME
|
|---|
| 128 | ;
|
|---|
| 129 | ; Otherwise, schedule it for later today
|
|---|
| 130 | E S ZTDTH=+$H_","_MTIME
|
|---|
| 131 | ;
|
|---|
| 132 | ; Set up the other TaskManager variables
|
|---|
| 133 | S ZTRTN="MAILMSG^IBCNERP7"
|
|---|
| 134 | S ZTDESC="IIV Daily Statistics E-Mail"
|
|---|
| 135 | S ZTIO=""
|
|---|
| 136 | D ^%ZTLOAD ; Call TaskManager
|
|---|
| 137 | I $G(ZTSK) G MMQX ; Task# is OK so get out
|
|---|
| 138 | ;
|
|---|
| 139 | ; Send a MailMan message if this Task could not get scheduled
|
|---|
| 140 | S MSG(1)="TaskManager could not schedule the daily IIV MailMan message"
|
|---|
| 141 | S MSG(2)="at the specified time of "_$E($P(IIV,U,3),1,2)_":"_$E($P(IIV,U,3),3,4)_"."
|
|---|
| 142 | S MSG(3)="This is defined in the IIV Site Parameters option."
|
|---|
| 143 | ; Set to IB site parameter MAILGROUP
|
|---|
| 144 | S MGRP=$$MGRP^IBCNEUT5()
|
|---|
| 145 | D MSG^IBCNEUT5(MGRP,"IIV Statistical Message Not Sent","MSG(")
|
|---|
| 146 | ;
|
|---|
| 147 | MMQX ;
|
|---|
| 148 | Q
|
|---|
| 149 | ;
|
|---|
| 150 | ER ; Unlock the IIV Nightly Task and return to log error
|
|---|
| 151 | L -^TMP("IBCNEDE")
|
|---|
| 152 | D ^%ZTER
|
|---|
| 153 | D UNWIND^%ZTER
|
|---|
| 154 | Q
|
|---|
| 155 | ;
|
|---|
