75 lines
3.9 KiB
Mathematica
75 lines
3.9 KiB
Mathematica
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
|