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

Last change on this file since 1556 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1FBAARJP ;AISC/GRR-PRINT REJECTS PENDING MAS ACTION ;08AUG86
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 S VAR="",VAL="",PGM="START^FBAARJP"
5 D ZIS^FBAAUTL G:FBPOP END
6START 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
7 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
8 I 'CNT W !!,*7,"No Rejects Pending!"
9END 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
10 K FBAC,FBAP,FBDX,FBK,FBL,FBPDT,FBPROC,FBSC,FBTD,FBFD
11 D CLOSE^FBAAUTL Q
12MED 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
13 Q
14MORE D HED,HED^FBAACCB,HEDB
15 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
16 Q:FBAAOUT W !,UL,! D ASKH^FBAACCB0:$E(IOST,1,2)["C-"&('$G(FBNNP)) Q:FBAAOUT W:'$G(FBNNP) @IOF
17 Q
18HEDB W !,"Batch Number: ",FBNUM,?21,"Voucher Date: ",$$DATX^FBAAUTL(FBVD),?44,"Voucherer: ",$S(FBVDUZ="":"",$D(^VA(200,FBVDUZ,0)):$P(^(0),"^",1),1:"Unknown"),!
19 Q
20WRITM 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
21TRAV 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
22 Q
23TMORE D HED,HEDP^FBAACCB0,HEDB
24 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
25 Q:FBAAOUT W !,UL,! D ASKH^FBAACCB0:$E(IOST,1,2)["C-"&('$G(FBNNP)) Q:FBAAOUT W:'$G(FBNNP) @IOF
26 Q
27WRITT S CNT=CNT+1,FBRR=$P(^FBAAC(J,3,K,"FBREJ"),"^",2) W !,?7,"Reject Reason: ",FBRR Q
28PHARM 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
29 Q
30PMORE D HED,HED^FBAACCB,HEDB
31 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
32 Q:FBAAOUT W !,UL,! D ASKH^FBAACCB0:$E(IOST,1,2)="C-"&('$G(FBNNP)) Q:FBAAOUT W:'$G(FBNNP) @IOF
33 Q
34WRITP 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
35CHNH 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
36 Q
37CMORE D HED,HEDC^FBAACCB1,HEDB
38 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
39 Q:FBAAOUT W !,UL,! D ASKH^FBAACCB0:$E(IOST,1,2)="C-"&('$G(FBNNP)) Q:FBAAOUT W:'$G(FBNNP) @IOF
40 Q
41WRITC 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
42 ;
43HED ;write header for report if sent to printer
44 Q:$E(IOST,1,2)="C-"
45 W !?31,"REJECTS PENDING ACTION",!?30,$E(Q,1,24),!
46 Q
Note: See TracBrowser for help on using the repository browser.