FBAARR0.m

FBAARR0 ;AISC/GRR - REINITIATE BATCH CONTINUED ;3/28/2012

 ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17

 ;;Per VHA Directive 2004-038, this routine should not be modified.

HELP W !!,"Enter the batch number to which the rejected items you re-initiate will",!,"be assigned to. It must be an open batch and assigned to you."

 G BTN^FBAARR

CHKOB W !!,*7,"The obligation number from the batch with rejects"

 W !,"is not the same as the new batch selected !"

 S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="NO"

 D ^DIR K DIR I $D(DIRUT)!'Y D UNLK^FBAARR G BT^FBAARR

 G ASKLL^FBAARR

DELC S (QQ,FBAAOUT)=0 W @IOF D HEDC^FBAACCB1

 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 WRITC

RL S ERR=0 S DIR(0)="N^1:"_QQ,DIR("A")="Re-Initiate which line item" D ^DIR K DIR G:$D(DIRUT) END^FBAARR S HX=X

 I '$D(QQ(HX)) W !,*7,"You already did that one !!" G RL

ASKSU S DIR(0)="Y",DIR("A")="Are you sure you want to re-initiate line item number:  "_HX,DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT)!'Y RL

 S J=QQ(HX)

 K FBERR

 D REJC^FBAARR1

ASKRI S DIR(0)="Y",DIR("A")=$S($G(FBERR):"",1:"Item Re-initiated.  ")_"Want to re-initiate another",DIR("B")="YES" D ^DIR K DIR G ASKRI:$D(DIRUT),DELC:Y

 Q

WRITC S QQ=QQ+1,QQ(QQ)=I D CMORE^FBAACCB1 Q

 ;

NEWBT S FBSTN=$P(FZ,"^",8),FBDCB=$P(FZ,"^",13)

 W ! D GETNXB^FBAAUTL W !!,*7,"New Batch for Rejects is: ",FBBN

 S DLAYGO=161.7,X=FBBN,DIC(0)="LQ",DIC("DR")="1////^S X=FBOB;2////^S X=""B9"";3////^S X=DT;4////^S X=DUZ;4.5////^S X=FBDCB;11////^S X=$S(FBEXMPT[""Y"":""O"",1:""A"");16////^S X=FBSTN;17////^S X=""Y"";18////^S X=FBEXMPT"

 K DD,DO D FILE^DICN K DIC,DLAYGO S FBNB=+Y

 S FBNUM=$P(FZ,"^",1),FBVD=$P(FZ,"^",12),FBVDUZ=$P(FZ,"^",16),FBNOB=FBOB

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAARR0   1746     printed  Apr 09, 2024@21:05:38                                                                                                                                                                                                     Page 2

FBAARR0   ;AISC/GRR - REINITIATE BATCH CONTINUED ;3/28/2012

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

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

HELP       WRITE !!,"Enter the batch number to which the rejected items you re-initiate will",!,"be assigned to. It must be an open batch and assigned to you."

 +1        GOTO BTN^FBAARR

CHKOB      WRITE !!,*7,"The obligation number from the batch with rejects"

 +1        WRITE !,"is not the same as the new batch selected !"

 +2        SET DIR(0)="Y"

           SET DIR("A")="Do you want to continue"

           SET DIR("B")="NO"

 +3        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!'Y

               DO UNLK^FBAARR

               GOTO BT^FBAARR

 +4        GOTO ASKLL^FBAARR

DELC       SET (QQ,FBAAOUT)=0

           WRITE @IOF

           DO HEDC^FBAACCB1

 +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 WRITC

RL         SET ERR=0

           SET DIR(0)="N^1:"_QQ

           SET DIR("A")="Re-Initiate which line item"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO END^FBAARR

           SET HX=X

 +1        IF '$DATA(QQ(HX))

               WRITE !,*7,"You already did that one !!"

               GOTO RL

ASKSU      SET DIR(0)="Y"

           SET DIR("A")="Are you sure you want to re-initiate line item number:  "_HX

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)!'Y

               GOTO RL

 +1        SET J=QQ(HX)

 +2        KILL FBERR

 +3        DO REJC^FBAARR1

ASKRI      SET DIR(0)="Y"

           SET DIR("A")=$SELECT($GET(FBERR):"",1:"Item Re-initiated.  ")_"Want to re-initiate another"

           SET DIR("B")="YES"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO ASKRI

           if Y

               GOTO DELC

 +1        QUIT 

WRITC      SET QQ=QQ+1

           SET QQ(QQ)=I

           DO CMORE^FBAACCB1

           QUIT 

 +1       ;

NEWBT      SET FBSTN=$PIECE(FZ,"^",8)

           SET FBDCB=$PIECE(FZ,"^",13)

 +1        WRITE !

           DO GETNXB^FBAAUTL

           WRITE !!,*7,"New Batch for Rejects is: ",FBBN

 +2        SET DLAYGO=161.7

           SET X=FBBN

           SET DIC(0)="LQ"

           SET DIC("DR")="1////^S X=FBOB;2////^S X=""B9"";3////^S X=DT;4////^S X=DUZ;4.5////^S X=FBDCB;11////^S X=$S(FBEXMPT[""Y"":""O"",1:""A"");16////^S X=FBSTN;17////^S X=""Y"";18////^S X=FBEXMPT"

 +3        KILL DD,DO

           DO FILE^DICN

           KILL DIC,DLAYGO

           SET FBNB=+Y

 +4        SET FBNUM=$PIECE(FZ,"^",1)

           SET FBVD=$PIECE(FZ,"^",12)

           SET FBVDUZ=$PIECE(FZ,"^",16)

           SET FBNOB=FBOB

 +5        QUIT