PRCHRPT6 ;BOISE/TKW-SUPPLEMENT TO PRCHRPT5--BUILD PRINT LOG OF REQUESTS/P.O.'S AND REPRINT ;4/27/89 9:59 AM ;2/19/92 3:50 PM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN1 ; REPRINT REQUESTS PRINTED IN A&MM (2237'S)
D ST Q:'$D(PRC("SITE")) S M1="Requests",M2="A&MM (2237's)",M5="R1"
G SELLST
;
EN2 ; REPRINT REQUESTS PRINTED IN FISCAL (1358'S)
D ST Q:'$D(PRC("SITE")) S M1="Requests",M2="Fiscal (1358's)",M5="R2"
G SELLST
;
EN3 ; REPRINT PURCHASE ORDERS PRINTED IN FISCAL
D ST Q:'$D(PRC("SITE")) S M1="Purchase Orders",M2="Fiscal",M5="P1"
G SELLST
;
EN4 ; REPRINT PURCHASE ORDERS PRINTED IN A&MM AFTER OBLIGATION
D ST Q:'$D(PRC("SITE")) S M1="Purchase Orders",M2="A&MM after Obligation",M5="P2"
G SELLST
;
EN5 ; REPRINT RECEIVING REPORTS PRINTED IN FISCAL
D ST Q:'$D(PRC("SITE")) S M1="Receiving Reports",M2="Fiscal",M5="P3"
G SELLST
;
SELLST ; SELECT LIST TO BE REPRINTED
S PRCHPGM="PRCHRPT6" W !! S DIC="^PRC(443.5,",DIC(0)="AEQMOZ",DIC("S")="I $P(^(0),U,2)=M5",DIC("A")="Select "_M1_" Print List Number: " D ^DIC K DIC G:Y=-1 EXIT^PRCHRPT5
S PRCHREC=+Y,Y=+$P(Y(0),U,3) D DD^%DT S M3=Y,Y=+$P(Y(0),U,4) D DD^%DT S M4=Y
W ! S %A="Display list ",%B="",%=2 D ^PRCFYN G:%=-1 EXIT^PRCHRPT5 G:%=0 SELLST I %=1 D HOME^%ZIS D PR1^PRCHRPT8
S PRCHALL="N" W !!,"Do you want to * REPRINT ALL * "_M1_" previously printed in "_M2,!," between "_M3_" and "_M4 S %B="",%=2 D ^PRCFYN G:%=-1 EXIT^PRCHRPT5 G:%=0 SELLST S:%=1 PRCHALL="Y"
I PRCHALL="N" W !!,"Do you want to * REPRINT ANY * "_M1_" previously printed in "_M2,!," between "_M3_" and "_M4 S %B="",%=2 D ^PRCFYN G:%=-1 EXIT^PRCHRPT5 G:%'=1 DELLST W !!
W:M5="P3" "P.O.# - Partial #",!
S PRCHTRX="" F PRCHI5=0:0 S PRCHTRX=$O(^PRC(443.5,PRCHREC,1,"B",PRCHTRX)) Q:PRCHTRX="" S I=$O(^(PRCHTRX,0)) I I,$D(^PRC(443.5,PRCHREC,1,I,0)) S Y=$P(^(0),U,3),DA=+$P(^(0),U,2) D DD^%DT W !,PRCHTRX,?23,Y D PRT Q:PRCHEX="^"
G:PRCHEX="^" EXIT^PRCHRPT5
G DELLST
;
PRT S PRCHEX="" I PRCHALL'="Y" W ?45,"Reprint " S %B="",%=2 D ^PRCFYN S:%=-1 PRCHEX="^" Q:%'=1
S PRCHREPR=1
D:M1="Requests" P11 D:M5="P3" P14 I M1="Purchase Orders" D:M5="P1" P12 D:M5="P2" P13
Q
;
DELLST W !!,"Do you want to * DELETE THE LIST * of "_M1_" previously printed",!,"in "_M2,!," between "_M3_" and "_M4 S %B="",%=2 D ^PRCFYN G:%=0 W G:%'=1 EXIT^PRCHRPT5
S DIK="^PRC(443.5,",DA=PRCHREC D ^DIK K DIK W !!!,$C(7)," *** LIST DELETED ***"
G EXIT^PRCHRPT5
;
P11 ; REPRINT REQUESTS (2237'S OR 1138'S) IN FISCAL OR A&MM
N PPMFLG S PPMFLG=1
Q:'$D(^PRCS(410,DA,0)) S D0=DA,PRCHQ=$P(^(0),U,4),PRCHQ=$S(PRCHQ=1:"QUE^PRCSP11",1:"QUE^PRCSP12"),PRCHQ("DEST")=$S(PRCHQ="QUE^PRCSP11":"F",1:"S") D ^PRCHQUE
Q
;
P12 ; REPRINT P.O.'S IN FISCAL
Q:'$D(^PRC(442,DA,0)) S D0=DA,PRCHQ="^PRCHFPNT" S:$D(^PRC(411,PRC("SITE"),2,"AC","F")) PRCHQ("DEST")="F" D ^PRCHQUE K ZTSK
Q
;
P13 ; REPRINT P.O.'S FROM FISCAL TO A&MM AFTER OBLIGATION
Q:'$D(^PRC(442,DA,0)) S D0=DA,X=$P(^PRC(411,PRC("SITE"),0),U,11),PRCHQ=$S(X=1:"^PRCHPNT",1:"^PRCHFPNT"),PRCHQ("DEST")="S8" D ^PRCHQUE
Q
;
P14 ; REPRINT RECEIVING REPORTS IN FISCAL
Q:'$D(^PRC(442,DA,0)) S D0=DA,PRCHFPT=$P(PRCHTRX,"-",3),PRCHQ="^PRCHFPNT",PRCHQ("DEST")="R",PRCHQ("DEST2")="FR" D ^PRCHQUE K ZTSK
Q
;
W W !!,"This will not delete any of the "_M1_", it will only delete the",!,"list of those "_M1_" that were previously printed in "_M2_",",!,"between "_M3_" and "_M4_"."
G DELLST
;
ST S PRCF("X")="SP" D ^PRCFSITE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHRPT6 3520 printed Sep 23, 2025@19:46:37 Page 2
PRCHRPT6 ;BOISE/TKW-SUPPLEMENT TO PRCHRPT5--BUILD PRINT LOG OF REQUESTS/P.O.'S AND REPRINT ;4/27/89 9:59 AM ;2/19/92 3:50 PM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
EN1 ; REPRINT REQUESTS PRINTED IN A&MM (2237'S)
+1 DO ST
if '$DATA(PRC("SITE"))
QUIT
SET M1="Requests"
SET M2="A&MM (2237's)"
SET M5="R1"
+2 GOTO SELLST
+3 ;
EN2 ; REPRINT REQUESTS PRINTED IN FISCAL (1358'S)
+1 DO ST
if '$DATA(PRC("SITE"))
QUIT
SET M1="Requests"
SET M2="Fiscal (1358's)"
SET M5="R2"
+2 GOTO SELLST
+3 ;
EN3 ; REPRINT PURCHASE ORDERS PRINTED IN FISCAL
+1 DO ST
if '$DATA(PRC("SITE"))
QUIT
SET M1="Purchase Orders"
SET M2="Fiscal"
SET M5="P1"
+2 GOTO SELLST
+3 ;
EN4 ; REPRINT PURCHASE ORDERS PRINTED IN A&MM AFTER OBLIGATION
+1 DO ST
if '$DATA(PRC("SITE"))
QUIT
SET M1="Purchase Orders"
SET M2="A&MM after Obligation"
SET M5="P2"
+2 GOTO SELLST
+3 ;
EN5 ; REPRINT RECEIVING REPORTS PRINTED IN FISCAL
+1 DO ST
if '$DATA(PRC("SITE"))
QUIT
SET M1="Receiving Reports"
SET M2="Fiscal"
SET M5="P3"
+2 GOTO SELLST
+3 ;
SELLST ; SELECT LIST TO BE REPRINTED
+1 SET PRCHPGM="PRCHRPT6"
WRITE !!
SET DIC="^PRC(443.5,"
SET DIC(0)="AEQMOZ"
SET DIC("S")="I $P(^(0),U,2)=M5"
SET DIC("A")="Select "_M1_" Print List Number: "
DO ^DIC
KILL DIC
if Y=-1
GOTO EXIT^PRCHRPT5
+2 SET PRCHREC=+Y
SET Y=+$PIECE(Y(0),U,3)
DO DD^%DT
SET M3=Y
SET Y=+$PIECE(Y(0),U,4)
DO DD^%DT
SET M4=Y
+3 WRITE !
SET %A="Display list "
SET %B=""
SET %=2
DO ^PRCFYN
if %=-1
GOTO EXIT^PRCHRPT5
if %=0
GOTO SELLST
IF %=1
DO HOME^%ZIS
DO PR1^PRCHRPT8
+4 SET PRCHALL="N"
WRITE !!,"Do you want to * REPRINT ALL * "_M1_" previously printed in "_M2,!," between "_M3_" and "_M4
SET %B=""
SET %=2
DO ^PRCFYN
if %=-1
GOTO EXIT^PRCHRPT5
if %=0
GOTO SELLST
if %=1
SET PRCHALL="Y"
+5 IF PRCHALL="N"
WRITE !!,"Do you want to * REPRINT ANY * "_M1_" previously printed in "_M2,!," between "_M3_" and "_M4
SET %B=""
SET %=2
DO ^PRCFYN
if %=-1
GOTO EXIT^PRCHRPT5
if %'=1
GOTO DELLST
WRITE !!
+6 if M5="P3"
WRITE "P.O.# - Partial #",!
+7 SET PRCHTRX=""
FOR PRCHI5=0:0
SET PRCHTRX=$ORDER(^PRC(443.5,PRCHREC,1,"B",PRCHTRX))
if PRCHTRX=""
QUIT
SET I=$ORDER(^(PRCHTRX,0))
IF I
IF $DATA(^PRC(443.5,PRCHREC,1,I,0))
SET Y=$PIECE(^(0),U,3)
SET DA=+$PIECE(^(0),U,2)
DO DD^%DT
WRITE !,PRCHTRX,?23,Y
DO PRT
if PRCHEX="^"
QUIT
+8 if PRCHEX="^"
GOTO EXIT^PRCHRPT5
+9 GOTO DELLST
+10 ;
PRT SET PRCHEX=""
IF PRCHALL'="Y"
WRITE ?45,"Reprint "
SET %B=""
SET %=2
DO ^PRCFYN
if %=-1
SET PRCHEX="^"
if %'=1
QUIT
+1 SET PRCHREPR=1
+2 if M1="Requests"
DO P11
if M5="P3"
DO P14
IF M1="Purchase Orders"
if M5="P1"
DO P12
if M5="P2"
DO P13
+3 QUIT
+4 ;
DELLST WRITE !!,"Do you want to * DELETE THE LIST * of "_M1_" previously printed",!,"in "_M2,!," between "_M3_" and "_M4
SET %B=""
SET %=2
DO ^PRCFYN
if %=0
GOTO W
if %'=1
GOTO EXIT^PRCHRPT5
+1 SET DIK="^PRC(443.5,"
SET DA=PRCHREC
DO ^DIK
KILL DIK
WRITE !!!,$CHAR(7)," *** LIST DELETED ***"
+2 GOTO EXIT^PRCHRPT5
+3 ;
P11 ; REPRINT REQUESTS (2237'S OR 1138'S) IN FISCAL OR A&MM
+1 NEW PPMFLG
SET PPMFLG=1
+2 if '$DATA(^PRCS(410,DA,0))
QUIT
SET D0=DA
SET PRCHQ=$PIECE(^(0),U,4)
SET PRCHQ=$SELECT(PRCHQ=1:"QUE^PRCSP11",1:"QUE^PRCSP12")
SET PRCHQ("DEST")=$SELECT(PRCHQ="QUE^PRCSP11":"F",1:"S")
DO ^PRCHQUE
+3 QUIT
+4 ;
P12 ; REPRINT P.O.'S IN FISCAL
+1 if '$DATA(^PRC(442,DA,0))
QUIT
SET D0=DA
SET PRCHQ="^PRCHFPNT"
if $DATA(^PRC(411,PRC("SITE"),2,"AC","F"))
SET PRCHQ("DEST")="F"
DO ^PRCHQUE
KILL ZTSK
+2 QUIT
+3 ;
P13 ; REPRINT P.O.'S FROM FISCAL TO A&MM AFTER OBLIGATION
+1 if '$DATA(^PRC(442,DA,0))
QUIT
SET D0=DA
SET X=$PIECE(^PRC(411,PRC("SITE"),0),U,11)
SET PRCHQ=$SELECT(X=1:"^PRCHPNT",1:"^PRCHFPNT")
SET PRCHQ("DEST")="S8"
DO ^PRCHQUE
+2 QUIT
+3 ;
P14 ; REPRINT RECEIVING REPORTS IN FISCAL
+1 if '$DATA(^PRC(442,DA,0))
QUIT
SET D0=DA
SET PRCHFPT=$PIECE(PRCHTRX,"-",3)
SET PRCHQ="^PRCHFPNT"
SET PRCHQ("DEST")="R"
SET PRCHQ("DEST2")="FR"
DO ^PRCHQUE
KILL ZTSK
+2 QUIT
+3 ;
W WRITE !!,"This will not delete any of the "_M1_", it will only delete the",!,"list of those "_M1_" that were previously printed in "_M2_",",!,"between "_M3_" and "_M4_"."
+1 GOTO DELLST
+2 ;
ST SET PRCF("X")="SP"
DO ^PRCFSITE
+1 QUIT
