- IBRFN4 ;ALB/TMK - Supported functions for AR/IB DATA EXTRACT ;15-FEB-2005
- ;;2.0;INTEGRATED BILLING;**301,305,389,516**;21-MAR-94;Build 123
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- IBAREXT(IBIFN,IBD) ; Returns data for claim IBIFN for IB/AR Extract
- ; Data returned (pieces):
- ; 1-MEDICARE Status (0=not MRA secondary, 1=MRA secondary)
- ; 2-Last MRA requested date "S";7 (7 - INTERNAL)
- ; 3-Last Electronic extract date "TX";2 (21 - INTERNAL)
- ; 4-Printed via EDI "TX";7 (26 - EXTERNAL)
- ; 5-Force Claim to Print "TX";8 (27 - EXTERNAL)
- ; 6-Claim MRA Status "TX";5 (24 - EXTERNAL)
- ; 7-MRA recorded date "TX";3 (22 - INTERNAL)
- ; 8-Bill cancelled date "S";17 (17 - INTERNAL)
- ; 9-form type 0;19 (.19 - EXTERNAL)
- ; 10-Current Payer $$CURR^IBCEF2(IBIFN) returns IEN;NAME (file 36)
- ; 11-DRG 0;8==> file 45 (9 - EXTERNAL)
- ; 12-ECME # "M1";8 (460 - EXTERNAL)
- ; 13-NON-VA Facility
- ; 14-#Days Site Not Responsible for MRA ($$DAYS(IBIFN))
- ; 15-National VA id number for Ins Verification (365.12;.02 - INTERNAL)
- ; 16-Payer name (file 365.12;.01)
- ; 17-Offset Amount (202-INTERNAL)
- ;
- ; IBD("PRD",seq #)=prosthetic item name^date^bill ien
- ; IBD("IN")= TYPE OF PLAN NAME ^ GROUP NUMBER ^ RELATIONSHIP TO INSURED
- ; ^ SOURCE OF INFO ^ EDI ID NUMBER - INST ^ EDI ID NUMBER - PROF
- ; ^ INSURANCE REIMBURSE
- ; IBD("IN","MMA")= MAILING STREET ADDRESS [LINE 1] ^
- ; ^ MAILING STREET ADDRESS [LINE 2] ^ CITY ^ STATE NAME ^ ZIP
- ;
- N IB,IBI,IBJ,IBK,IBX,IBNODE,IBTMP,IBIN,Z
- F IBNODE=0,"S","TX","M","U1" S IB(IBNODE)=$G(^DGCR(399,IBIFN,IBNODE))
- S IBD=$S($$MRASEC^IBCEF4(IBIFN):1,1:0)
- S $P(IBD,U,2)=$P(IB("S"),U,7),$P(IBD,U,3)=$P(IB("TX"),U,2)
- S $P(IBD,U,4)=$$GET1^DIQ(399,IBIFN_",",26,"E"),$P(IBD,U,5)=$$GET1^DIQ(399,IBIFN_",",27,"E")
- S $P(IBD,U,6)=$$GET1^DIQ(399,IBIFN_",",24,"E"),$P(IBD,U,7)=$P(IB("TX"),U,3)
- S $P(IBD,U,8)=$P(IB("S"),U,17),$P(IBD,U,9)=$$GET1^DIQ(399,IBIFN_",",.19,"E")
- S Z=$$CURR^IBCEF2(IBIFN),$P(IBD,U,10)=Z_$S(Z:";"_$P($G(^DIC(36,Z,0)),U),1:"")
- S Z=$P($G(^DIC(36,+Z,3)),U,10),$P(IBD,U,15)=$P($G(^IBE(365.12,+Z,0)),U,2),$P(IBD,U,16)=$P($G(^(0)),U)
- S Z=$P(IB(0),U,8),$P(IBD,U,11)=$S(Z:$$GET1^DIQ(45,Z_",",9,"E"),1:"")
- S $P(IBD,U,12)=$$GET1^DIQ(399,IBIFN_",",460,"E")
- S Z=$P($G(^DGCR(399,IBIFN,"U2")),U,10),$P(IBD,U,13)=$S(Z:$P($G(^IBA(355.93,Z,0)),U,1),1:"")
- ;
- S $P(IBD,U,14)=$$DAYS(IBIFN)
- S $P(IBD,U,17)=$P(IB("U1"),U,2)
- ;
- K IBTMP D SET^IBCSC5B(IBIFN,.IBTMP)
- S (IBI,IBJ)=0 F S IBI=$O(IBTMP(IBI)) Q:'IBI D
- . S IBK=0 F S IBK=$O(IBTMP(IBI,IBK)) Q:'IBK D
- .. S IBX=IBTMP(IBI,IBK)
- .. S IBJ=IBJ+1
- .. S IBD("PRD",IBJ)=$$PINB^IBCSC5B(+IBX)_U_IBI_U_+IBTMP
- ;
- S Z=" ",IBD("IN")="",DFN=+$P(IB(0),U,2)
- F S Z=$O(^DPT(DFN,.312,Z),-1) Q:Z="" D Q:Z=""
- . ;IB*2.0*516/TAZ - Use HIPAA compliant fields
- . ;S IBIN=$G(^DPT(DFN,.312,Z,0)) ; 516 - baa
- . S IBIN=$$ZND^IBCNS1(DFN,Z) ; 516 - baa
- . I +IB("M")=+IBIN D
- .. N IBQ,IBP
- .. S IBP=+$P(IBIN,U,18),IBQ=$G(^IBA(355.3,+IBP,0))
- .. ;S IBD("IN")=$S($P(IBQ,U,9):$$GET1^DIQ(355.3,IBP_",",.09,"E"),1:"")_U_$P(IBQ,U,4)_U_$P(IBIN,U,6)_U_$P($G(^DPT(DFN,.312,Z,1)),U,9)
- .. S IBD("IN")=$$GET1^DIQ(355.3,IBP_",",.09,"E")_U_$P(IBIN,U,3)_U_$P(IBIN,U,6)_U_$P($G(^DPT(DFN,.312,Z,1)),U,9)
- .. S Z=""
- ;
- S Z=$G(^DIC(36,+IB("M"),3))
- S $P(IBD("IN"),U,5)=$P(Z,U,4),$P(IBD("IN"),U,6)=$P(Z,U,2)
- S $P(IBD("IN"),U,7)=$$GET1^DIQ(36,+IB("M")_",",1,"I")
- S Z=$G(^DIC(36,+IB("M"),.11))
- S IBD("IN","MMA")=$P(Z,U,1)_U_$P(Z,U,2)_U_$P(Z,U,4)_U_$S($P(Z,U,5):$P($G(^DIC(5,$P(Z,U,5),0)),U,1),1:"")_U_$P(Z,U,6)
- ;
- Q IBD
- ;
- IBACT(IBIFN,IBARRY) ; Returns IB actions for bill ien IBIFN
- ;IBARRY should be passed by reference and returns:
- ;
- ; IBARRY(seq)=AR bill #^reference #^external STATUS^IB ACTION TYPE NAME
- ; ^UNITS^TOTAL CHARGE^DT BILLD FROM^DT BILLD TO^AR BILL IEN
- ; ^DT ENTRY ADDED^PATIENT SSN^EVENT DATE^RESULTING FROM
- ; ^INSTITUTION IEN
- ;
- N IBNA,IB,IB0,DFN,IBCT,Z
- S IBNA=$$BN1^PRCAFN(IBIFN),IB="",IBCT=0
- F S IB=$O(^IB("ABIL",IBNA,IB)) Q:IB="" D
- . S IBCT=IBCT+1
- . S IB0=$G(^IB(IB,0))
- . I $G(DFN)="" S DFN=$P(IB0,U,2)
- . ;
- . S IBARRY=IBNA_U_$P(IB0,U,1)_U_$$GET1^DIQ(350,IB_",",.05,"E")
- . S Z=$P(IB0,U,3)
- . S IBARRY=IBARRY_U_$S(Z'="":$P($G(^IBE(350.1,Z,0)),U,1),1:"")
- . S IBARRY=IBARRY_U_$P(IB0,U,6) ; UNITS
- . S IBARRY=IBARRY_U_$P(IB0,U,7) ; TOTAL CHARGE
- . S IBARRY=IBARRY_U_$P(IB0,U,14) ; DT BILLD FROM
- . S IBARRY=IBARRY_U_$P(IB0,U,15) ; DT BILLD TO
- . S IBARRY=IBARRY_U_$P(IB0,U,11) ; AR BILL #
- . S IBARRY=IBARRY_U_$P($P($G(^IB(IB,1)),U,2),".",1) ; DT ENTRY ADDED
- . S IBARRY=IBARRY_U_$P(^DPT(DFN,0),U,9) ; SSN
- . S IBARRY=IBARRY_U_$P(IB0,U,17) ; EVENT DT
- . S IBARRY=IBARRY_U_$P(IB0,U,4) ;RESULTING FROM
- . S IBARRY=IBARRY_U_$P(IB0,U,13) ; Institution
- . S IBARRY(IBCT)=IBARRY,IBARRY=""
- Q
- ;
- PREREG(IBBDT,IBEDT) ;Returns Pre-registration data
- N IBDATA
- S IBDATA=$$IBAR^IBJDIPR(IBBDT,IBEDT)
- Q IBDATA
- ;
- BUFFER(IBBDT,IBEDT) ;Returns Buffer data
- N IBDATA
- S IBDATA=$$IBAR^IBCNBOA(IBBDT,IBEDT)
- Q IBDATA
- ;
- DAYS(IBIFN) ; Returns # days site not responsible for MRA
- N X,X1,X2,D0
- S X="" ;No. of days
- G:'$P(IBD,U,2) DAYSQ
- S X2=$P(IBD,U,2) ;MRA Request Date
- S X1=$P(IBD,U,7) ;MRA Recorded Date
- G:'$$MRASEC^IBCEF4(IBIFN) DAYSQ ; Not MEDICARE secondary
- I 'X1!(X1<X2) S X1=DT
- D ^%DTC
- DAYSQ Q X
- ;
- REJ(IBIFN) ; Returns 1 if any rejects found for MRA secondary claim or for
- ; any preceding claims it was cancelled/cloned from
- N X,Y,I,X1,X2,X3,D0,CURSEQ
- S Y=0 ;Y=REJECT FLAG
- G:'$$MRASEC^IBCEF4(IBIFN) REJQ ; Not MEDICARE secondary
- S CURSEQ=$$COBN^IBCEF(IBIFN),X1=+$P($G(^DGCR(399,IBIFN,0)),U,15)
- S D0=IBIFN
- F D Q:'D0!Y
- . ; claim copied from not cancelled and not MRA secondary claim
- . I X1,$P($G(^DGCR(399,X1,0)),U,13)'=7,X1'=IBIFN S D0="" Q
- . I X1,$P($G(^DGCR(399,X1,0)),U,19)'=$P($G(^DGCR(399,D0,0)),U,19) S D0="" Q
- . S I=0 F S I=$O(^IBM(361,"B",D0,I)) Q:'I D Q:Y
- .. S X2=$G(^IBM(361,I,0))
- .. Q:$P(X2,U,3)'="R"!'$P(X2,U,11) ;No reject or no transmit bill
- .. S X3=$TR($P($G(^IBA(364,+$P(X2,U,11),0)),U,8),"PST","123") ;status msg seq
- .. Q:X3'=(CURSEQ-1)
- .. S Y=1
- . I 'Y S D0=X1,X1=+$P($G(^DGCR(399,X1,0)),U,15) S:X1=D0 D0="" Q
- REJQ Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRFN4 6259 printed Mar 13, 2025@21:31:57 Page 2
- IBRFN4 ;ALB/TMK - Supported functions for AR/IB DATA EXTRACT ;15-FEB-2005
- +1 ;;2.0;INTEGRATED BILLING;**301,305,389,516**;21-MAR-94;Build 123
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- IBAREXT(IBIFN,IBD) ; Returns data for claim IBIFN for IB/AR Extract
- +1 ; Data returned (pieces):
- +2 ; 1-MEDICARE Status (0=not MRA secondary, 1=MRA secondary)
- +3 ; 2-Last MRA requested date "S";7 (7 - INTERNAL)
- +4 ; 3-Last Electronic extract date "TX";2 (21 - INTERNAL)
- +5 ; 4-Printed via EDI "TX";7 (26 - EXTERNAL)
- +6 ; 5-Force Claim to Print "TX";8 (27 - EXTERNAL)
- +7 ; 6-Claim MRA Status "TX";5 (24 - EXTERNAL)
- +8 ; 7-MRA recorded date "TX";3 (22 - INTERNAL)
- +9 ; 8-Bill cancelled date "S";17 (17 - INTERNAL)
- +10 ; 9-form type 0;19 (.19 - EXTERNAL)
- +11 ; 10-Current Payer $$CURR^IBCEF2(IBIFN) returns IEN;NAME (file 36)
- +12 ; 11-DRG 0;8==> file 45 (9 - EXTERNAL)
- +13 ; 12-ECME # "M1";8 (460 - EXTERNAL)
- +14 ; 13-NON-VA Facility
- +15 ; 14-#Days Site Not Responsible for MRA ($$DAYS(IBIFN))
- +16 ; 15-National VA id number for Ins Verification (365.12;.02 - INTERNAL)
- +17 ; 16-Payer name (file 365.12;.01)
- +18 ; 17-Offset Amount (202-INTERNAL)
- +19 ;
- +20 ; IBD("PRD",seq #)=prosthetic item name^date^bill ien
- +21 ; IBD("IN")= TYPE OF PLAN NAME ^ GROUP NUMBER ^ RELATIONSHIP TO INSURED
- +22 ; ^ SOURCE OF INFO ^ EDI ID NUMBER - INST ^ EDI ID NUMBER - PROF
- +23 ; ^ INSURANCE REIMBURSE
- +24 ; IBD("IN","MMA")= MAILING STREET ADDRESS [LINE 1] ^
- +25 ; ^ MAILING STREET ADDRESS [LINE 2] ^ CITY ^ STATE NAME ^ ZIP
- +26 ;
- +27 NEW IB,IBI,IBJ,IBK,IBX,IBNODE,IBTMP,IBIN,Z
- +28 FOR IBNODE=0,"S","TX","M","U1"
- SET IB(IBNODE)=$GET(^DGCR(399,IBIFN,IBNODE))
- +29 SET IBD=$SELECT($$MRASEC^IBCEF4(IBIFN):1,1:0)
- +30 SET $PIECE(IBD,U,2)=$PIECE(IB("S"),U,7)
- SET $PIECE(IBD,U,3)=$PIECE(IB("TX"),U,2)
- +31 SET $PIECE(IBD,U,4)=$$GET1^DIQ(399,IBIFN_",",26,"E")
- SET $PIECE(IBD,U,5)=$$GET1^DIQ(399,IBIFN_",",27,"E")
- +32 SET $PIECE(IBD,U,6)=$$GET1^DIQ(399,IBIFN_",",24,"E")
- SET $PIECE(IBD,U,7)=$PIECE(IB("TX"),U,3)
- +33 SET $PIECE(IBD,U,8)=$PIECE(IB("S"),U,17)
- SET $PIECE(IBD,U,9)=$$GET1^DIQ(399,IBIFN_",",.19,"E")
- +34 SET Z=$$CURR^IBCEF2(IBIFN)
- SET $PIECE(IBD,U,10)=Z_$SELECT(Z:";"_$PIECE($GET(^DIC(36,Z,0)),U),1:"")
- +35 SET Z=$PIECE($GET(^DIC(36,+Z,3)),U,10)
- SET $PIECE(IBD,U,15)=$PIECE($GET(^IBE(365.12,+Z,0)),U,2)
- SET $PIECE(IBD,U,16)=$PIECE($GET(^(0)),U)
- +36 SET Z=$PIECE(IB(0),U,8)
- SET $PIECE(IBD,U,11)=$SELECT(Z:$$GET1^DIQ(45,Z_",",9,"E"),1:"")
- +37 SET $PIECE(IBD,U,12)=$$GET1^DIQ(399,IBIFN_",",460,"E")
- +38 SET Z=$PIECE($GET(^DGCR(399,IBIFN,"U2")),U,10)
- SET $PIECE(IBD,U,13)=$SELECT(Z:$PIECE($GET(^IBA(355.93,Z,0)),U,1),1:"")
- +39 ;
- +40 SET $PIECE(IBD,U,14)=$$DAYS(IBIFN)
- +41 SET $PIECE(IBD,U,17)=$PIECE(IB("U1"),U,2)
- +42 ;
- +43 KILL IBTMP
- DO SET^IBCSC5B(IBIFN,.IBTMP)
- +44 SET (IBI,IBJ)=0
- FOR
- SET IBI=$ORDER(IBTMP(IBI))
- if 'IBI
- QUIT
- Begin DoDot:1
- +45 SET IBK=0
- FOR
- SET IBK=$ORDER(IBTMP(IBI,IBK))
- if 'IBK
- QUIT
- Begin DoDot:2
- +46 SET IBX=IBTMP(IBI,IBK)
- +47 SET IBJ=IBJ+1
- +48 SET IBD("PRD",IBJ)=$$PINB^IBCSC5B(+IBX)_U_IBI_U_+IBTMP
- End DoDot:2
- End DoDot:1
- +49 ;
- +50 SET Z=" "
- SET IBD("IN")=""
- SET DFN=+$PIECE(IB(0),U,2)
- +51 FOR
- SET Z=$ORDER(^DPT(DFN,.312,Z),-1)
- if Z=""
- QUIT
- Begin DoDot:1
- +52 ;IB*2.0*516/TAZ - Use HIPAA compliant fields
- +53 ;S IBIN=$G(^DPT(DFN,.312,Z,0)) ; 516 - baa
- +54 ; 516 - baa
- SET IBIN=$$ZND^IBCNS1(DFN,Z)
- +55 IF +IB("M")=+IBIN
- Begin DoDot:2
- +56 NEW IBQ,IBP
- +57 SET IBP=+$PIECE(IBIN,U,18)
- SET IBQ=$GET(^IBA(355.3,+IBP,0))
- +58 ;S IBD("IN")=$S($P(IBQ,U,9):$$GET1^DIQ(355.3,IBP_",",.09,"E"),1:"")_U_$P(IBQ,U,4)_U_$P(IBIN,U,6)_U_$P($G(^DPT(DFN,.312,Z,1)),U,9)
- +59 SET IBD("IN")=$$GET1^DIQ(355.3,IBP_",",.09,"E")_U_$PIECE(IBIN,U,3)_U_$PIECE(IBIN,U,6)_U_$PIECE($GET(^DPT(DFN,.312,Z,1)),U,9)
- +60 SET Z=""
- End DoDot:2
- End DoDot:1
- if Z=""
- QUIT
- +61 ;
- +62 SET Z=$GET(^DIC(36,+IB("M"),3))
- +63 SET $PIECE(IBD("IN"),U,5)=$PIECE(Z,U,4)
- SET $PIECE(IBD("IN"),U,6)=$PIECE(Z,U,2)
- +64 SET $PIECE(IBD("IN"),U,7)=$$GET1^DIQ(36,+IB("M")_",",1,"I")
- +65 SET Z=$GET(^DIC(36,+IB("M"),.11))
- +66 SET IBD("IN","MMA")=$PIECE(Z,U,1)_U_$PIECE(Z,U,2)_U_$PIECE(Z,U,4)_U_$SELECT($PIECE(Z,U,5):$PIECE($GET(^DIC(5,$PIECE(Z,U,5),0)),U,1),1:"")_U_$PIECE(Z,U,6)
- +67 ;
- +68 QUIT IBD
- +69 ;
- IBACT(IBIFN,IBARRY) ; Returns IB actions for bill ien IBIFN
- +1 ;IBARRY should be passed by reference and returns:
- +2 ;
- +3 ; IBARRY(seq)=AR bill #^reference #^external STATUS^IB ACTION TYPE NAME
- +4 ; ^UNITS^TOTAL CHARGE^DT BILLD FROM^DT BILLD TO^AR BILL IEN
- +5 ; ^DT ENTRY ADDED^PATIENT SSN^EVENT DATE^RESULTING FROM
- +6 ; ^INSTITUTION IEN
- +7 ;
- +8 NEW IBNA,IB,IB0,DFN,IBCT,Z
- +9 SET IBNA=$$BN1^PRCAFN(IBIFN)
- SET IB=""
- SET IBCT=0
- +10 FOR
- SET IB=$ORDER(^IB("ABIL",IBNA,IB))
- if IB=""
- QUIT
- Begin DoDot:1
- +11 SET IBCT=IBCT+1
- +12 SET IB0=$GET(^IB(IB,0))
- +13 IF $GET(DFN)=""
- SET DFN=$PIECE(IB0,U,2)
- +14 ;
- +15 SET IBARRY=IBNA_U_$PIECE(IB0,U,1)_U_$$GET1^DIQ(350,IB_",",.05,"E")
- +16 SET Z=$PIECE(IB0,U,3)
- +17 SET IBARRY=IBARRY_U_$SELECT(Z'="":$PIECE($GET(^IBE(350.1,Z,0)),U,1),1:"")
- +18 ; UNITS
- SET IBARRY=IBARRY_U_$PIECE(IB0,U,6)
- +19 ; TOTAL CHARGE
- SET IBARRY=IBARRY_U_$PIECE(IB0,U,7)
- +20 ; DT BILLD FROM
- SET IBARRY=IBARRY_U_$PIECE(IB0,U,14)
- +21 ; DT BILLD TO
- SET IBARRY=IBARRY_U_$PIECE(IB0,U,15)
- +22 ; AR BILL #
- SET IBARRY=IBARRY_U_$PIECE(IB0,U,11)
- +23 ; DT ENTRY ADDED
- SET IBARRY=IBARRY_U_$PIECE($PIECE($GET(^IB(IB,1)),U,2),".",1)
- +24 ; SSN
- SET IBARRY=IBARRY_U_$PIECE(^DPT(DFN,0),U,9)
- +25 ; EVENT DT
- SET IBARRY=IBARRY_U_$PIECE(IB0,U,17)
- +26 ;RESULTING FROM
- SET IBARRY=IBARRY_U_$PIECE(IB0,U,4)
- +27 ; Institution
- SET IBARRY=IBARRY_U_$PIECE(IB0,U,13)
- +28 SET IBARRY(IBCT)=IBARRY
- SET IBARRY=""
- End DoDot:1
- +29 QUIT
- +30 ;
- PREREG(IBBDT,IBEDT) ;Returns Pre-registration data
- +1 NEW IBDATA
- +2 SET IBDATA=$$IBAR^IBJDIPR(IBBDT,IBEDT)
- +3 QUIT IBDATA
- +4 ;
- BUFFER(IBBDT,IBEDT) ;Returns Buffer data
- +1 NEW IBDATA
- +2 SET IBDATA=$$IBAR^IBCNBOA(IBBDT,IBEDT)
- +3 QUIT IBDATA
- +4 ;
- DAYS(IBIFN) ; Returns # days site not responsible for MRA
- +1 NEW X,X1,X2,D0
- +2 ;No. of days
- SET X=""
- +3 if '$PIECE(IBD,U,2)
- GOTO DAYSQ
- +4 ;MRA Request Date
- SET X2=$PIECE(IBD,U,2)
- +5 ;MRA Recorded Date
- SET X1=$PIECE(IBD,U,7)
- +6 ; Not MEDICARE secondary
- if '$$MRASEC^IBCEF4(IBIFN)
- GOTO DAYSQ
- +7 IF 'X1!(X1<X2)
- SET X1=DT
- +8 DO ^%DTC
- DAYSQ QUIT X
- +1 ;
- REJ(IBIFN) ; Returns 1 if any rejects found for MRA secondary claim or for
- +1 ; any preceding claims it was cancelled/cloned from
- +2 NEW X,Y,I,X1,X2,X3,D0,CURSEQ
- +3 ;Y=REJECT FLAG
- SET Y=0
- +4 ; Not MEDICARE secondary
- if '$$MRASEC^IBCEF4(IBIFN)
- GOTO REJQ
- +5 SET CURSEQ=$$COBN^IBCEF(IBIFN)
- SET X1=+$PIECE($GET(^DGCR(399,IBIFN,0)),U,15)
- +6 SET D0=IBIFN
- +7 FOR
- Begin DoDot:1
- +8 ; claim copied from not cancelled and not MRA secondary claim
- +9 IF X1
- IF $PIECE($GET(^DGCR(399,X1,0)),U,13)'=7
- IF X1'=IBIFN
- SET D0=""
- QUIT
- +10 IF X1
- IF $PIECE($GET(^DGCR(399,X1,0)),U,19)'=$PIECE($GET(^DGCR(399,D0,0)),U,19)
- SET D0=""
- QUIT
- +11 SET I=0
- FOR
- SET I=$ORDER(^IBM(361,"B",D0,I))
- if 'I
- QUIT
- Begin DoDot:2
- +12 SET X2=$GET(^IBM(361,I,0))
- +13 ;No reject or no transmit bill
- if $PIECE(X2,U,3)'="R"!'$PIECE(X2,U,11)
- QUIT
- +14 ;status msg seq
- SET X3=$TRANSLATE($PIECE($GET(^IBA(364,+$PIECE(X2,U,11),0)),U,8),"PST","123")
- +15 if X3'=(CURSEQ-1)
- QUIT
- +16 SET Y=1
- End DoDot:2
- if Y
- QUIT
- +17 IF 'Y
- SET D0=X1
- SET X1=+$PIECE($GET(^DGCR(399,X1,0)),U,15)
- if X1=D0
- SET D0=""
- QUIT
- End DoDot:1
- if 'D0!Y
- QUIT
- REJQ QUIT Y
