source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAARJP.m@ 1361

FBAARJP ;AISC/GRR-PRINT REJECTS PENDING MAS ACTION ;08AUG86
 ;;3.5;FEE BASIS;;JAN 30, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 S VAR="",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
 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)),^("ST")="V" S B(0)=^(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,?21,"Voucher Date: ",$$DATX^FBAAUTL(FBVD),?44,"Voucherer: ",$S(FBVDUZ="":"",$D(^VA(200,FBVDUZ,0)):$P(^(0),"^",1),1:"Unknown"),!
 Q
WRITM Q:FBAAOUT  S CNT=CNT+1,FBRR=$P(^FBAAC(J,1,K,1,L,1,M,"FBREJ"),"^",2) W !,?7,"Reject Reason: ",FBRR,!,?7,"Old Batch #: ",$S($D(^FBAA(161.7,+$P(^("FBREJ"),"^",3),0)):$P(^(0),"^"),1:"") Q
TRAV F B=0:0 S B=$O(^FBAAC("AG",B)) Q:B'>0!(FBAAOUT)  I $D(^FBAA(161.7,B,0)),^("ST")="V" S B(0)=^(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,FBRR=$P(^FBAAC(J,3,K,"FBREJ"),"^",2) W !,?7,"Reject Reason: ",FBRR 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)),^("ST")="V" S B(0)=^(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,FBRR=$P(^FBAA(162.1,A,"RX",B2,"FBREJ"),"^",2) W !,?7,"Reject Reason: ",FBRR,!,?7,"Old Batch #: ",$S($D(^FBAA(161.7,$P(^("FBREJ"),"^",3),0)):$P(^(0),"^"),1:"") Q
CHNH F B=0:0 S B=$O(^FBAAI("AH",B)) Q:B'>0!(FBAAOUT)  I $D(^FBAA(161.7,B,0)),^("ST")="V" S B(0)=^(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,FBRR=$P(^FBAAI(I,"FBREJ"),"^",2) W !,?7,"Reject Reason: ",FBRR,!,?7,"Old Batch #: ",$S($D(^FBAA(161.7,$P(^("FBREJ"),"^",3),0)):$P(^(0),"^"),1:"") Q
 ;
HED ;write header for report if sent to printer
 Q:$E(IOST,1,2)="C-"
 W !?31,"REJECTS PENDING ACTION",!?30,$E(Q,1,24),!
 Q