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 ---[H[J[2J[HFBAARR0 1746 printed Dec 13, 2024@01:56:29 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
