| 1 | PRCHRPT9 ;SF/TKW/WISC/CLH,AKS-PUBLIC LAW 100-322 REPORT ;3/19/93 16:41
|
|---|
| 2 | V ;;5.1;IFCAP;*89*;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN1 S PRCF("X")="SP" D ^PRCFSITE Q:'$D(PRC("SITE"))
|
|---|
| 6 | ;
|
|---|
| 7 | EN10 S PRCHD="DATE",M="DATE RECEIVED" D RNG^PRCHRPT1 G Q:FR["^"!(TO["^") I FR["?"!(TO["?") W $C(7),!!,"Enter a beginning and ending RECEIPT DATE range for this report." G EN10
|
|---|
| 8 | S PRCHNULL=0 I (FR["@")!(TO["@") S PRCHNULL=1 S:FR["@" FR="" S:TO["@" TO="z"
|
|---|
| 9 | W !! S PRCHDET=0,%A="Print Detail Report as well as Summary ",%B="Answer 'YES' to if you wish to print the Detail Report as well as",%B(1)="the Summary, 'NO' if you wish to print ONLY the summary.",%=1 D YN^PRCFYN G:%=-1 Q S:%=1 PRCHDET=1
|
|---|
| 10 | ;
|
|---|
| 11 | EN11 K PRCHQ S PRCHQ="EN2^PRCHRPT9" D ^PRCHQUE
|
|---|
| 12 | G Q
|
|---|
| 13 | ;
|
|---|
| 14 | EN2 D NOW^%DTC S Y=% D DD^%DT S PRCHPDAT=Y K ^TMP($J) S PRCHSITE="** INVALID STATION **",X=$O(^PRC(411,"B",PRC("SITE"),0)) I $D(^PRC(411,+X,0)),$D(^DIC(4,+$P(^(0),U,10),0)) S PRCHSITE=$P(^(0),U,1)
|
|---|
| 15 | S PRCHFT="ALL DATES" I FR S Y=FR D DD^%DT S PRCHFT=Y_" through "
|
|---|
| 16 | S:'TO PRCHFT=PRCHFT_" LAST date" I TO S Y=TO D DD^%DT S PRCHFT=PRCHFT_Y
|
|---|
| 17 | ;**** NOTE: FSC CODES SELECTED ARE SET HERE--CAN BE CHANGED BY ADDING OR DELETING FROM LIST IN TMP
|
|---|
| 18 | F I=65,66,73 S ^TMP($J,"FSCG",I)=$P($G(^PRC(441.3,+I,0)),U,2)
|
|---|
| 19 | S (PRCHPO,PRCHCNT)=0 D RD
|
|---|
| 20 | ;
|
|---|
| 21 | P S PRCHPAGE=0,PRCHDY=99
|
|---|
| 22 | I '$D(^TMP($J,"FSC")) D NONE^PRCHRPTA
|
|---|
| 23 | I $D(^TMP($J,"FSC")) D:PRCHDET EN^PRCHRPTA S PRCHPAGE=0 D EN2^PRCHRPTA
|
|---|
| 24 | W !,$C(13) D:$D(ZTSK) KILL^%ZTLOAD K ZTSK,ZTSKT
|
|---|
| 25 | G Q
|
|---|
| 26 | ;
|
|---|
| 27 | RD S PRCHPO=$O(^PRC(442,PRCHPO)) Q:'PRCHPO G:'$D(^(PRCHPO,0)) RD G:'$D(^(1)) RD S PRCH0=^(0),X=^(1) G:+PRCH0'=PRC("SITE") RD G:'$O(^PRC(442,PRCHPO,11,0)) RD G:"13478"'[($P(PRCH0,U,2)) RD
|
|---|
| 28 | G:$P(X,U,18)="N" RD S PRCHDT=$P(X,U,15) G:PRCHDT]TO RD
|
|---|
| 29 | S PRCHV=+X,PRCHEMG=$P(X,U,17),PRCHSRC=$P($G(^PRCD(420.8,+$P(X,U,7),0)),U,1)
|
|---|
| 30 | S PRCHI=0 D RD1
|
|---|
| 31 | G RD
|
|---|
| 32 | ;
|
|---|
| 33 | RD1 S PRCHI=$O(^PRC(442,PRCHPO,2,PRCHI)) Q:'PRCHI G:'$O(^(PRCHI,3,0)) RD1 S PRCHI0=^PRC(442,PRCHPO,2,PRCHI,0)
|
|---|
| 34 | I $D(^PRC(442,PRCHPO,2,PRCHI,2)) S X=+$P(^(2),U,3) I $D(^TMP($J,"FSCG",$E(X,1,2))) S PRCHFSC=X S:'$D(^TMP($J,"FSC",X)) ^TMP($J,"FSC",X)=$P($G(^PRC(441.2,X,0)),U,2) S PRCHR=0 D RD2
|
|---|
| 35 | G RD1
|
|---|
| 36 | ;
|
|---|
| 37 | RD2 S PRCHR=$O(^PRC(442,PRCHPO,2,PRCHI,3,PRCHR)) Q:'PRCHR G:'$D(^(PRCHR,0)) RD2 S PRCHD0=^(0),PRCHRDT=$P(^(0),U,1) G:FR]PRCHRDT!(PRCHRDT]TO) RD2 D BLD
|
|---|
| 38 | G RD2
|
|---|
| 39 | ;
|
|---|
| 40 | BLD I '$D(^TMP($J,"V",PRCHV)) S:$D(^PRC(440,+PRCHV,0)) ^TMP($J,"V",PRCHV)=$P(^(0),U,1) S:'$D(^TMP($J,"V",PRCHV)) ^(PRCHV)="**INVALID VENDOR**"
|
|---|
| 41 | S (PRCHDESC,ITEMNO)="",UNIT=0
|
|---|
| 42 | I $D(^PRC(441,+$P(PRCHI0,U,5),0)) S PRCHDESC=$P(^(0),U,2),ITEMNO=$P(^(0),U,1)
|
|---|
| 43 | I $D(^PRC(442,PRCHPO,2,PRCHI,0)) S UNIT=$P(^(0),U,3) S:UNIT'="" UNIT=$G(^PRCD(420.5,UNIT,0)),UNIT=$P(UNIT,U) S:UNIT="" UNIT=0
|
|---|
| 44 | I PRCHDESC="" S X=$O(^PRC(442,PRCHPO,2,PRCHI,1,0)) I X,$D(^(X,0)) S PRCHDESC=^(0)
|
|---|
| 45 | S:PRCHDESC="" PRCHDESC="** MISSING ITEM DESCRIPTION **"
|
|---|
| 46 | S PRCHCNT=PRCHCNT+1,PRCHTOT=$P(PRCHD0,U,3),(X,PRCHNIIN)=$P(PRCHI0,U,13) I X]"" S PRCHNIIN=$P(X,"-",2)_"-"_$P(X,"-",3)_"-"_$P(X,"-",4)
|
|---|
| 47 | I X']"" S PRCHNIIN=0
|
|---|
| 48 | S FLG=0 I PRCHSRC=2 S FLG=1
|
|---|
| 49 | I PRCHSRC="B"&($P($G(^PRC(442,PRCHPO,2,PRCHI,2)),U,2)="") S FLG=1
|
|---|
| 50 | I 'FLG D SUM Q
|
|---|
| 51 | S X=$G(^TMP($J,"R",PRCHFSC,$E(PRCHDESC,1,30),UNIT,PRCHNIIN,PRCHSRC))
|
|---|
| 52 | S $P(X,U,2)=PRCHNIIN,$P(X,U,4)=$P(X,U,4)+$P(PRCHD0,U,2)
|
|---|
| 53 | S $P(X,U,6)=$P(X,U,6)+PRCHTOT,$P(X,U,9)=PRCHSRC
|
|---|
| 54 | S:$P(X,U,10)="" $P(X,U,10)=$P(PRCHI0,U,9)
|
|---|
| 55 | I $P(PRCHI0,U,9)<$P(X,U,10) S $P(X,U,10)=$P(PRCHI0,U,9)
|
|---|
| 56 | I $P(PRCHI0,U,9)>$P(X,U,11) S $P(X,U,11)=$P(PRCHI0,U,9)
|
|---|
| 57 | S $P(X,U,12)=ITEMNO
|
|---|
| 58 | S ^TMP($J,"R",PRCHFSC,$E(PRCHDESC,1,30),UNIT,PRCHNIIN,PRCHSRC)=X D SUM
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | SUM S X=^TMP($J,"FSC",PRCHFSC),$P(X,U,2)=$P(X,U,2)+PRCHTOT I 'FLG S ^TMP($J,"FSC",PRCHFSC)=X Q
|
|---|
| 62 | I FLG S $P(X,U,3)=$P(X,U,3)+PRCHTOT S I=$S(PRCHEMG="Y":4,1:5),$P(X,U,I)=$P(X,U,I)+PRCHTOT S ^TMP($J,"FSC",PRCHFSC)=X
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | Q K %,%ZIS,IO("Q"),IOP,I,J,K,L,M,PRC,PRCF,PRCH0,PRCHCNT,PRCHD,PRCHD0,PRCHDESC,PRCHDET,PRCHDT,PRCHDY,PRCHEMG,PRCHFSC,PRCHFSCG,PRCHFT,PRCHGT,PRCHI
|
|---|
| 66 | K PRCHPAGE,PRCHPDAT,PRCHPO,PRCHQ,PRCHR,PRCHRDT,PRCHSITE,PRCHSRC,PRCHT,PRCHTOT,PRCHV,ZTRTN,^TMP($J),FLG,PRCHTOTD,PRCHI0,PRCHNIIN,PRCHNULL
|
|---|
| 67 | Q
|
|---|
