source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHRPT5.m@ 1394

PRCHRPT5 ;BOISE/TKW-GENERATE LOG OF REQUESTS AND P.O.'S PRINTED. ;10-13-89/4:01 PM
V ;;5.1;IFCAP;**25**;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
EN1 ; GENERATE LOG OF REQUESTS PRINTED IN A&MM (2237'S)
 K PRCHERR
 D ST Q:'$D(PRC("SITE"))  S M1="Requests (2237's)",M2="A&MM",M5="R1" D ENTDT G:'$D(PRCHBEG) EXIT
 G SDEV^PRCHRPT8
 ;
EN2 ; GENERATE LOG OF REQUESTS PRINTED IN FISCAL (1358'S)
 K PRCHERR
 D ST Q:'$D(PRC("SITE"))  S X=$P($G(^PRC(411,+PRC("SITE"),0)),U,4) Q:X'="Y"  S M1="Requests (1358's)",M2="Fiscal",M5="R2" D ENTDT G:'$D(PRCHBEG) EXIT
 G SDEV^PRCHRPT8
 ;
EN3 ; GENERATE LOG OF PO'S PRINTED IN FISCAL
 K PRCHERR
 D ST Q:'$D(PRC("SITE"))  S X=$P($G(^PRC(411,+PRC("SITE"),0)),U,4) Q:X'="Y"  S M1="Purchase Orders",M2="Fiscal",M5="P1" D ENTDT G:'$D(PRCHBEG) EXIT
 G SDEV^PRCHRPT8
 ;
EN4 ; GENERATE LOG OF PO'S PRINTED IN A&MM AFTER OBLIGATION
 K PRCHERR
 D ST Q:'$D(PRC("SITE"))  S M1="Purchase Orders",M2="A&MM after Obligation",M5="P2" D ENTDT G:'$D(PRCHBEG) EXIT
 G SDEV^PRCHRPT8
 ;
EN5 ; GENERATE LOG OF RECEIVING REPORTS PRINTED IN FISCAL
 K PRCHERR
 D ST Q:'$D(PRC("SITE"))  S X=$P($G(^PRC(411,+PRC("SITE"),0)),U,4) Q:X'="Y"  S M1="Receiving Reports",M2="Fiscal",M5="P3" D ENTDT G:'$D(PRCHBEG) EXIT
 G SDEV^PRCHRPT8
 ; BUILD LIST PRINTED WITHIN SPECIFIED TIMES.
 ;
RD1 S PRCHPGM="PRCHRPT5" K PRCHREC,PRCHERR F PRCHI=0:0 S PRCHI=$O(^PRCS(410,PRCHI)) Q:'PRCHI  S PRCHX=$G(^PRCS(410,PRCHI,0)) I +PRCHX=PRC("SITE") D RD11
 G PR1^PRCHRPT8
 ;
 ; SCREEN OUT PURCHASE CARD TRANSACTIONS
RD11 Q:'$D(^PRCS(410,PRCHI,7))  S PRCHDT=$P(^(7),U,7) Q:PRCHDT<PRCHBEG!(PRCHDT>PRCHEND)  Q:$P($G(^PRCS(410,PRCHI,1)),"^",2)>0  Q:M5="R1"&($P(PRCHX,U,4)'>1)  Q:M5="R2"&($P(PRCHX,U,4)'=1)  D ADD
 Q
 ;
RD2 S PRCHPGM="PRCHRPT5"
 F PRCHI=0:0 S PRCHI=$O(^PRC(442,PRCHI)) Q:'PRCHI  S PRCHX=$G(^(PRCHI,0)) I +PRCHX=PRC("SITE"),$D(^(12)) S X=^(12),PRCHDT="" S:M5="P1" PRCHDT=$P(X,U,3) S:M5="P2" PRCHDT=$P(X,U,1) I PRCHDT'<PRCHBEG,PRCHDT'>PRCHEND D ADD
 G PR1^PRCHRPT8
 ;
RD3 S PRCHPGM="PRCHRPT5"
 F PRCHI=0:0 S PRCHI=$O(^PRC(442,PRCHI)) Q:'PRCHI  S PRCHX=$G(^(PRCHI,0)) I $P(PRCHX,"^",2),+PRCHX=PRC("SITE"),$D(^(11,0)),$P($G(^PRCD(442.5,$P(PRCHX,"^",2),0)),"^",3)-25  D RD31
 G PR1^PRCHRPT8
 ;
RD31 F PRCHJ=0:0 S PRCHJ=$O(^PRC(442,PRCHI,11,PRCHJ)) Q:'PRCHJ  I $D(^(PRCHJ,0)) S X=^(0),PRCHDT=$P(X,U,11) I PRCHDT'<PRCHBEG,PRCHDT'>PRCHEND D ADD
 Q
 ;
ADD ; ADD RECORD TO LOG FILE (443.5) AND SCREEN OUT PURCHASE CARD ORDERS.
 Q:$G(PRCHERR)=1
 I M5="P1" S X=+$P($G(^PRCD(442.5,+$P(^PRC(442,PRCHI,0),U,2),0)),U,3) Q:X=12!(X=25)  ;DO NOT PRINT IMPREST FUNDS OR PURCHASE CARD ORDERS.
 D:'$D(PRCHREC) ADD1 Q:'$D(PRCHREC)  S X=$P(PRCHX,U,1)_$S(M5="P3":"-"_PRCHJ,1:"") Q:X=""
 S DIC="^PRC(443.5,"_PRCHREC_",1,",DA(1)=PRCHREC,DIC(0)="L" D ^DIC K DIC S $P(^PRC(443.5,PRCHREC,1,+Y,0),U,2,3)=PRCHI_U_PRCHDT
 L -^PRC(443.5,PRCHREC)
 Q
 ;
ADD1 Q:$G(PRCHERR)=1  L +^PRC(443.5,0):5 E  W !!,$C(7),"Another user is editing this file, try later." S PRCHERR=1 Q
ADD2 S X=$P(^PRC(443.5,0),U,3)+1,DIC="^PRC(443.5,",DIC(0)="L",DLAYGO=443.5 D ^DIC K DIC,DLAYGO Q:Y=-1  S:$P(Y,U,3)=1 PRCHREC=+Y I $P(Y,U,3)'=1 S $P(^(0),U,3)=$P(^PRC(443.5,0),U,3)+1 G ADD2
 L +^PRC(443.5,PRCHREC):5 G:'$T ADD2
 S $P(^PRC(443.5,PRCHREC,0),U,2,4)=M5_"^"_PRCHBEG_"^"_PRCHEND,^PRC(443.5,PRCHREC,1,0)="^443.51A^^"
 L -^PRC(443.5,0)
 Q
 ;
ENTDT K PRCHBEG,PRCHEND W !!,"Generate listing of "_M1_" that was printed in "_M2_" between:"
 W ! S %DT="AET",%DT("A")="Beginning Date/Time: " D ^%DT K:Y=-1 %DT Q:Y=-1  S PRCHBEG=Y
 W ! S %DT("A")="Ending Date/Time:    " D ^%DT G:Y=-1 ENTDT G:Y<PRCHBEG ENTDT S PRCHEND=Y
 K %DT W ! S %A=" Is This OK ",%B="",%=1 D ^PRCFYN K:%=-1 PRCHBEG,PRCHEND Q:%=-1  G:%'=1 ENTDT S Y=PRCHBEG D DD^%DT S M3=Y,Y=PRCHEND D DD^%DT S M4=Y
 Q
 ;
EXIT K M,M1,M2,M3,M4,M5,PRCHBEG,PRCHEND,PRCHERR,PRCHPR,PRCHREC,PRCHREPR,PRCHSTAT,PRCHTX,PRCHTRX,PRCHTYP,PRCHI,PRCHI5,PRCHPDAT,PRCHDT,PRCHX,PRCHALL,PRCHQ,PRCHX5,PRCHEX,PRCHPGM,PRCHNRQ,I,X,Y,D0,DA,ZTRTN
 Q
 ;
ST S PRCF("X")="SP" D ^PRCFSITE
 Q