29 lines
2.3 KiB
Mathematica
29 lines
2.3 KiB
Mathematica
FBAADD ;AISC/GRR-REJECT ENTIRE BATCH ;08AUG86
|
|
;;3.5;FEE BASIS;;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
RD S DIR(0)="Y",DIR("A")="Are you sure you want to reject all line items in this batch",DIR("B")="NO" D ^DIR K DIR G Q^FBAAVR:$D(DIRUT),RD1^FBAAVR:'Y
|
|
D CK1358^FBAAUTL1 G Q^FBAAVR:$D(FBERR)
|
|
S FBAARA=$P(FZ,"^",9),FBAAON=$P(FZ,"^",2) I FBAARA'>0!($P(FZ,"^",11)'>0) G NOLINE
|
|
RR S DIR(0)="F^2:40",DIR("A")="Enter reason for rejecting (2-40 characters)",DIR("?")="Please enter the reason this item was rejected" D ^DIR K DIR G:$D(DIRUT) Q^FBAAVR S FBRR=X
|
|
D WAIT^DICD,ALLM:FBTYPE="B3",ALLT:FBTYPE="B2",ALLP:FBTYPE="B5",ALLC:FBTYPE="B9"
|
|
G RDD^FBAAVR
|
|
ALLM F J=0:0 S J=$O(^FBAAC("AC",B,J)) Q:J'>0 F K=0:0 S K=$O(^FBAAC("AC",B,J,K)) Q:K'>0 F L=0:0 S L=$O(^FBAAC("AC",B,J,K,L)) Q:L'>0 F M=0:0 S M=$O(^FBAAC("AC",B,J,K,L,M)) Q:M'>0 D REJM
|
|
ADONE S $P(FZ,"^",9)=0,$P(FZ,"^",10)=0,$P(FZ,"^",11)=0,$P(FZ,"^",17)="Y",^FBAA(161.7,B,0)=FZ
|
|
W !!,"All items in batch flagged as rejected!!" S:FBTYPE'="B9" FBRFLAG=1 Q
|
|
REJM S $P(^FBAAC(J,1,K,1,L,1,M,"FBREJ"),"^",3)=$P(^FBAAC(J,1,K,1,L,1,M,0),"^",8),$P(^(0),"^",8)="",FBIN=$P(^(0),"^",16),$P(^("FBREJ"),"^",1)="P",$P(^("FBREJ"),"^",2)=FBRR,^FBAAC("AH",B,J,K,L,M)=""
|
|
K ^FBAAC("AC",B,J,K,L,M),^FBAAC("AJ",B,FBIN,J,K,L,M) Q
|
|
ALLT F J=0:0 S J=$O(^FBAAC("AD",B,J)) Q:J'>0 F K=0:0 S K=$O(^FBAAC("AD",B,J,K)) Q:K'>0 D REJT
|
|
G ADONE
|
|
REJT ;SETUP REJECT FIELDS FOR TRAVEL
|
|
S $P(^FBAAC(J,3,K,"FBREJ"),"^",3)=$P(^FBAAC(J,3,K,0),"^",2),$P(^(0),"^",2)="" K ^FBAAC("AD",B,J,K) S ^FBAAC("AG",B,J,K)="",$P(^FBAAC(J,3,K,"FBREJ"),"^",2)=FBRR,$P(^("FBREJ"),"^",1)="P"
|
|
Q
|
|
ALLP F J=0:0 S J=$O(^FBAA(162.1,"AE",B,J)) Q:J'>0 F K=0:0 S K=$O(^FBAA(162.1,"AE",B,J,K)) Q:K'>0 D REJP
|
|
G ADONE
|
|
REJP S $P(^FBAA(162.1,J,"RX",K,"FBREJ"),"^",1)="P",$P(^("FBREJ"),"^",2)=FBRR,$P(^("FBREJ"),"^",3)=B,$P(^(0),"^",17)="",FBPID=$P(^(0),"^",5),^FBAA(162.1,"AF",B,J,K)="" K ^FBAA(162.1,"AE",B,J,K),^FBAA(162.1,"AJ",B,FBPID,J,K)
|
|
Q
|
|
ALLC F J=0:0 S J=$O(^FBAAI("AC",B,J)) Q:J'>0 S J(0)="P"_"^"_FBRR_"^"_B,^FBAAI(J,"FBREJ")=J(0),$P(^FBAAI(J,0),"^",17)="",^FBAAI("AH",B,J)="" K ^FBAAI("AC",B,J),^FBAAI("AE",B,$P(^FBAAI(J,0),"^",4),J) D
|
|
.S FBAAMT=-($P(^FBAAI(J,0),"^",9)),FBII78=$P(^(0),"^",5),FBMM=$E($P(^(0),U,6),4,5) D INPOST^FBAARD3
|
|
G ADONE
|
|
NOLINE W *7,!!,"Total dollars/Line count of batch is equal zero!",! D Q^FBAAVR G ^FBAAVR
|
|
Q
|