FBAARJP.m

FBAARJP ;AISC/GRR - PRINT REJECTS PENDING ACTION ;12/23/15  15:25

 ;;3.5;FEE BASIS;**132,165**;JAN 30, 1995;Build 7

 ;;Per VA Directive 6402, this routine should not be modified.

 ; ICR# 10103 XLFDT, ICR# 10005 DT^DICRW

 D:$D(DT)#10=0 DT^DICRW

 ; ask batch status to report

 S DIR(0)="S^1:CENTRAL FEE ACCEPTED;2:VOUCHERED;3:BOTH"

 S DIR("A")="Select batch status to report"

 S DIR("B")="BOTH"

 D ^DIR K DIR Q:$D(DIRUT)

 S FBSTATL=$S(Y=1:"^F^",Y=2:"^V^",1:"^F^V^")

 S DIR(0)="D^:DT:EP",DIR("A")="Exclude rejects transmitted before"

 S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-730),5)

 S DIR("?")="  Do not include time.",DIR("?",1)="Enter earliest transmission date for payment to be included on report."

 S DIR("?",2)="Response must not be a future date."

 D ^DIR K DIR G:$D(DIRUT) END

 S FBSTARTD=Y

 S VAR="FBSTATL^FBSTARTD",VAL="",PGM="START^FBAARJP"

 D ZIS^FBAAUTL G:FBPOP END

START U IO W:$E(IOST,1,2)="C-" @IOF K QQ,B S (Q,UL)="",$P(Q,"=",80)="=",$P(UL,"-",80)="-",(FBAAOUT,CNT,FBINTOT)=0

 D MED:$D(^FBAAC("AH")) G END:FBAAOUT D TRAV:$D(^FBAAC("AG")) G END:FBAAOUT D PHARM:$D(^FBAA(162.1,"AF")) G END:FBAAOUT D CHNH:$D(^FBAAI("AH")) G END:FBAAOUT

 I 'CNT W !!,*7,"No Rejects Pending!"

END K FBTYPE,FBVDUZ,FBVD,FBPV,CNT,D,I,PGM,Q,UL,VAL,VAR,Y,Z,A1,A2,A3,B,FBAACPT,FBIN,FBNUM,FBRR,FBINTOT,CPTDESC,FBAAOUT,FBVP,J,K,T,X,L,M,N,S,V,VID,XY,ZS,POP,A,B2,FBINOLD

 K FBAC,FBAP,FBDX,FBK,FBL,FBPDT,FBPROC,FBSC,FBTD,FBFD,FBSTATL,FBSTARTD,DIRUT

 D CLOSE^FBAAUTL Q

MED F B=0:0 S B=$O(^FBAAC("AH",B)) Q:B'>0!(FBAAOUT)  I $D(^FBAA(161.7,B,0)),FBSTATL[(U_^("ST")_U),$$DATEOK(B,FBSTARTD) S B(0)=^FBAA(161.7,B,0),FBTYPE=$P(B(0),"^",3),FBNUM=$P(B(0),"^",1),FBVD=$P(B(0),"^",12),FBVDUZ=$P(B(0),"^",16) D MORE

 Q

MORE D HED,HED^FBAACCB,HEDB

 F J=0:0 S J=$O(^FBAAC("AH",B,J)) Q:J'>0!(FBAAOUT)  F K=0:0 S K=$O(^FBAAC("AH",B,J,K)) Q:K'>0!(FBAAOUT)  F L=0:0 S L=$O(^FBAAC("AH",B,J,K,L)) Q:L'>0!(FBAAOUT)  F M=0:0 S M=$O(^FBAAC("AH",B,J,K,L,M)) Q:M'>0!(FBAAOUT)  D SET^FBAACCB,WRITM

 Q:FBAAOUT  W !,UL,! D ASKH^FBAACCB0:$E(IOST,1,2)["C-"&('$G(FBNNP)) Q:FBAAOUT  W:'$G(FBNNP) @IOF

 Q

HEDB W !,"Batch Number: ",FBNUM,?22,"Voucher Date: ",$$DATX^FBAAUTL(FBVD),?45,"Voucherer: ",$S(FBVDUZ="":"",$D(^VA(200,FBVDUZ,0)):$P(^(0),"^",1),1:"Unknown"),!

 Q

WRITM Q:FBAAOUT  S CNT=CNT+1

 N FBL,FBTXT

 D REJTXT(162.03,M_","_L_","_K_","_J_",",.FBTXT)

 S FBL=0 F  S FBL=$O(FBTXT(FBL)) Q:'FBL  D

 . I $Y+3>IOSL D ASKH^FBAACCB0:$E(IOST,1,2)["C-" Q:FBAAOUT  W @IOF D HED^FBAACCB

 . W !,FBTXT(FBL)

 Q

TRAV F B=0:0 S B=$O(^FBAAC("AG",B)) Q:B'>0!(FBAAOUT)  I $D(^FBAA(161.7,B,0)),FBSTATL[(U_^("ST")_U),$$DATEOK(B,FBSTARTD) S B(0)=^FBAA(161.7,B,0),FBTYPE=$P(B(0),"^",3),FBNUM=$P(B(0),"^",1),FBVD=$P(B(0),"^",12),FBVDUZ=$P(B(0),"^",16) D TMORE

 Q

TMORE D HED,HEDP^FBAACCB0,HEDB

 F J=0:0 S J=$O(^FBAAC("AG",B,J)) Q:J'>0  F K=0:0 S K=$O(^FBAAC("AG",B,J,K)) Q:K'>0  S Y(0)=^FBAAC(J,3,K,0) D SETT^FBAACCB0,WRITT

 Q:FBAAOUT  W !,UL,! D ASKH^FBAACCB0:$E(IOST,1,2)["C-"&('$G(FBNNP)) Q:FBAAOUT  W:'$G(FBNNP) @IOF

 Q

WRITT S CNT=CNT+1

 N FBL,FBTXT

 D REJTXT(162.04,K_","_J_",",.FBTXT)

 S FBL=0 F  S FBL=$O(FBTXT(FBL)) Q:'FBL  D

 . I $Y+3>IOSL D ASKH^FBAACCB0:$E(IOST,1,2)["C-" Q:FBAAOUT  W @IOF D HEDP^FBAACCB0

 . W !,FBTXT(FBL)

 Q

PHARM F B=0:0 S B=$O(^FBAA(162.1,"AF",B)) Q:B'>0!(FBAAOUT)  I $D(^FBAA(161.7,B,0)),FBSTATL[(U_^("ST")_U),$$DATEOK(B,FBSTARTD) S B(0)=^FBAA(161.7,B,0),FBTYPE=$P(B(0),"^",3),FBNUM=$P(B(0),"^",1),FBVD=$P(B(0),"^",12),FBVDUZ=$P(B(0),"^",16) D PMORE

 Q

PMORE D HED,HED^FBAACCB,HEDB

 F A=0:0 S A=$O(^FBAA(162.1,"AF",B,A)) Q:A'>0!(FBAAOUT)  S FBIN=A D SETV^FBAACCB0 F B2=0:0 S B2=$O(^FBAA(162.1,"AF",B,A,B2)) Q:B2'>0!(FBAAOUT)  I $D(^FBAA(162.1,A,"RX",B2,0)) S Z(0)=^(0) D MORE^FBAACCB1,WRITP

 Q:FBAAOUT  W !,UL,! D ASKH^FBAACCB0:$E(IOST,1,2)="C-"&('$G(FBNNP)) Q:FBAAOUT  W:'$G(FBNNP) @IOF

 Q

WRITP S CNT=CNT+1

 N FBL,FBTXT

 D REJTXT(162.11,B2_","_A_",",.FBTXT)

 S FBL=0 F  S FBL=$O(FBTXT(FBL)) Q:'FBL  D

 . I $Y+3>IOSL D ASKH^FBAACCB0:$E(IOST,1,2)["C-" Q:FBAAOUT  W @IOF D HED^FBAACCB

 . W !,FBTXT(FBL)

 Q

CHNH F B=0:0 S B=$O(^FBAAI("AH",B)) Q:B'>0!(FBAAOUT)  I $D(^FBAA(161.7,B,0)),FBSTATL[(U_^("ST")_U),$$DATEOK(B,FBSTARTD) S B(0)=^FBAA(161.7,B,0),FBTYPE=$P(B(0),"^",3),FBNUM=$P(B(0),"^",1),FBVD=$P(B(0),"^",12),FBVDUZ=$P(B(0),"^",16) D CMORE

 Q

CMORE D HED,HEDC^FBAACCB1,HEDB

 F I=0:0 S I=$O(^FBAAI("AH",B,I)) Q:I'>0!(FBAAOUT)  I $D(^FBAAI(I,0)) S Z(0)=^(0) D CMORE^FBAACCB1,WRITC

 Q:FBAAOUT  W !,UL,! D ASKH^FBAACCB0:$E(IOST,1,2)="C-"&('$G(FBNNP)) Q:FBAAOUT  W:'$G(FBNNP) @IOF

 Q

WRITC Q:FBAAOUT  S CNT=CNT+1

 N FBL,FBTXT

 D REJTXT(162.5,I_",",.FBTXT)

 S FBL=0 F  S FBL=$O(FBTXT(FBL)) Q:'FBL  D

 . I $Y+3>IOSL D ASKH^FBAACCB0:$E(IOST,1,2)["C-" Q:FBAAOUT  W @IOF D HEDC^FBAACCB1

 . W !,FBTXT(FBL)

 Q

 ;

HED ;write header for report if sent to printer

 Q:$E(IOST,1,2)="C-"

 W !?3,"REJECTS PENDING ACTION - ",$S(FBSTATL["F^V":"CF Accepted & Vouchered",FBSTATL["F":"Central Fee Accepted",FBSTATL["V":"Vouchered",1:"")," Trans Since: ",$$FMTE^XLFDT(FBSTARTD,5),!?3,$E(Q,1,74),!

 Q

 ;

REJTXT(FBFILE,FBIENS,FBTXT) ; get reject text for line item

 ; input

 ;   FBFILE - (required) Sub-File (162.03, 162.04, 162.1, or 162.5)

 ;   FBIENS - (required) IENS of line item, FileMan DBS format

 ;   FBTXT  - array passed by reference, will be initialzed

 ; output

 ;   FBTXT  - array of text with format

 ;            FBTXT(0)=count of lines

 ;            FBTXT(#)=line of text

 ;             where # is sequential number starting at 1

 ;

 N FBC,FBD,FBFIELDS,FBLST,FBRIENS

 K FBTXT

 S (FBC,FBTXT(0))=0

 ; check inputs

 Q:"^162.03^162.04^162.11^162.5^"'[("^"_$G(FBFILE)_"^")

 Q:$G(FBIENS)=""

 ;

 ; determine field numbers based on file

 ; FBFIELDS will contain the numbers of the following fields/sub-file

 ;   piece 1 = batch number

 ;   piece 2 = amount paid

 ;   piece 3 = reject status

 ;   piece 4 = reject reason

 ;   piece 5 = old batch number

 ;   piece 6 = interface reject

 ;   piece 7 = reject code

 ;   piece 8 = reject code sub-file number

 I FBFILE="162.03" S FBFIELDS="7^2^19^20^21^21.3^21.6^162.031"

 I FBFILE="162.04" S FBFIELDS="1^2^4^5^6^6.3^6.6^162.041"

 I FBFILE="162.11" S FBFIELDS="13^6.5^17^18^19^19.3^19.6^162.111"

 I FBFILE="162.5" S FBFIELDS="20^8^13^14^15^15.3^15.6^162.515"

 ;

 S FBD(5)=$$GET1^DIQ(FBFILE,FBIENS,$P(FBFIELDS,"^",5)) ; old batch

 Q:FBD(5)=""  ; line is not rejected

 S FBD(6)=$$GET1^DIQ(FBFILE,FBIENS,$P(FBFIELDS,"^",6),"I") ; inter. rej.

 ;

 ; 1st line

 S FBC=FBC+1

 S FBTXT(FBC)=$$LJ^XLFSTR($S(FBD(6):"Central Fee",1:"Local")_" Reject",20)_"Old Batch #: "_FBD(5)

 ;

 ; line for reject reason (if any)

 S FBD(4)=$$GET1^DIQ(FBFILE,FBIENS,$P(FBFIELDS,"^",4)) ; reject reason

 I FBD(4)]"" S FBC=FBC+1,FBTXT(FBC)="Reject Reason: "_FBD(4)

 ;

 ; lines for reject codes (if any)

 ; get list of entries in REJECT CODE multiple

 D GETS^DIQ(FBFILE,FBIENS,$P(FBFIELDS,"^",7)_"*","","FBLST")

 ;

 ; loop thru REJECT CODE entries

 S FBRIENS=""

 F  S FBRIENS=$O(FBLST($P(FBFIELDS,"^",8),FBRIENS)) Q:FBRIENS=""  D

 . N FBARR,FBRC,FBLI

 . S FBRC=FBLST($P(FBFIELDS,"^",8),FBRIENS,.01) ; REJECT CODE

 . Q:FBRC=""

 . ; get description of code from file 161.99

 . D RCDES(FBRC,,.FBARR)

 . ;

 . ; add code and first line of description to output array

 . S FBC=FBC+1

 . S FBTXT(FBC)=$$LJ^XLFSTR("Rej Code: "_FBRC,16)

 . I $D(FBARR(1,0)) S FBTXT(FBC)=FBTXT(FBC)_FBARR(1,0)

 . ;

 . ; loop thru remaining description lines

 . S FBLI=1 F  S FBLI=$O(FBARR(FBLI)) Q:'FBLI  D

 . . Q:'$D(FBARR(FBLI,0))

 . . ; add description line to output array

 . . S FBC=FBC+1

 . . S FBTXT(FBC)="                "_FBARR(FBLI,0)

 ;

 S FBTXT(0)=FBC

 Q

 ;

RCDES(FBRC,FBRM,FBARR) ; Reject Code Description

 ; input

 ;   FBRC  - reject code external value

 ;   FBRM  - (optional) right margin, default 60

 ;   FBARR - array, passed by reference, not FBWP, will be initialized

 ; output

 ;   FBARR - array contained formatted description

 ;           where

 ;             FBARR(0)=line count

 ;             FBARR(1,0)=1st line of description

 ;             FBARR(2,0)=2nd line of description

 ;

 ; note: some variables newed because DIWP call is stepping on I

 N A,B,DIWL,DIWR,DIWF,FBI,FBRCI,FBWP,FBX,I,J,K,L,M

 ;

 S FBRM=$G(FBRM,60)

 K FBARR

 Q:$G(FBRC)=""

 ;

 ; find IEN of code

 S FBRCI=$$FIND1^DIC(161.99,,"X",FBRC)

 ;

 ; if entry found then load description from file

 S:FBRCI FBX=$$GET1^DIQ(161.99,FBRCI_",",1,"","FBWP")

 ; if entry not found use default description

 S:'FBRCI FBWP(1)="Reject reason code is not currently defined in list."

 ;

 ; reformat description

 K ^UTILITY($J,"W")

 S DIWL=1,DIWR=FBRM,DIWF=""

 S FBI=0 F  S FBI=$O(FBWP(FBI)) Q:'FBI  S X=FBWP(FBI) D ^DIWP

 ;

 ; move description into output array

 M FBARR=^UTILITY($J,"W",DIWL)

 ;

 K ^UTILITY($J,"W")

 Q

 ;

DATEOK(FBATID,FBSTART) ;Compares batch transmission date to start date

 ; Returns 0 if transmission date earlier than start date

 ; Returns 1 if transmission date equals or is later

 N FBX,FBY

 Q:FBATID'>0 0 Q:FBSTART="" 0

 S FBY=$P($P($G(^FBAA(161.7,FBATID,0)),U,14),".")

 S FBX=$S(FBY="":1,FBY<FBSTART:0,1:1)

 Q FBX

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAARJP   9159     printed  Apr 23, 2025@18:10:55                                                                                                                                                                                                     Page 2

FBAARJP   ;AISC/GRR - PRINT REJECTS PENDING ACTION ;12/23/15  15:25

 +1       ;;3.5;FEE BASIS;**132,165**;JAN 30, 1995;Build 7

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ; ICR# 10103 XLFDT, ICR# 10005 DT^DICRW

 +4        if $DATA(DT)#10=0

               DO DT^DICRW

 +5       ; ask batch status to report

 +6        SET DIR(0)="S^1:CENTRAL FEE ACCEPTED;2:VOUCHERED;3:BOTH"

 +7        SET DIR("A")="Select batch status to report"

 +8        SET DIR("B")="BOTH"

 +9        DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               QUIT 

 +10       SET FBSTATL=$SELECT(Y=1:"^F^",Y=2:"^V^",1:"^F^V^")

 +11       SET DIR(0)="D^:DT:EP"

           SET DIR("A")="Exclude rejects transmitted before"

 +12       SET DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-730),5)

 +13       SET DIR("?")="  Do not include time."

           SET DIR("?",1)="Enter earliest transmission date for payment to be included on report."

 +14       SET DIR("?",2)="Response must not be a future date."

 +15       DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO END

 +16       SET FBSTARTD=Y

 +17       SET VAR="FBSTATL^FBSTARTD"

           SET VAL=""

           SET PGM="START^FBAARJP"

 +18       DO ZIS^FBAAUTL

           if FBPOP

               GOTO END

START      USE IO

           if $EXTRACT(IOST,1,2)="C-"

               WRITE @IOF

           KILL QQ,B

           SET (Q,UL)=""

           SET $PIECE(Q,"=",80)="="

           SET $PIECE(UL,"-",80)="-"

           SET (FBAAOUT,CNT,FBINTOT)=0

 +1        if $DATA(^FBAAC("AH"))

               DO MED

           if FBAAOUT

               GOTO END

           if $DATA(^FBAAC("AG"))

               DO TRAV

           if FBAAOUT

               GOTO END

           if $DATA(^FBAA(162.1,"AF"))

               DO PHARM

           if FBAAOUT

               GOTO END

           if $DATA(^FBAAI("AH"))

               DO CHNH

           if FBAAOUT

               GOTO END

 +2        IF 'CNT

               WRITE !!,*7,"No Rejects Pending!"

END        KILL FBTYPE,FBVDUZ,FBVD,FBPV,CNT,D,I,PGM,Q,UL,VAL,VAR,Y,Z,A1,A2,A3,B,FBAACPT,FBIN,FBNUM,FBRR,FBINTOT,CPTDESC,FBAAOUT,FBVP,J,K,T,X,L,M,N,S,V,VID,XY,ZS,POP,A,B2,FBINOLD

 +1        KILL FBAC,FBAP,FBDX,FBK,FBL,FBPDT,FBPROC,FBSC,FBTD,FBFD,FBSTATL,FBSTARTD,DIRUT

 +2        DO CLOSE^FBAAUTL

           QUIT 

MED        FOR B=0:0

               SET B=$ORDER(^FBAAC("AH",B))

               if B'>0!(FBAAOUT)

                   QUIT 

               IF $DATA(^FBAA(161.7,B,0))

                   IF FBSTATL[(U_^("ST")_U)

                       IF $$DATEOK(B,FBSTARTD)

                           SET B(0)=^FBAA(161.7,B,0)

                           SET FBTYPE=$PIECE(B(0),"^",3)

                           SET FBNUM=$PIECE(B(0),"^",1)

                           SET FBVD=$PIECE(B(0),"^",12)

                           SET FBVDUZ=$PIECE(B(0),"^",16)

                           DO MORE

 +1        QUIT 

MORE       DO HED

           DO HED^FBAACCB

           DO HEDB

 +1        FOR J=0:0

               SET J=$ORDER(^FBAAC("AH",B,J))

               if J'>0!(FBAAOUT)

                   QUIT 

               FOR K=0:0

                   SET K=$ORDER(^FBAAC("AH",B,J,K))

                   if K'>0!(FBAAOUT)

                       QUIT 

                   FOR L=0:0

                       SET L=$ORDER(^FBAAC("AH",B,J,K,L))

                       if L'>0!(FBAAOUT)

                           QUIT 

                       FOR M=0:0

                           SET M=$ORDER(^FBAAC("AH",B,J,K,L,M))

                           if M'>0!(FBAAOUT)

                               QUIT 

                           DO SET^FBAACCB

                           DO WRITM

 +2        if FBAAOUT

               QUIT 

           WRITE !,UL,!

           if $EXTRACT(IOST,1,2)["C-"&('$GET(FBNNP))

               DO ASKH^FBAACCB0

           if FBAAOUT

               QUIT 

           if '$GET(FBNNP)

               WRITE @IOF

 +3        QUIT 

HEDB       WRITE !,"Batch Number: ",FBNUM,?22,"Voucher Date: ",$$DATX^FBAAUTL(FBVD),?45,"Voucherer: ",$SELECT(FBVDUZ="":"",$DATA(^VA(200,FBVDUZ,0)):$PIECE(^(0),"^",1),1:"Unknown"),!

 +1        QUIT 

WRITM      if FBAAOUT

               QUIT 

           SET CNT=CNT+1

 +1        NEW FBL,FBTXT

 +2        DO REJTXT(162.03,M_","_L_","_K_","_J_",",.FBTXT)

 +3        SET FBL=0

           FOR 

               SET FBL=$ORDER(FBTXT(FBL))

               if 'FBL

                   QUIT 

               Begin DoDot:1

 +4                IF $Y+3>IOSL

                       if $EXTRACT(IOST,1,2)["C-"

                           DO ASKH^FBAACCB0

                       if FBAAOUT

                           QUIT 

                       WRITE @IOF

                       DO HED^FBAACCB

 +5                WRITE !,FBTXT(FBL)

               End DoDot:1

 +6        QUIT 

TRAV       FOR B=0:0

               SET B=$ORDER(^FBAAC("AG",B))

               if B'>0!(FBAAOUT)

                   QUIT 

               IF $DATA(^FBAA(161.7,B,0))

                   IF FBSTATL[(U_^("ST")_U)

                       IF $$DATEOK(B,FBSTARTD)

                           SET B(0)=^FBAA(161.7,B,0)

                           SET FBTYPE=$PIECE(B(0),"^",3)

                           SET FBNUM=$PIECE(B(0),"^",1)

                           SET FBVD=$PIECE(B(0),"^",12)

                           SET FBVDUZ=$PIECE(B(0),"^",16)

                           DO TMORE

 +1        QUIT 

TMORE      DO HED

           DO HEDP^FBAACCB0

           DO HEDB

 +1        FOR J=0:0

               SET J=$ORDER(^FBAAC("AG",B,J))

               if J'>0

                   QUIT 

               FOR K=0:0

                   SET K=$ORDER(^FBAAC("AG",B,J,K))

                   if K'>0

                       QUIT 

                   SET Y(0)=^FBAAC(J,3,K,0)

                   DO SETT^FBAACCB0

                   DO WRITT

 +2        if FBAAOUT

               QUIT 

           WRITE !,UL,!

           if $EXTRACT(IOST,1,2)["C-"&('$GET(FBNNP))

               DO ASKH^FBAACCB0

           if FBAAOUT

               QUIT 

           if '$GET(FBNNP)

               WRITE @IOF

 +3        QUIT 

WRITT      SET CNT=CNT+1

 +1        NEW FBL,FBTXT

 +2        DO REJTXT(162.04,K_","_J_",",.FBTXT)

 +3        SET FBL=0

           FOR 

               SET FBL=$ORDER(FBTXT(FBL))

               if 'FBL

                   QUIT 

               Begin DoDot:1

 +4                IF $Y+3>IOSL

                       if $EXTRACT(IOST,1,2)["C-"

                           DO ASKH^FBAACCB0

                       if FBAAOUT

                           QUIT 

                       WRITE @IOF

                       DO HEDP^FBAACCB0

 +5                WRITE !,FBTXT(FBL)

               End DoDot:1

 +6        QUIT 

PHARM      FOR B=0:0

               SET B=$ORDER(^FBAA(162.1,"AF",B))

               if B'>0!(FBAAOUT)

                   QUIT 

               IF $DATA(^FBAA(161.7,B,0))

                   IF FBSTATL[(U_^("ST")_U)

                       IF $$DATEOK(B,FBSTARTD)

                           SET B(0)=^FBAA(161.7,B,0)

                           SET FBTYPE=$PIECE(B(0),"^",3)

                           SET FBNUM=$PIECE(B(0),"^",1)

                           SET FBVD=$PIECE(B(0),"^",12)

                           SET FBVDUZ=$PIECE(B(0),"^",16)

                           DO PMORE

 +1        QUIT 

PMORE      DO HED

           DO HED^FBAACCB

           DO HEDB

 +1        FOR A=0:0

               SET A=$ORDER(^FBAA(162.1,"AF",B,A))

               if A'>0!(FBAAOUT)

                   QUIT 

               SET FBIN=A

               DO SETV^FBAACCB0

               FOR B2=0:0

                   SET B2=$ORDER(^FBAA(162.1,"AF",B,A,B2))

                   if B2'>0!(FBAAOUT)

                       QUIT 

                   IF $DATA(^FBAA(162.1,A,"RX",B2,0))

                       SET Z(0)=^(0)

                       DO MORE^FBAACCB1

                       DO WRITP

 +2        if FBAAOUT

               QUIT 

           WRITE !,UL,!

           if $EXTRACT(IOST,1,2)="C-"&('$GET(FBNNP))

               DO ASKH^FBAACCB0

           if FBAAOUT

               QUIT 

           if '$GET(FBNNP)

               WRITE @IOF

 +3        QUIT 

WRITP      SET CNT=CNT+1

 +1        NEW FBL,FBTXT

 +2        DO REJTXT(162.11,B2_","_A_",",.FBTXT)

 +3        SET FBL=0

           FOR 

               SET FBL=$ORDER(FBTXT(FBL))

               if 'FBL

                   QUIT 

               Begin DoDot:1

 +4                IF $Y+3>IOSL

                       if $EXTRACT(IOST,1,2)["C-"

                           DO ASKH^FBAACCB0

                       if FBAAOUT

                           QUIT 

                       WRITE @IOF

                       DO HED^FBAACCB

 +5                WRITE !,FBTXT(FBL)

               End DoDot:1

 +6        QUIT 

CHNH       FOR B=0:0

               SET B=$ORDER(^FBAAI("AH",B))

               if B'>0!(FBAAOUT)

                   QUIT 

               IF $DATA(^FBAA(161.7,B,0))

                   IF FBSTATL[(U_^("ST")_U)

                       IF $$DATEOK(B,FBSTARTD)

                           SET B(0)=^FBAA(161.7,B,0)

                           SET FBTYPE=$PIECE(B(0),"^",3)

                           SET FBNUM=$PIECE(B(0),"^",1)

                           SET FBVD=$PIECE(B(0),"^",12)

                           SET FBVDUZ=$PIECE(B(0),"^",16)

                           DO CMORE

 +1        QUIT 

CMORE      DO HED

           DO HEDC^FBAACCB1

           DO HEDB

 +1        FOR I=0:0

               SET I=$ORDER(^FBAAI("AH",B,I))

               if I'>0!(FBAAOUT)

                   QUIT 

               IF $DATA(^FBAAI(I,0))

                   SET Z(0)=^(0)

                   DO CMORE^FBAACCB1

                   DO WRITC

 +2        if FBAAOUT

               QUIT 

           WRITE !,UL,!

           if $EXTRACT(IOST,1,2)="C-"&('$GET(FBNNP))

               DO ASKH^FBAACCB0

           if FBAAOUT

               QUIT 

           if '$GET(FBNNP)

               WRITE @IOF

 +3        QUIT 

WRITC      if FBAAOUT

               QUIT 

           SET CNT=CNT+1

 +1        NEW FBL,FBTXT

 +2        DO REJTXT(162.5,I_",",.FBTXT)

 +3        SET FBL=0

           FOR 

               SET FBL=$ORDER(FBTXT(FBL))

               if 'FBL

                   QUIT 

               Begin DoDot:1

 +4                IF $Y+3>IOSL

                       if $EXTRACT(IOST,1,2)["C-"

                           DO ASKH^FBAACCB0

                       if FBAAOUT

                           QUIT 

                       WRITE @IOF

                       DO HEDC^FBAACCB1

 +5                WRITE !,FBTXT(FBL)

               End DoDot:1

 +6        QUIT 

 +7       ;

HED       ;write header for report if sent to printer

 +1        if $EXTRACT(IOST,1,2)="C-"

               QUIT 

 +2        WRITE !?3,"REJECTS PENDING ACTION - ",$SELECT(FBSTATL["F^V":"CF Accepted & Vouchered",FBSTATL["F":"Central Fee Accepted",FBSTATL["V":"Vouchered",1:"")," Trans Since: ",$$FMTE^XLFDT(FBSTARTD,5),!?3,$EXTRACT(Q,1,74),!

 +3        QUIT 

 +4       ;

REJTXT(FBFILE,FBIENS,FBTXT) ; get reject text for line item

 +1       ; input

 +2       ;   FBFILE - (required) Sub-File (162.03, 162.04, 162.1, or 162.5)

 +3       ;   FBIENS - (required) IENS of line item, FileMan DBS format

 +4       ;   FBTXT  - array passed by reference, will be initialzed

 +5       ; output

 +6       ;   FBTXT  - array of text with format

 +7       ;            FBTXT(0)=count of lines

 +8       ;            FBTXT(#)=line of text

 +9       ;             where # is sequential number starting at 1

 +10      ;

 +11       NEW FBC,FBD,FBFIELDS,FBLST,FBRIENS

 +12       KILL FBTXT

 +13       SET (FBC,FBTXT(0))=0

 +14      ; check inputs

 +15       if "^162.03^162.04^162.11^162.5^"'[("^"_$GET(FBFILE)_"^")

               QUIT 

 +16       if $GET(FBIENS)=""

               QUIT 

 +17      ;

 +18      ; determine field numbers based on file

 +19      ; FBFIELDS will contain the numbers of the following fields/sub-file

 +20      ;   piece 1 = batch number

 +21      ;   piece 2 = amount paid

 +22      ;   piece 3 = reject status

 +23      ;   piece 4 = reject reason

 +24      ;   piece 5 = old batch number

 +25      ;   piece 6 = interface reject

 +26      ;   piece 7 = reject code

 +27      ;   piece 8 = reject code sub-file number

 +28       IF FBFILE="162.03"

               SET FBFIELDS="7^2^19^20^21^21.3^21.6^162.031"

 +29       IF FBFILE="162.04"

               SET FBFIELDS="1^2^4^5^6^6.3^6.6^162.041"

 +30       IF FBFILE="162.11"

               SET FBFIELDS="13^6.5^17^18^19^19.3^19.6^162.111"

 +31       IF FBFILE="162.5"

               SET FBFIELDS="20^8^13^14^15^15.3^15.6^162.515"

 +32      ;

 +33      ; old batch

           SET FBD(5)=$$GET1^DIQ(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",5))

 +34      ; line is not rejected

           if FBD(5)=""

               QUIT 

 +35      ; inter. rej.

           SET FBD(6)=$$GET1^DIQ(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",6),"I")

 +36      ;

 +37      ; 1st line

 +38       SET FBC=FBC+1

 +39       SET FBTXT(FBC)=$$LJ^XLFSTR($SELECT(FBD(6):"Central Fee",1:"Local")_" Reject",20)_"Old Batch #: "_FBD(5)

 +40      ;

 +41      ; line for reject reason (if any)

 +42      ; reject reason

           SET FBD(4)=$$GET1^DIQ(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",4))

 +43       IF FBD(4)]""

               SET FBC=FBC+1

               SET FBTXT(FBC)="Reject Reason: "_FBD(4)

 +44      ;

 +45      ; lines for reject codes (if any)

 +46      ; get list of entries in REJECT CODE multiple

 +47       DO GETS^DIQ(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",7)_"*","","FBLST")

 +48      ;

 +49      ; loop thru REJECT CODE entries

 +50       SET FBRIENS=""

 +51       FOR 

               SET FBRIENS=$ORDER(FBLST($PIECE(FBFIELDS,"^",8),FBRIENS))

               if FBRIENS=""

                   QUIT 

               Begin DoDot:1

 +52               NEW FBARR,FBRC,FBLI

 +53      ; REJECT CODE

                   SET FBRC=FBLST($PIECE(FBFIELDS,"^",8),FBRIENS,.01)

 +54               if FBRC=""

                       QUIT 

 +55      ; get description of code from file 161.99

 +56               DO RCDES(FBRC,,.FBARR)

 +57      ;

 +58      ; add code and first line of description to output array

 +59               SET FBC=FBC+1

 +60               SET FBTXT(FBC)=$$LJ^XLFSTR("Rej Code: "_FBRC,16)

 +61               IF $DATA(FBARR(1,0))

                       SET FBTXT(FBC)=FBTXT(FBC)_FBARR(1,0)

 +62      ;

 +63      ; loop thru remaining description lines

 +64               SET FBLI=1

                   FOR 

                       SET FBLI=$ORDER(FBARR(FBLI))

                       if 'FBLI

                           QUIT 

                       Begin DoDot:2

 +65                       if '$DATA(FBARR(FBLI,0))

                               QUIT 

 +66      ; add description line to output array

 +67                       SET FBC=FBC+1

 +68                       SET FBTXT(FBC)="                "_FBARR(FBLI,0)

                       End DoDot:2

               End DoDot:1

 +69      ;

 +70       SET FBTXT(0)=FBC

 +71       QUIT 

 +72      ;

RCDES(FBRC,FBRM,FBARR) ; Reject Code Description

 +1       ; input

 +2       ;   FBRC  - reject code external value

 +3       ;   FBRM  - (optional) right margin, default 60

 +4       ;   FBARR - array, passed by reference, not FBWP, will be initialized

 +5       ; output

 +6       ;   FBARR - array contained formatted description

 +7       ;           where

 +8       ;             FBARR(0)=line count

 +9       ;             FBARR(1,0)=1st line of description

 +10      ;             FBARR(2,0)=2nd line of description

 +11      ;

 +12      ; note: some variables newed because DIWP call is stepping on I

 +13       NEW A,B,DIWL,DIWR,DIWF,FBI,FBRCI,FBWP,FBX,I,J,K,L,M

 +14      ;

 +15       SET FBRM=$GET(FBRM,60)

 +16       KILL FBARR

 +17       if $GET(FBRC)=""

               QUIT 

 +18      ;

 +19      ; find IEN of code

 +20       SET FBRCI=$$FIND1^DIC(161.99,,"X",FBRC)

 +21      ;

 +22      ; if entry found then load description from file

 +23       if FBRCI

               SET FBX=$$GET1^DIQ(161.99,FBRCI_",",1,"","FBWP")