- IBCNEDEP ;DAOU/ALA - Process Transaction Records ;14-OCT-2015
- ;;2.0;INTEGRATED BILLING;**184,271,300,416,438,506,533,549,601,621,713,737,778**;21-MAR-94;Build 28
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; This program finds records needing HL7 msg creation
- ; Periodically check for stop request for background task
- ;
- ; Variables
- ; RETR = # retries allowed
- ; RETRYFLG = determines if a Transmitted message can be resent
- ; MGRP = Msg Mailgroup
- ; FAIL = # of days before failure
- ; FMSG = Failure Mailman flag
- ; TMSG = Timeout Mailman flag
- ; FLDT = Failure date
- ; FUTDT = Future transmission date
- ; DFN = Patient IEN
- ; PAYR = Payer IEN
- ; DTCRT = Date Created
- ; BUFF = Buffer File IEN
- ; NRETR = # of retries accomplished
- ; IHCNT = Count of successful HL7 msgs
- ; QUERY = Type of msg
- ; EXT = Which extract produced record
- ; SRVDT = Service Date
- ; IRIEN = Insurance Record IEN
- ; NTRAN = # of transmissions accomplished
- ; OVRIDE = Override Flag
- ; BNDL = Bundle Verification Flag
- ;
- EN ; Entry point
- ;
- ; Start processing of data
- K ^TMP("HLS",$J),^TMP("IBQUERY",$J)
- ; Initialize count for periodic TaskMan check
- ;IB*533 RRA CREATE VARIABLES TO ACCOUNT FOR MAX SENT LIMITATIONS
- N IBMAXCNT,IBSENT
- S IBCNETOT=0,IBSENT=0
- ;
- S C1CODE=$O(^IBE(365.15,"B","C1",""))
- ; Get IB Site Parameters
- S IBCNEP=$G(^IBE(350.9,1,51))
- S RETR=+$P(IBCNEP,U,6),BNDL=$P(IBCNEP,U,23)
- S MGRP=$$MGRP^IBCNEUT5()
- S FAIL=$P(IBCNEP,U,5),TMSG=$P(IBCNEP,U,7),FMSG=$P(IBCNEP,U,20)
- S RETRYFLG=$P(IBCNEP,U,26) ;set value to (#350.9, 51.26) - IB*2.0*506
- S IBMAXCNT=$P(IBCNEP,U,15) ;get HL7 MAXIMUM NUMBER - IB*533
- S FLDT=$$FMADD^XLFDT(DT,-FAIL)
- ; Statuses
- ; 1 = Ready To Transmit
- ; 2 = Transmitted
- ; 4 = Hold
- ; 6 = Retry
- ;
- ; If the status is 'HOLD' is this a 'Retry'? - IB*2.0*506
- ; DO HLD ; this is not to be called unless the status of HOLD is reinstated...see HLD tag
- ; below and the code within ERROR^IBCNEHL3
- ;
- ; Exit based on stop request
- I $G(ZTSTOP) G EXIT
- ;
- TMT ; If the status is 'Transmitted' - is this a 'Retry' or
- ; 'Comm Failure'
- S IEN=""
- F S IEN=$O(^IBCN(365.1,"AC",2,IEN)) Q:IEN="" D Q:$G(ZTSTOP)
- . ; Update count for periodic check
- . S IBCNETOT=IBCNETOT+1
- . ; Check for request to stop background job, periodically
- . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
- . ;
- . NEW TDATA,DTCRT,BUFF,DFN,PAYR,XMSUB,VERID,EXT
- . S TDATA=$G(^IBCN(365.1,IEN,0))
- . S DFN=$P(TDATA,U,2),PAYR=$P(TDATA,U,3)
- . S DTCRT=$P(TDATA,U,6)\1,BUFF=$P(TDATA,U,5)
- . S VERID=$P(TDATA,U,11)
- . S EXT=$P(TDATA,U,10)
- . ;
- . ; Check against the Failure Date
- . I (VERID="I")&(EXT=4) Q:DT<$$FMADD^XLFDT(DTCRT+30) ; IB*2.0*621 ; HAN
- . I (VERID'="I")&(EXT'=4)&(DTCRT>FLDT) Q
- . ;
- . ; If retries are defined
- . I (VERID'="I"&(EXT'=4))&(RETRYFLG="Y") D Q ; IB*2.0*506 ; IB*2.0*621
- .. ;
- .. I '$$PYRACTV^IBCNEDE7(PAYR) Q ; If Payer is not Nationally Active skip record - IB*2.0*506
- .. ;
- .. D SST^IBCNEUT2(IEN,6) ; mark TQ entry status as 'retry'
- .. Q
- . ;
- . D SST^IBCNEUT2(IEN,5) ; if RETRYFLG=NO set TQ record to 'communication failure'
- . ;
- . ; For msg in the Response file set the status to
- . ; 'Comm Failure'
- . D RSTA^IBCNEUT7(IEN)
- . I (VERID="I")&(EXT=4) D
- .. N IENS,RSUPDT,TRKIEN
- .. S TRKIEN=$O(^IBCN(365.18,"B",IEN,"")),IENS=TRKIEN_","
- .. S RSUPDT(365.18,IENS,.06)=$$GET1^DIQ(365.16,"1,"_IEN_",",.03) ;There is only one occurance for EICD Identification
- .. S RSUPDT(365.18,IENS,.07)=0 ;Set status to "Error"
- .. D FILE^DIE("","RSUPDT","ERROR")
- . ;
- . ; Set Buffer symbol to 'C1' (Comm Failure) ; used to be 'B12' - ien of 15
- . I BUFF'="" D BUFF^IBCNEUT2(BUFF,C1CODE) ; set to "#" communication failure - IB*2.0*506
- . ;
- . ; Issue comm fail MailMan msg only for ver'ns
- . I VERID="V" D CERR^IBCNEDEQ
- ;
- ; Exit for stop request
- I $G(ZTSTOP) G EXIT
- ;
- RET ; If status is 'Retry' ; retries only exist if the RETRYFLG=YES - IB*2.0*506
- S IEN=""
- F S IEN=$O(^IBCN(365.1,"AC",6,IEN)) Q:IEN="" D Q:$G(ZTSTOP)
- . ; Update count for periodic check
- . S IBCNETOT=IBCNETOT+1
- . ; Check for request to stop background job, periodically
- . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
- . ;
- . NEW TDATA,NRETR,PAYR,BUFF,DFN,MSG,RIEN,HIEN,XMSUB,VERID
- . S TDATA=$G(^IBCN(365.1,IEN,0))
- . S NRETR=$P(TDATA,U,8),PAYR=$P(TDATA,U,3)
- . S BUFF=$P(TDATA,U,5),DFN=$P(TDATA,U,2)
- . S VERID=$P(TDATA,U,11)
- . S NRETR=NRETR+1
- . ;
- . ; If retries are finished, set to communication failure - IB*2.0*506
- . I NRETR>RETR D Q
- .. D SST^IBCNEUT2(IEN,5)
- .. ;
- .. ; Set Buffer symbol to 'C1' (Comm Failure) ; used to be 'B12' - ien of 15
- .. I BUFF'="" D BUFF^IBCNEUT2(BUFF,C1CODE) ; set to "#" communication failure - IB*2.0*506
- .. ;
- .. ; For msg in the Response file set the status to
- .. ; 'Comm Failure'
- .. D RSTA^IBCNEUT7(IEN)
- .. ;
- .. ;I VERID="V" D CERE^IBCNEDEQ ; removed IB*2.0*506
- . ; If generating retry, set eIV status to comm failure (5) for
- . ; remaining related responses
- . D RSTA^IBCNEUT7(IEN)
- ;
- ; Exit for stop request
- I $G(ZTSTOP) G EXIT
- ;
- FIN ; Prioritize requests for statuses 'Retry' and 'Ready to Transmit'
- ;
- ; Separate inquiries into verifications, identifications,
- ; and "fishes" - VNUM = Priority of output
- F STA=1,6 S IEN="" D
- . F S IEN=$O(^IBCN(365.1,"AC",STA,IEN)) Q:IEN="" D
- .. S IBDATA=$G(^IBCN(365.1,IEN,0)) Q:IBDATA=""
- .. S QUERY=$P(IBDATA,U,11),DFN=$P(IBDATA,U,2),OVRIDE=$P(IBDATA,U,14)
- .. S PAYR=$P(IBDATA,U,3)
- .. I QUERY="V" S VNUM=3
- .. I QUERY'="V" D
- ... S VNUM=4
- .. I OVRIDE'="" D
- ... S VNUM=1
- .. S ^TMP("IBQUERY",$J,VNUM,DFN,IEN)="" ; VNUM = Priority of output
- ;
- LP ; Loop through priorities, process as either verifications
- ; or identifications
- ;IB*713/DW add GOOGMSG variable to skip & cancel bad msgs (foreign chars)
- N IHCNT,IBSTOP
- S VNUM="",IHCNT=0 ; VNUM = Priority of output
- F S VNUM=$O(^TMP("IBQUERY",$J,VNUM)) Q:VNUM="" D Q:$G(ZTSTOP)!$G(QFL)=1!($G(IBSTOP)=1)
- . I VNUM=1!(VNUM=3) D VER Q
- . D ID
- ;
- EXIT ; Finish
- K BUFF,CNT,D,D0,DA,DFN,DI,DIC,DIE,DISYS,DQ,DR,DTCRT,EICDVIEN,EXT,FAIL,FLDT,FUTDT
- K FRDT,FMSG,GT1,HCT,HIEN,HL,HLCDOM,HLCINS,HLCS,HLCSTCP,HLDOM,HLECH,%I,%H
- K HLEID,HLFS,HLHDR,HLINST,HLIP,HLN,HLPARAM,HLPROD,HLQ,HLRESLT,XMSUB
- K HLSAN,HLTYPE,HLX,IBCNEP,IBCNHLP,IEN,IHCNT,IN1,IRIEN,MDTM,MGRP,MSGID,TOT
- K NRETR,NTRAN,OVRIDE,PAYR,PID,QFL,QUERY,RETR,RETRYFLG,RSIEN,SRVDT,STA,TRANSR,X
- K ZMID,^TMP("IBQUERY",$J),Y,DOD,DGREL,TMSG,RSTYPE,OMSGID,QFL
- K IBCNETOT,HLP,SUBID,VNUM,BNDL,IBDATA,PATID,C1CODE
- K GRPNUM,GRPNAM,TRANSR1 ;IB*778/CKB - clean up variables
- Q
- ;
- VER ; Initialize HL7 variables protocol for Verifications
- S IBCNHLP="IBCNE IIV RQV OUT"
- D INIT^IBCNEHLO
- ;
- S DFN=""
- ; VNUM = Priority of output
- F S DFN=$O(^TMP("IBQUERY",$J,VNUM,DFN)) Q:DFN="" D Q:$G(ZTSTOP)!($G(IBSTOP)=1)
- . ;
- . ; If the INQUIRE SECONDARY INSURANCES flag is 'yes',
- . ; bundle verifications together, send a continuation pointer
- . I VNUM=3,BNDL D Q:QFL
- .. S TOT=0,IEN="",QFL=0
- .. F S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN="" S TOT=TOT+1
- . ;
- . S IEN="",OMSGID="",QFL=0,CNT=0
- . F S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN="" D Q:$G(ZTSTOP)!($G(IBSTOP)=1)
- .. ;
- .. ; IB*2.0*549 - quit if test site and not a valid test case
- .. Q:'$$XMITOK^IBCNETST(IEN)
- .. ; Update count for periodic check
- .. S IBCNETOT=IBCNETOT+1
- .. ; Check for request to stop background job, periodically
- .. I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
- .. ;
- .. ;IB*713/TAZ - Convert to function and quit if no HL7 message created
- .. I '$$PROC Q
- .. ;
- .. I BNDL S HLP("CONTPTR")=$G(OMSGID)
- .. D GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
- .. K ^TMP("HLS",$J),HLP
- .. ;
- .. ; If not successful
- .. I $P(HLRESLT,U,2)]"" D HLER^IBCNEDEQ Q
- .. ; If successful
- .. ; increment counter and quit if reached IBMAXCNT IB*533
- .. S IBSENT=IBSENT+1
- .. I IBMAXCNT'="",IBSENT+1>IBMAXCNT S IBSTOP=1
- .. D SCC^IBCNEDEQ
- .. I BNDL D
- ... I CNT=1 S OMSGID=MSGID
- ;
- K HL,IN1,GT1,PID,DFN,^TMP($J,"HLS")
- Q
- ;
- ID ; Send Identification Msgs
- ;
- ; Initialize the HL7 variables based on the HL7 protocol
- S IBCNHLP="IBCNE EIV RQP OUT"
- D INIT^IBCNEHLO
- ;
- S DFN=""
- ; VNUM = Priority of output
- F S DFN=$O(^TMP("IBQUERY",$J,VNUM,DFN)) Q:DFN="" D Q:$G(ZTSTOP)!QFL
- . ; Update count for periodic check
- . S IBCNETOT=IBCNETOT+1
- . ; Check for request to stop background job, periodically
- . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
- . ;
- . S TOT=0,IEN="",CNT=0,OMSGID="",QFL=0
- . ;
- . ; Get the total # of identification msgs for a patient
- . F S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN="" S TOT=TOT+1
- . ;
- . ; For each identification transaction generate an HL7 msg
- . F S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN="" D
- .. ;IB*2.0*621 - quit if test site and not a valid test case
- .. Q:'$$XMITOK^IBCNETST(IEN)
- .. ;
- .. ;IB*713/TAZ - Convert to function call and quit if no HL7 message created
- .. I '$$PROC Q
- .. ;
- .. ;I VNUM=4 S HLP("CONTPTR")=$G(OMSGID) ; IB*621 - HAN
- .. D GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
- .. K ^TMP("HLS",$J),HLP
- .. ;
- .. ; If not successful
- .. I $P(HLRESLT,U,2)]"" D HLER^IBCNEDEQ Q
- .. ;
- .. ; If successful
- .. D SCC^IBCNEDEQ
- .. ; IB*621 - HAN Set DATE LAST EICD RUN
- .. S DA=DFN,DIE="^DPT(",DR="2001///"_DT
- .. D ^DIE
- ;
- Q
- ;
- XMIT1(IEN) ; Transmit one transaction at time. Currently only used for Appointment Extract.
- ; created tag with IB*778/TAZ
- ; Input: IEN - the Transaction Queue entry
- ;
- ; Note: IHCNT and VNUM are used for subsequent calls. It is not needed for this functionality.
- ;
- N DFN,GT1,HL,IHCNT,IN1,PID,QUERYFLG,VNUM
- K ^TMP("HLS",$J)
- ;
- S IHCNT=0
- ;
- I '$G(IEN) G XMIT1Q
- S QUERYFLG=$$GET1^DIQ(365.1,IEN_",",.11,"I") ;I or V
- ;
- ; If not I or V set TQ entry to Communication Failure, then quit
- I QUERYFLG="" D SST^IBCNEUT2(IEN,5) G XMIT1Q
- ;
- ; Set up outbound HL7 protocol
- S IBCNHLP=$S(QUERYFLG="V":"IBCNE IIV RQV OUT",1:"IBCNE EIV RQP OUT")
- D INIT^IBCNEHLO
- ;
- ; Quit if test site and not a valid test case
- I '$$XMITOK^IBCNETST(IEN) G XMIT1Q
- ;
- ; Process TQ record and quit if errors
- I '$$PROC G XMIT1Q
- ;
- D GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
- K ^TMP("HLS",$J),HLP
- ;
- ; If not successful
- I $P(HLRESLT,U,2)]"" D HLER^IBCNEDEQ G XMIT1Q
- ;
- ; If successful
- D SCC^IBCNEDEQ
- ;
- ; Update LAST EICD RUN for ID transactions
- I QUERYFLG="I" D
- . S DA=DFN,DIE="^DPT(",DR="2001///"_DT
- . D ^DIE
- ;
- XMIT1Q ;Exit
- Q
- ;
- ;IB*713/TAZ - Convert to function call
- PROC() ; Process TQ record
- ;Output:
- ; 1 - OK to create HL7 message
- ; 0 - Do not create hl7 message
- ;
- S TRANSR=$G(^IBCN(365.1,IEN,0))
- S DFN=$P(TRANSR,U,2),PAYR=$P(TRANSR,U,3),BUFF=$P(TRANSR,U,5)
- S QUERY=$P(TRANSR,U,11),EXT=$P(TRANSR,U,10),SRVDT=$P(TRANSR,U,12)
- S IRIEN=$P(TRANSR,U,13),HCT=0,NTRAN=$P(TRANSR,U,7),NRETR=$P(TRANSR,U,8)
- S SUBID=$P(TRANSR,U,16),OVRIDE=$P(TRANSR,U,14),STA=$P(TRANSR,U,4)
- S FRDT=$P(TRANSR,U,17),PATID=$P(TRANSR,U,19),EICDVIEN=$P(TRANSR,U,21)
- ;IB*778/CKB - added TRANSR1,GRPNUM,GRPNAM. GRPNUM,GRPNAM will be used to build HL7 msg
- S TRANSR1=$G(^IBCN(365.1,IEN,1))
- S GRPNUM=$P(TRANSR1,U,3),GRPNAM=$P(TRANSR1,U,4)
- ;
- ; Build the HL7 msg
- S VNUM=$G(VNUM,1) ;Default is "1" if VNUM is "" ; IB*778/TAZ
- S HCT=HCT+1,^TMP("HLS",$J,HCT)="PRD|NA"
- D PID^IBCNEHLQ I PID=""!(PID?."*") Q
- S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(PID,"*","")
- D GT1^IBCNEHLQ I GT1'="",GT1'?."*" S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(GT1,"*","")
- D IN1^IBCNEHLQ I IN1'="",IN1'?."*" D
- . S HCT=HCT+1
- . I VNUM=1 S ^TMP("HLS",$J,HCT)=$TR(IN1,"*","") Q ; VNUM = Priority of output
- . I VNUM=2,'BNDL S ^TMP("HLS",$J,HCT)=$TR(IN1,"*","") Q
- . S CNT=CNT+1 I TOT=0 S TOT=1
- . S $P(IN1,HLFS,22)=TOT,$P(IN1,HLFS,21)=CNT
- . S ^TMP("HLS",$J,HCT)=$TR(IN1,"*","")
- ;
- ;IB*713/TAZ - Check to see if we should continue building HL7 message
- ;NOTE: BADMSG Returns 1 if processing is to stop.
- ;
- I $$BADMSG^IBCNEUT2(EXT,QUERY) D Q 0
- . N STIEN
- . D SST^IBCNEUT2(IEN,7) ; set TQ status to 'Cancelled'
- . ;If BUFF is defined, set Buffer Symbol to B17 to force manual processing of entry.
- . I $G(BUFF) D
- . . S STIEN=$$FIND1^DIC(365.15,,"X","B17","B")
- . . D BUFF^IBCNEUT2(BUFF,STIEN)
- ;
- ; Build multi-field NTE segment
- D NTE^IBCNEHLQ(1)
- ; If build successful
- I NTE'="",$E(NTE,1)'="*" S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(NTE,"*","")
- ; IB*2.0*601 - Added NTE 2 & 3
- D NTE^IBCNEHLQ(2)
- ; If build successful Second NTE segment
- I NTE'="",$E(NTE,1)'="*" S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(NTE,"*","")
- D NTE^IBCNEHLQ(3)
- ; set the third NTE segment
- I NTE'="",$E(NTE,1)'="*" S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(NTE,"*","")
- ; IB*601 - End HAN
- ; IB*2.0*621
- D NTE^IBCNEHLQ(4)
- ; set the fourth NTE segment
- S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(NTE,"*","")
- D NTE^IBCNEHLQ(5)
- ; set the fifth NTE segment
- S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(NTE,"*","")
- ; IB*621 - End HAN
- K NTE
- Q 1
- ;
- ; The tag HLD was found at the top of this routine. It was moved
- ; to its own procedure because it isn't needed anymore at this time.
- ; Responses will not have the status of HOLD starting with patch IB*2.0*506.
- ; If HOLD is reinstated, then the logic below must be rewritten for the
- ; appropriate retry logic at that time.
- HLD ; Go through the 'Hold' statuses, see if ready to be 'retried'
- Q ; Quit added as safety valve
- ;S IEN=""
- ;F S IEN=$O(^IBCN(365.1,"AC",4,IEN)) Q:IEN="" D Q:$G(ZTSTOP)
- ;. ; Update count for periodic check
- ;. S IBCNETOT=IBCNETOT+1
- ;. ; Check for request to stop background job, periodically
- ;. I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
- ;. ;
- ;. S FUTDT=$P($G(^IBCN(365.1,IEN,0)),U,9)
- ;. ;
- ;. ; If the future date is today, set status to 'Retry',
- ;. ; DON'T clear future transmission date. (Need date to see if this is the first
- ;. ; time that the payer asked us to resubmit this inquiry.)
- ;. I FUTDT'>DT D SST^IBCNEUT2(IEN,6) ;D
- ;. ;. NEW DA,DIE,DR
- ;. ;. S DA=IEN,DIE="^IBCN(365.1,",DR=".09///@" D ^DIE
- ;.. ;
- ;.. D SST^IBCNEUT2(IEN,6) ; set TQ status to 'retry'
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEDEP 14498 printed Feb 18, 2025@23:40:55 Page 2
- IBCNEDEP ;DAOU/ALA - Process Transaction Records ;14-OCT-2015
- +1 ;;2.0;INTEGRATED BILLING;**184,271,300,416,438,506,533,549,601,621,713,737,778**;21-MAR-94;Build 28
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; This program finds records needing HL7 msg creation
- +5 ; Periodically check for stop request for background task
- +6 ;
- +7 ; Variables
- +8 ; RETR = # retries allowed
- +9 ; RETRYFLG = determines if a Transmitted message can be resent
- +10 ; MGRP = Msg Mailgroup
- +11 ; FAIL = # of days before failure
- +12 ; FMSG = Failure Mailman flag
- +13 ; TMSG = Timeout Mailman flag
- +14 ; FLDT = Failure date
- +15 ; FUTDT = Future transmission date
- +16 ; DFN = Patient IEN
- +17 ; PAYR = Payer IEN
- +18 ; DTCRT = Date Created
- +19 ; BUFF = Buffer File IEN
- +20 ; NRETR = # of retries accomplished
- +21 ; IHCNT = Count of successful HL7 msgs
- +22 ; QUERY = Type of msg
- +23 ; EXT = Which extract produced record
- +24 ; SRVDT = Service Date
- +25 ; IRIEN = Insurance Record IEN
- +26 ; NTRAN = # of transmissions accomplished
- +27 ; OVRIDE = Override Flag
- +28 ; BNDL = Bundle Verification Flag
- +29 ;
- EN ; Entry point
- +1 ;
- +2 ; Start processing of data
- +3 KILL ^TMP("HLS",$JOB),^TMP("IBQUERY",$JOB)
- +4 ; Initialize count for periodic TaskMan check
- +5 ;IB*533 RRA CREATE VARIABLES TO ACCOUNT FOR MAX SENT LIMITATIONS
- +6 NEW IBMAXCNT,IBSENT
- +7 SET IBCNETOT=0
- SET IBSENT=0
- +8 ;
- +9 SET C1CODE=$ORDER(^IBE(365.15,"B","C1",""))
- +10 ; Get IB Site Parameters
- +11 SET IBCNEP=$GET(^IBE(350.9,1,51))
- +12 SET RETR=+$PIECE(IBCNEP,U,6)
- SET BNDL=$PIECE(IBCNEP,U,23)
- +13 SET MGRP=$$MGRP^IBCNEUT5()
- +14 SET FAIL=$PIECE(IBCNEP,U,5)
- SET TMSG=$PIECE(IBCNEP,U,7)
- SET FMSG=$PIECE(IBCNEP,U,20)
- +15 ;set value to (#350.9, 51.26) - IB*2.0*506
- SET RETRYFLG=$PIECE(IBCNEP,U,26)
- +16 ;get HL7 MAXIMUM NUMBER - IB*533
- SET IBMAXCNT=$PIECE(IBCNEP,U,15)
- +17 SET FLDT=$$FMADD^XLFDT(DT,-FAIL)
- +18 ; Statuses
- +19 ; 1 = Ready To Transmit
- +20 ; 2 = Transmitted
- +21 ; 4 = Hold
- +22 ; 6 = Retry
- +23 ;
- +24 ; If the status is 'HOLD' is this a 'Retry'? - IB*2.0*506
- +25 ; DO HLD ; this is not to be called unless the status of HOLD is reinstated...see HLD tag
- +26 ; below and the code within ERROR^IBCNEHL3
- +27 ;
- +28 ; Exit based on stop request
- +29 IF $GET(ZTSTOP)
- GOTO EXIT
- +30 ;
- TMT ; If the status is 'Transmitted' - is this a 'Retry' or
- +1 ; 'Comm Failure'
- +2 SET IEN=""
- +3 FOR
- SET IEN=$ORDER(^IBCN(365.1,"AC",2,IEN))
- if IEN=""
- QUIT
- Begin DoDot:1
- +4 ; Update count for periodic check
- +5 SET IBCNETOT=IBCNETOT+1
- +6 ; Check for request to stop background job, periodically
- +7 IF $DATA(ZTQUEUED)
- IF IBCNETOT#100=0
- IF $$S^%ZTLOAD()
- SET ZTSTOP=1
- QUIT
- +8 ;
- +9 NEW TDATA,DTCRT,BUFF,DFN,PAYR,XMSUB,VERID,EXT
- +10 SET TDATA=$GET(^IBCN(365.1,IEN,0))
- +11 SET DFN=$PIECE(TDATA,U,2)
- SET PAYR=$PIECE(TDATA,U,3)
- +12 SET DTCRT=$PIECE(TDATA,U,6)\1
- SET BUFF=$PIECE(TDATA,U,5)
- +13 SET VERID=$PIECE(TDATA,U,11)
- +14 SET EXT=$PIECE(TDATA,U,10)
- +15 ;
- +16 ; Check against the Failure Date
- +17 ; IB*2.0*621 ; HAN
- IF (VERID="I")&(EXT=4)
- if DT<$$FMADD^XLFDT(DTCRT+30)
- QUIT
- +18 IF (VERID'="I")&(EXT'=4)&(DTCRT>FLDT)
- QUIT
- +19 ;
- +20 ; If retries are defined
- +21 ; IB*2.0*506 ; IB*2.0*621
- IF (VERID'="I"&(EXT'=4))&(RETRYFLG="Y")
- Begin DoDot:2
- +22 ;
- +23 ; If Payer is not Nationally Active skip record - IB*2.0*506
- IF '$$PYRACTV^IBCNEDE7(PAYR)
- QUIT
- +24 ;
- +25 ; mark TQ entry status as 'retry'
- DO SST^IBCNEUT2(IEN,6)
- +26 QUIT
- End DoDot:2
- QUIT
- +27 ;
- +28 ; if RETRYFLG=NO set TQ record to 'communication failure'
- DO SST^IBCNEUT2(IEN,5)
- +29 ;
- +30 ; For msg in the Response file set the status to
- +31 ; 'Comm Failure'
- +32 DO RSTA^IBCNEUT7(IEN)
- +33 IF (VERID="I")&(EXT=4)
- Begin DoDot:2
- +34 NEW IENS,RSUPDT,TRKIEN
- +35 SET TRKIEN=$ORDER(^IBCN(365.18,"B",IEN,""))
- SET IENS=TRKIEN_","
- +36 ;There is only one occurance for EICD Identification
- SET RSUPDT(365.18,IENS,.06)=$$GET1^DIQ(365.16,"1,"_IEN_",",.03)
- +37 ;Set status to "Error"
- SET RSUPDT(365.18,IENS,.07)=0
- +38 DO FILE^DIE("","RSUPDT","ERROR")
- End DoDot:2
- +39 ;
- +40 ; Set Buffer symbol to 'C1' (Comm Failure) ; used to be 'B12' - ien of 15
- +41 ; set to "#" communication failure - IB*2.0*506
- IF BUFF'=""
- DO BUFF^IBCNEUT2(BUFF,C1CODE)
- +42 ;
- +43 ; Issue comm fail MailMan msg only for ver'ns
- +44 IF VERID="V"
- DO CERR^IBCNEDEQ
- End DoDot:1
- if $GET(ZTSTOP)
- QUIT
- +45 ;
- +46 ; Exit for stop request
- +47 IF $GET(ZTSTOP)
- GOTO EXIT
- +48 ;
- RET ; If status is 'Retry' ; retries only exist if the RETRYFLG=YES - IB*2.0*506
- +1 SET IEN=""
- +2 FOR
- SET IEN=$ORDER(^IBCN(365.1,"AC",6,IEN))
- if IEN=""
- QUIT
- Begin DoDot:1
- +3 ; Update count for periodic check
- +4 SET IBCNETOT=IBCNETOT+1
- +5 ; Check for request to stop background job, periodically
- +6 IF $DATA(ZTQUEUED)
- IF IBCNETOT#100=0
- IF $$S^%ZTLOAD()
- SET ZTSTOP=1
- QUIT
- +7 ;
- +8 NEW TDATA,NRETR,PAYR,BUFF,DFN,MSG,RIEN,HIEN,XMSUB,VERID
- +9 SET TDATA=$GET(^IBCN(365.1,IEN,0))
- +10 SET NRETR=$PIECE(TDATA,U,8)
- SET PAYR=$PIECE(TDATA,U,3)
- +11 SET BUFF=$PIECE(TDATA,U,5)
- SET DFN=$PIECE(TDATA,U,2)
- +12 SET VERID=$PIECE(TDATA,U,11)
- +13 SET NRETR=NRETR+1
- +14 ;
- +15 ; If retries are finished, set to communication failure - IB*2.0*506
- +16 IF NRETR>RETR
- Begin DoDot:2
- +17 DO SST^IBCNEUT2(IEN,5)
- +18 ;
- +19 ; Set Buffer symbol to 'C1' (Comm Failure) ; used to be 'B12' - ien of 15
- +20 ; set to "#" communication failure - IB*2.0*506
- IF BUFF'=""
- DO BUFF^IBCNEUT2(BUFF,C1CODE)
- +21 ;
- +22 ; For msg in the Response file set the status to
- +23 ; 'Comm Failure'
- +24 DO RSTA^IBCNEUT7(IEN)
- +25 ;
- +26 ;I VERID="V" D CERE^IBCNEDEQ ; removed IB*2.0*506
- End DoDot:2
- QUIT
- +27 ; If generating retry, set eIV status to comm failure (5) for
- +28 ; remaining related responses
- +29 DO RSTA^IBCNEUT7(IEN)
- End DoDot:1
- if $GET(ZTSTOP)
- QUIT
- +30 ;
- +31 ; Exit for stop request
- +32 IF $GET(ZTSTOP)
- GOTO EXIT
- +33 ;
- FIN ; Prioritize requests for statuses 'Retry' and 'Ready to Transmit'
- +1 ;
- +2 ; Separate inquiries into verifications, identifications,
- +3 ; and "fishes" - VNUM = Priority of output
- +4 FOR STA=1,6
- SET IEN=""
- Begin DoDot:1
- +5 FOR
- SET IEN=$ORDER(^IBCN(365.1,"AC",STA,IEN))
- if IEN=""
- QUIT
- Begin DoDot:2
- +6 SET IBDATA=$GET(^IBCN(365.1,IEN,0))
- if IBDATA=""
- QUIT
- +7 SET QUERY=$PIECE(IBDATA,U,11)
- SET DFN=$PIECE(IBDATA,U,2)
- SET OVRIDE=$PIECE(IBDATA,U,14)
- +8 SET PAYR=$PIECE(IBDATA,U,3)
- +9 IF QUERY="V"
- SET VNUM=3
- +10 IF QUERY'="V"
- Begin DoDot:3
- +11 SET VNUM=4
- End DoDot:3
- +12 IF OVRIDE'=""
- Begin DoDot:3
- +13 SET VNUM=1
- End DoDot:3
- +14 ; VNUM = Priority of output
- SET ^TMP("IBQUERY",$JOB,VNUM,DFN,IEN)=""
- End DoDot:2
- End DoDot:1
- +15 ;
- LP ; Loop through priorities, process as either verifications
- +1 ; or identifications
- +2 ;IB*713/DW add GOOGMSG variable to skip & cancel bad msgs (foreign chars)
- +3 NEW IHCNT,IBSTOP
- +4 ; VNUM = Priority of output
- SET VNUM=""
- SET IHCNT=0
- +5 FOR
- SET VNUM=$ORDER(^TMP("IBQUERY",$JOB,VNUM))
- if VNUM=""
- QUIT
- Begin DoDot:1
- +6 IF VNUM=1!(VNUM=3)
- DO VER
- QUIT
- +7 DO ID
- End DoDot:1
- if $GET(ZTSTOP)!$GET(QFL)=1!($GET(IBSTOP)=1)
- QUIT
- +8 ;
- EXIT ; Finish
- +1 KILL BUFF,CNT,D,D0,DA,DFN,DI,DIC,DIE,DISYS,DQ,DR,DTCRT,EICDVIEN,EXT,FAIL,FLDT,FUTDT
- +2 KILL FRDT,FMSG,GT1,HCT,HIEN,HL,HLCDOM,HLCINS,HLCS,HLCSTCP,HLDOM,HLECH,%I,%H
- +3 KILL HLEID,HLFS,HLHDR,HLINST,HLIP,HLN,HLPARAM,HLPROD,HLQ,HLRESLT,XMSUB
- +4 KILL HLSAN,HLTYPE,HLX,IBCNEP,IBCNHLP,IEN,IHCNT,IN1,IRIEN,MDTM,MGRP,MSGID,TOT
- +5 KILL NRETR,NTRAN,OVRIDE,PAYR,PID,QFL,QUERY,RETR,RETRYFLG,RSIEN,SRVDT,STA,TRANSR,X
- +6 KILL ZMID,^TMP("IBQUERY",$JOB),Y,DOD,DGREL,TMSG,RSTYPE,OMSGID,QFL
- +7 KILL IBCNETOT,HLP,SUBID,VNUM,BNDL,IBDATA,PATID,C1CODE
- +8 ;IB*778/CKB - clean up variables
- KILL GRPNUM,GRPNAM,TRANSR1
- +9 QUIT
- +10 ;
- VER ; Initialize HL7 variables protocol for Verifications
- +1 SET IBCNHLP="IBCNE IIV RQV OUT"
- +2 DO INIT^IBCNEHLO
- +3 ;
- +4 SET DFN=""
- +5 ; VNUM = Priority of output
- +6 FOR
- SET DFN=$ORDER(^TMP("IBQUERY",$JOB,VNUM,DFN))
- if DFN=""
- QUIT
- Begin DoDot:1
- +7 ;
- +8 ; If the INQUIRE SECONDARY INSURANCES flag is 'yes',
- +9 ; bundle verifications together, send a continuation pointer
- +10 IF VNUM=3
- IF BNDL
- Begin DoDot:2
- +11 SET TOT=0
- SET IEN=""
- SET QFL=0
- +12 FOR
- SET IEN=$ORDER(^TMP("IBQUERY",$JOB,VNUM,DFN,IEN))
- if IEN=""
- QUIT
- SET TOT=TOT+1
- End DoDot:2
- if QFL
- QUIT
- +13 ;
- +14 SET IEN=""
- SET OMSGID=""
- SET QFL=0
- SET CNT=0
- +15 FOR
- SET IEN=$ORDER(^TMP("IBQUERY",$JOB,VNUM,DFN,IEN))
- if IEN=""
- QUIT
- Begin DoDot:2
- +16 ;
- +17 ; IB*2.0*549 - quit if test site and not a valid test case
- +18 if '$$XMITOK^IBCNETST(IEN)
- QUIT
- +19 ; Update count for periodic check
- +20 SET IBCNETOT=IBCNETOT+1
- +21 ; Check for request to stop background job, periodically
- +22 IF $DATA(ZTQUEUED)
- IF IBCNETOT#100=0
- IF $$S^%ZTLOAD()
- SET ZTSTOP=1
- QUIT
- +23 ;
- +24 ;IB*713/TAZ - Convert to function and quit if no HL7 message created
- +25 IF '$$PROC
- QUIT
- +26 ;
- +27 IF BNDL
- SET HLP("CONTPTR")=$GET(OMSGID)
- +28 DO GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
- +29 KILL ^TMP("HLS",$JOB),HLP
- +30 ;
- +31 ; If not successful
- +32 IF $PIECE(HLRESLT,U,2)]""
- DO HLER^IBCNEDEQ
- QUIT
- +33 ; If successful
- +34 ; increment counter and quit if reached IBMAXCNT IB*533
- +35 SET IBSENT=IBSENT+1
- +36 IF IBMAXCNT'=""
- IF IBSENT+1>IBMAXCNT
- SET IBSTOP=1
- +37 DO SCC^IBCNEDEQ
- +38 IF BNDL
- Begin DoDot:3
- +39 IF CNT=1
- SET OMSGID=MSGID
- End DoDot:3
- End DoDot:2
- if $GET(ZTSTOP)!($GET(IBSTOP)=1)
- QUIT
- End DoDot:1
- if $GET(ZTSTOP)!($GET(IBSTOP)=1)
- QUIT
- +40 ;
- +41 KILL HL,IN1,GT1,PID,DFN,^TMP($JOB,"HLS")
- +42 QUIT
- +43 ;
- ID ; Send Identification Msgs
- +1 ;
- +2 ; Initialize the HL7 variables based on the HL7 protocol
- +3 SET IBCNHLP="IBCNE EIV RQP OUT"
- +4 DO INIT^IBCNEHLO
- +5 ;
- +6 SET DFN=""
- +7 ; VNUM = Priority of output
- +8 FOR
- SET DFN=$ORDER(^TMP("IBQUERY",$JOB,VNUM,DFN))
- if DFN=""
- QUIT
- Begin DoDot:1
- +9 ; Update count for periodic check
- +10 SET IBCNETOT=IBCNETOT+1
- +11 ; Check for request to stop background job, periodically
- +12 IF $DATA(ZTQUEUED)
- IF IBCNETOT#100=0
- IF $$S^%ZTLOAD()
- SET ZTSTOP=1
- QUIT
- +13 ;
- +14 SET TOT=0
- SET IEN=""
- SET CNT=0
- SET OMSGID=""
- SET QFL=0
- +15 ;
- +16 ; Get the total # of identification msgs for a patient
- +17 FOR
- SET IEN=$ORDER(^TMP("IBQUERY",$JOB,VNUM,DFN,IEN))
- if IEN=""
- QUIT
- SET TOT=TOT+1
- +18 ;
- +19 ; For each identification transaction generate an HL7 msg
- +20 FOR
- SET IEN=$ORDER(^TMP("IBQUERY",$JOB,VNUM,DFN,IEN))
- if IEN=""
- QUIT
- Begin DoDot:2
- +21 ;IB*2.0*621 - quit if test site and not a valid test case
- +22 if '$$XMITOK^IBCNETST(IEN)
- QUIT
- +23 ;
- +24 ;IB*713/TAZ - Convert to function call and quit if no HL7 message created
- +25 IF '$$PROC
- QUIT
- +26 ;
- +27 ;I VNUM=4 S HLP("CONTPTR")=$G(OMSGID) ; IB*621 - HAN
- +28 DO GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
- +29 KILL ^TMP("HLS",$JOB),HLP
- +30 ;
- +31 ; If not successful
- +32 IF $PIECE(HLRESLT,U,2)]""
- DO HLER^IBCNEDEQ
- QUIT
- +33 ;
- +34 ; If successful
- +35 DO SCC^IBCNEDEQ
- +36 ; IB*621 - HAN Set DATE LAST EICD RUN
- +37 SET DA=DFN
- SET DIE="^DPT("
- SET DR="2001///"_DT
- +38 DO ^DIE
- End DoDot:2
- End DoDot:1
- if $GET(ZTSTOP)!QFL
- QUIT
- +39 ;
- +40 QUIT
- +41 ;
- XMIT1(IEN) ; Transmit one transaction at time. Currently only used for Appointment Extract.
- +1 ; created tag with IB*778/TAZ
- +2 ; Input: IEN - the Transaction Queue entry
- +3 ;
- +4 ; Note: IHCNT and VNUM are used for subsequent calls. It is not needed for this functionality.
- +5 ;
- +6 NEW DFN,GT1,HL,IHCNT,IN1,PID,QUERYFLG,VNUM
- +7 KILL ^TMP("HLS",$JOB)
- +8 ;
- +9 SET IHCNT=0
- +10 ;
- +11 IF '$GET(IEN)
- GOTO XMIT1Q
- +12 ;I or V
- SET QUERYFLG=$$GET1^DIQ(365.1,IEN_",",.11,"I")
- +13 ;
- +14 ; If not I or V set TQ entry to Communication Failure, then quit
- +15 IF QUERYFLG=""
- DO SST^IBCNEUT2(IEN,5)
- GOTO XMIT1Q
- +16 ;
- +17 ; Set up outbound HL7 protocol
- +18 SET IBCNHLP=$SELECT(QUERYFLG="V":"IBCNE IIV RQV OUT",1:"IBCNE EIV RQP OUT")
- +19 DO INIT^IBCNEHLO
- +20 ;
- +21 ; Quit if test site and not a valid test case
- +22 IF '$$XMITOK^IBCNETST(IEN)
- GOTO XMIT1Q
- +23 ;
- +24 ; Process TQ record and quit if errors
- +25 IF '$$PROC
- GOTO XMIT1Q
- +26 ;
- +27 DO GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
- +28 KILL ^TMP("HLS",$JOB),HLP
- +29 ;
- +30 ; If not successful
- +31 IF $PIECE(HLRESLT,U,2)]""
- DO HLER^IBCNEDEQ
- GOTO XMIT1Q
- +32 ;
- +33 ; If successful
- +34 DO SCC^IBCNEDEQ
- +35 ;
- +36 ; Update LAST EICD RUN for ID transactions
- +37 IF QUERYFLG="I"
- Begin DoDot:1
- +38 SET DA=DFN
- SET DIE="^DPT("
- SET DR="2001///"_DT
- +39 DO ^DIE
- End DoDot:1
- +40 ;
- XMIT1Q ;Exit
- +1 QUIT
- +2 ;
- +3 ;IB*713/TAZ - Convert to function call
- PROC() ; Process TQ record
- +1 ;Output:
- +2 ; 1 - OK to create HL7 message
- +3 ; 0 - Do not create hl7 message
- +4 ;
- +5 SET TRANSR=$GET(^IBCN(365.1,IEN,0))
- +6 SET DFN=$PIECE(TRANSR,U,2)
- SET PAYR=$PIECE(TRANSR,U,3)
- SET BUFF=$PIECE(TRANSR,U,5)
- +7 SET QUERY=$PIECE(TRANSR,U,11)
- SET EXT=$PIECE(TRANSR,U,10)
- SET SRVDT=$PIECE(TRANSR,U,12)
- +8 SET IRIEN=$PIECE(TRANSR,U,13)
- SET HCT=0
- SET NTRAN=$PIECE(TRANSR,U,7)
- SET NRETR=$PIECE(TRANSR,U,8)
- +9 SET SUBID=$PIECE(TRANSR,U,16)
- SET OVRIDE=$PIECE(TRANSR,U,14)
- SET STA=$PIECE(TRANSR,U,4)
- +10 SET FRDT=$PIECE(TRANSR,U,17)
- SET PATID=$PIECE(TRANSR,U,19)
- SET EICDVIEN=$PIECE(TRANSR,U,21)
- +11 ;IB*778/CKB - added TRANSR1,GRPNUM,GRPNAM. GRPNUM,GRPNAM will be used to build HL7 msg
- +12 SET TRANSR1=$GET(^IBCN(365.1,IEN,1))
- +13 SET GRPNUM=$PIECE(TRANSR1,U,3)
- SET GRPNAM=$PIECE(TRANSR1,U,4)
- +14 ;
- +15 ; Build the HL7 msg
- +16 ;Default is "1" if VNUM is "" ; IB*778/TAZ
- SET VNUM=$GET(VNUM,1)
- +17 SET HCT=HCT+1
- SET ^TMP("HLS",$JOB,HCT)="PRD|NA"
- +18 DO PID^IBCNEHLQ
- IF PID=""!(PID?."*")
- QUIT
- +19 SET HCT=HCT+1
- SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(PID,"*","")
- +20 DO GT1^IBCNEHLQ
- IF GT1'=""
- IF GT1'?."*"
- SET HCT=HCT+1
- SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(GT1,"*","")
- +21 DO IN1^IBCNEHLQ
- IF IN1'=""
- IF IN1'?."*"
- Begin DoDot:1
- +22 SET HCT=HCT+1
- +23 ; VNUM = Priority of output
- IF VNUM=1
- SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(IN1,"*","")
- QUIT
- +24 IF VNUM=2
- IF 'BNDL
- SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(IN1,"*","")
- QUIT
- +25 SET CNT=CNT+1
- IF TOT=0
- SET TOT=1
- +26 SET $PIECE(IN1,HLFS,22)=TOT
- SET $PIECE(IN1,HLFS,21)=CNT
- +27 SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(IN1,"*","")
- End DoDot:1
- +28 ;
- +29 ;IB*713/TAZ - Check to see if we should continue building HL7 message
- +30 ;NOTE: BADMSG Returns 1 if processing is to stop.
- +31 ;
- +32 IF $$BADMSG^IBCNEUT2(EXT,QUERY)
- Begin DoDot:1
- +33 NEW STIEN
- +34 ; set TQ status to 'Cancelled'
- DO SST^IBCNEUT2(IEN,7)
- +35 ;If BUFF is defined, set Buffer Symbol to B17 to force manual processing of entry.
- +36 IF $GET(BUFF)
- Begin DoDot:2
- +37 SET STIEN=$$FIND1^DIC(365.15,,"X","B17","B")
- +38 DO BUFF^IBCNEUT2(BUFF,STIEN)
- End DoDot:2
- End DoDot:1
- QUIT 0
- +39 ;
- +40 ; Build multi-field NTE segment
- +41 DO NTE^IBCNEHLQ(1)
- +42 ; If build successful
- +43 IF NTE'=""
- IF $EXTRACT(NTE,1)'="*"
- SET HCT=HCT+1
- SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(NTE,"*","")
- +44 ; IB*2.0*601 - Added NTE 2 & 3
- +45 DO NTE^IBCNEHLQ(2)
- +46 ; If build successful Second NTE segment
- +47 IF NTE'=""
- IF $EXTRACT(NTE,1)'="*"
- SET HCT=HCT+1
- SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(NTE,"*","")
- +48 DO NTE^IBCNEHLQ(3)
- +49 ; set the third NTE segment
- +50 IF NTE'=""
- IF $EXTRACT(NTE,1)'="*"
- SET HCT=HCT+1
- SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(NTE,"*","")
- +51 ; IB*601 - End HAN
- +52 ; IB*2.0*621
- +53 DO NTE^IBCNEHLQ(4)
- +54 ; set the fourth NTE segment
- +55 SET HCT=HCT+1
- SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(NTE,"*","")
- +56 DO NTE^IBCNEHLQ(5)
- +57 ; set the fifth NTE segment
- +58 SET HCT=HCT+1
- SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(NTE,"*","")
- +59 ; IB*621 - End HAN
- +60 KILL NTE
- +61 QUIT 1
- +62 ;
- +63 ; The tag HLD was found at the top of this routine. It was moved
- +64 ; to its own procedure because it isn't needed anymore at this time.
- +65 ; Responses will not have the status of HOLD starting with patch IB*2.0*506.
- +66 ; If HOLD is reinstated, then the logic below must be rewritten for the
- +67 ; appropriate retry logic at that time.
- HLD ; Go through the 'Hold' statuses, see if ready to be 'retried'
- +1 ; Quit added as safety valve
- QUIT
- +2 ;S IEN=""
- +3 ;F S IEN=$O(^IBCN(365.1,"AC",4,IEN)) Q:IEN="" D Q:$G(ZTSTOP)
- +4 ;. ; Update count for periodic check
- +5 ;. S IBCNETOT=IBCNETOT+1
- +6 ;. ; Check for request to stop background job, periodically
- +7 ;. I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
- +8 ;. ;
- +9 ;. S FUTDT=$P($G(^IBCN(365.1,IEN,0)),U,9)
- +10 ;. ;
- +11 ;. ; If the future date is today, set status to 'Retry',
- +12 ;. ; DON'T clear future transmission date. (Need date to see if this is the first
- +13 ;. ; time that the payer asked us to resubmit this inquiry.)
- +14 ;. I FUTDT'>DT D SST^IBCNEUT2(IEN,6) ;D
- +15 ;. ;. NEW DA,DIE,DR
- +16 ;. ;. S DA=IEN,DIE="^IBCN(365.1,",DR=".09///@" D ^DIE
- +17 ;.. ;
- +18 ;.. D SST^IBCNEUT2(IEN,6) ; set TQ status to 'retry'
- +19 QUIT