47 lines
3.6 KiB
Mathematica
47 lines
3.6 KiB
Mathematica
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
|