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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHRPT5 4059 printed Sep 23, 2025@19:46:36 Page 2
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
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
EN1 ; GENERATE LOG OF REQUESTS PRINTED IN A&MM (2237'S)
+1 KILL PRCHERR
+2 DO ST
if '$DATA(PRC("SITE"))
QUIT
SET M1="Requests (2237's)"
SET M2="A&MM"
SET M5="R1"
DO ENTDT
if '$DATA(PRCHBEG)
GOTO EXIT
+3 GOTO SDEV^PRCHRPT8
+4 ;
EN2 ; GENERATE LOG OF REQUESTS PRINTED IN FISCAL (1358'S)
+1 KILL PRCHERR
+2 DO ST
if '$DATA(PRC("SITE"))
QUIT
SET X=$PIECE($GET(^PRC(411,+PRC("SITE"),0)),U,4)
if X'="Y"
QUIT
SET M1="Requests (1358's)"
SET M2="Fiscal"
SET M5="R2"
DO ENTDT
if '$DATA(PRCHBEG)
GOTO EXIT
+3 GOTO SDEV^PRCHRPT8
+4 ;
EN3 ; GENERATE LOG OF PO'S PRINTED IN FISCAL
+1 KILL PRCHERR
+2 DO ST
if '$DATA(PRC("SITE"))
QUIT
SET X=$PIECE($GET(^PRC(411,+PRC("SITE"),0)),U,4)
if X'="Y"
QUIT
SET M1="Purchase Orders"
SET M2="Fiscal"
SET M5="P1"
DO ENTDT
if '$DATA(PRCHBEG)
GOTO EXIT
+3 GOTO SDEV^PRCHRPT8
+4 ;
EN4 ; GENERATE LOG OF PO'S PRINTED IN A&MM AFTER OBLIGATION
+1 KILL PRCHERR
+2 DO ST
if '$DATA(PRC("SITE"))
QUIT
SET M1="Purchase Orders"
SET M2="A&MM after Obligation"
SET M5="P2"
DO ENTDT
if '$DATA(PRCHBEG)
GOTO EXIT
+3 GOTO SDEV^PRCHRPT8
+4 ;
EN5 ; GENERATE LOG OF RECEIVING REPORTS PRINTED IN FISCAL
+1 KILL PRCHERR
+2 DO ST
if '$DATA(PRC("SITE"))
QUIT
SET X=$PIECE($GET(^PRC(411,+PRC("SITE"),0)),U,4)
if X'="Y"
QUIT
SET M1="Receiving Reports"
SET M2="Fiscal"
SET M5="P3"
DO ENTDT
if '$DATA(PRCHBEG)
GOTO EXIT
+3 GOTO SDEV^PRCHRPT8
+4 ; BUILD LIST PRINTED WITHIN SPECIFIED TIMES.
+5 ;
RD1 SET PRCHPGM="PRCHRPT5"
KILL PRCHREC,PRCHERR
FOR PRCHI=0:0
SET PRCHI=$ORDER(^PRCS(410,PRCHI))
if 'PRCHI
QUIT
SET PRCHX=$GET(^PRCS(410,PRCHI,0))
IF +PRCHX=PRC("SITE")
DO RD11
+1 GOTO PR1^PRCHRPT8
+2 ;
+3 ; SCREEN OUT PURCHASE CARD TRANSACTIONS
RD11 if '$DATA(^PRCS(410,PRCHI,7))
QUIT
SET PRCHDT=$PIECE(^(7),U,7)
if PRCHDT<PRCHBEG!(PRCHDT>PRCHEND)
QUIT
if $PIECE($GET(^PRCS(410,PRCHI,1)),"^",2)>0
QUIT
if M5="R1"&($PIECE(PRCHX,U,4)'>1)
QUIT
if M5="R2"&($PIECE(PRCHX,U,4)'=1)
QUIT
DO ADD
+1 QUIT
+2 ;
RD2 SET PRCHPGM="PRCHRPT5"
+1 FOR PRCHI=0:0
SET PRCHI=$ORDER(^PRC(442,PRCHI))
if 'PRCHI
QUIT
SET PRCHX=$GET(^(PRCHI,0))
IF +PRCHX=PRC("SITE")
IF $DATA(^(12))
SET X=^(12)
SET PRCHDT=""
if M5="P1"
SET PRCHDT=$PIECE(X,U,3)
if M5="P2"
SET PRCHDT=$PIECE(X,U,1)
IF PRCHDT'<PRCHBEG
IF PRCHDT'>PRCHEND
DO ADD
+2 GOTO PR1^PRCHRPT8
+3 ;
RD3 SET PRCHPGM="PRCHRPT5"
+1 FOR PRCHI=0:0
SET PRCHI=$ORDER(^PRC(442,PRCHI))
if 'PRCHI
QUIT
SET PRCHX=$GET(^(PRCHI,0))
IF $PIECE(PRCHX,"^",2)
IF +PRCHX=PRC("SITE")
IF $DATA(^(11,0))
IF $PIECE($GET(^PRCD(442.5,$PIECE(PRCHX,"^",2),0)),"^",3)-25
DO RD31
+2 GOTO PR1^PRCHRPT8
+3 ;
RD31 FOR PRCHJ=0:0
SET PRCHJ=$ORDER(^PRC(442,PRCHI,11,PRCHJ))
if 'PRCHJ
QUIT
IF $DATA(^(PRCHJ,0))
SET X=^(0)
SET PRCHDT=$PIECE(X,U,11)
IF PRCHDT'<PRCHBEG
IF PRCHDT'>PRCHEND
DO ADD
+1 QUIT
+2 ;
ADD ; ADD RECORD TO LOG FILE (443.5) AND SCREEN OUT PURCHASE CARD ORDERS.
+1 if $GET(PRCHERR)=1
QUIT
+2 ;DO NOT PRINT IMPREST FUNDS OR PURCHASE CARD ORDERS.
IF M5="P1"
SET X=+$PIECE($GET(^PRCD(442.5,+$PIECE(^PRC(442,PRCHI,0),U,2),0)),U,3)
if X=12!(X=25)
QUIT
+3 if '$DATA(PRCHREC)
DO ADD1
if '$DATA(PRCHREC)
QUIT
SET X=$PIECE(PRCHX,U,1)_$SELECT(M5="P3":"-"_PRCHJ,1:"")
if X=""
QUIT
+4 SET DIC="^PRC(443.5,"_PRCHREC_",1,"
SET DA(1)=PRCHREC
SET DIC(0)="L"
DO ^DIC
KILL DIC
SET $PIECE(^PRC(443.5,PRCHREC,1,+Y,0),U,2,3)=PRCHI_U_PRCHDT
+5 LOCK -^PRC(443.5,PRCHREC)
+6 QUIT
+7 ;
ADD1 if $GET(PRCHERR)=1
QUIT
LOCK +^PRC(443.5,0):5
IF '$TEST
WRITE !!,$CHAR(7),"Another user is editing this file, try later."
SET PRCHERR=1
QUIT
ADD2 SET X=$PIECE(^PRC(443.5,0),U,3)+1
SET DIC="^PRC(443.5,"
SET DIC(0)="L"
SET DLAYGO=443.5
DO ^DIC
KILL DIC,DLAYGO
if Y=-1
QUIT
if $PIECE(Y,U,3)=1
SET PRCHREC=+Y
IF $PIECE(Y,U,3)'=1
SET $PIECE(^(0),U,3)=$PIECE(^PRC(443.5,0),U,3)+1
GOTO ADD2
+1 LOCK +^PRC(443.5,PRCHREC):5
if '$TEST
GOTO ADD2
+2 SET $PIECE(^PRC(443.5,PRCHREC,0),U,2,4)=M5_"^"_PRCHBEG_"^"_PRCHEND
SET ^PRC(443.5,PRCHREC,1,0)="^443.51A^^"
+3 LOCK -^PRC(443.5,0)
+4 QUIT
+5 ;
ENTDT KILL PRCHBEG,PRCHEND
WRITE !!,"Generate listing of "_M1_" that was printed in "_M2_" between:"
+1 WRITE !
SET %DT="AET"
SET %DT("A")="Beginning Date/Time: "
DO ^%DT
if Y=-1
KILL %DT
if Y=-1
QUIT
SET PRCHBEG=Y
+2 WRITE !
SET %DT("A")="Ending Date/Time: "
DO ^%DT
if Y=-1
GOTO ENTDT
if Y<PRCHBEG
GOTO ENTDT
SET PRCHEND=Y
+3 KILL %DT
WRITE !
SET %A=" Is This OK "
SET %B=""
SET %=1
DO ^PRCFYN
if %=-1
KILL PRCHBEG,PRCHEND
if %=-1
QUIT
if %'=1
GOTO ENTDT
SET Y=PRCHBEG
DO DD^%DT
SET M3=Y
SET Y=PRCHEND
DO DD^%DT
SET M4=Y
+4 QUIT
+5 ;
EXIT KILL 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
+1 QUIT
+2 ;
ST SET PRCF("X")="SP"
DO ^PRCFSITE
+1 QUIT
