Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNEDEP

IBCNEDEP.m

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