source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHRPT5.m@ 619

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1PRCHRPT5 ;BOISE/TKW-GENERATE LOG OF REQUESTS AND P.O.'S PRINTED. ;10-13-89/4:01 PM
2V ;;5.1;IFCAP;**25**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN1 ; GENERATE LOG OF REQUESTS PRINTED IN A&MM (2237'S)
6 K PRCHERR
7 D ST Q:'$D(PRC("SITE")) S M1="Requests (2237's)",M2="A&MM",M5="R1" D ENTDT G:'$D(PRCHBEG) EXIT
8 G SDEV^PRCHRPT8
9 ;
10EN2 ; GENERATE LOG OF REQUESTS PRINTED IN FISCAL (1358'S)
11 K PRCHERR
12 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
13 G SDEV^PRCHRPT8
14 ;
15EN3 ; GENERATE LOG OF PO'S PRINTED IN FISCAL
16 K PRCHERR
17 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
18 G SDEV^PRCHRPT8
19 ;
20EN4 ; GENERATE LOG OF PO'S PRINTED IN A&MM AFTER OBLIGATION
21 K PRCHERR
22 D ST Q:'$D(PRC("SITE")) S M1="Purchase Orders",M2="A&MM after Obligation",M5="P2" D ENTDT G:'$D(PRCHBEG) EXIT
23 G SDEV^PRCHRPT8
24 ;
25EN5 ; GENERATE LOG OF RECEIVING REPORTS PRINTED IN FISCAL
26 K PRCHERR
27 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
28 G SDEV^PRCHRPT8
29 ; BUILD LIST PRINTED WITHIN SPECIFIED TIMES.
30 ;
31RD1 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
32 G PR1^PRCHRPT8
33 ;
34 ; SCREEN OUT PURCHASE CARD TRANSACTIONS
35RD11 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
36 Q
37 ;
38RD2 S PRCHPGM="PRCHRPT5"
39 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
40 G PR1^PRCHRPT8
41 ;
42RD3 S PRCHPGM="PRCHRPT5"
43 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
44 G PR1^PRCHRPT8
45 ;
46RD31 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
47 Q
48 ;
49ADD ; ADD RECORD TO LOG FILE (443.5) AND SCREEN OUT PURCHASE CARD ORDERS.
50 Q:$G(PRCHERR)=1
51 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.
52 D:'$D(PRCHREC) ADD1 Q:'$D(PRCHREC) S X=$P(PRCHX,U,1)_$S(M5="P3":"-"_PRCHJ,1:"") Q:X=""
53 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
54 L -^PRC(443.5,PRCHREC)
55 Q
56 ;
57ADD1 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
58ADD2 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
59 L +^PRC(443.5,PRCHREC):5 G:'$T ADD2
60 S $P(^PRC(443.5,PRCHREC,0),U,2,4)=M5_"^"_PRCHBEG_"^"_PRCHEND,^PRC(443.5,PRCHREC,1,0)="^443.51A^^"
61 L -^PRC(443.5,0)
62 Q
63 ;
64ENTDT K PRCHBEG,PRCHEND W !!,"Generate listing of "_M1_" that was printed in "_M2_" between:"
65 W ! S %DT="AET",%DT("A")="Beginning Date/Time: " D ^%DT K:Y=-1 %DT Q:Y=-1 S PRCHBEG=Y
66 W ! S %DT("A")="Ending Date/Time: " D ^%DT G:Y=-1 ENTDT G:Y<PRCHBEG ENTDT S PRCHEND=Y
67 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
68 Q
69 ;
70EXIT 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
71 Q
72 ;
73ST S PRCF("X")="SP" D ^PRCFSITE
74 Q
Note: See TracBrowser for help on using the repository browser.