source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHRPT6.m@ 1078

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1PRCHRPT6 ;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
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN1 ; REPRINT REQUESTS PRINTED IN A&MM (2237'S)
6 D ST Q:'$D(PRC("SITE")) S M1="Requests",M2="A&MM (2237's)",M5="R1"
7 G SELLST
8 ;
9EN2 ; REPRINT REQUESTS PRINTED IN FISCAL (1358'S)
10 D ST Q:'$D(PRC("SITE")) S M1="Requests",M2="Fiscal (1358's)",M5="R2"
11 G SELLST
12 ;
13EN3 ; REPRINT PURCHASE ORDERS PRINTED IN FISCAL
14 D ST Q:'$D(PRC("SITE")) S M1="Purchase Orders",M2="Fiscal",M5="P1"
15 G SELLST
16 ;
17EN4 ; REPRINT PURCHASE ORDERS PRINTED IN A&MM AFTER OBLIGATION
18 D ST Q:'$D(PRC("SITE")) S M1="Purchase Orders",M2="A&MM after Obligation",M5="P2"
19 G SELLST
20 ;
21EN5 ; REPRINT RECEIVING REPORTS PRINTED IN FISCAL
22 D ST Q:'$D(PRC("SITE")) S M1="Receiving Reports",M2="Fiscal",M5="P3"
23 G SELLST
24 ;
25SELLST ; SELECT LIST TO BE REPRINTED
26 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
27 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
28 W ! S %A="Display list ",%B="",%=2 D ^PRCFYN G:%=-1 EXIT^PRCHRPT5 G:%=0 SELLST I %=1 D HOME^%ZIS D PR1^PRCHRPT8
29 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"
30 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 !!
31 W:M5="P3" "P.O.# - Partial #",!
32 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="^"
33 G:PRCHEX="^" EXIT^PRCHRPT5
34 G DELLST
35 ;
36PRT S PRCHEX="" I PRCHALL'="Y" W ?45,"Reprint " S %B="",%=2 D ^PRCFYN S:%=-1 PRCHEX="^" Q:%'=1
37 S PRCHREPR=1
38 D:M1="Requests" P11 D:M5="P3" P14 I M1="Purchase Orders" D:M5="P1" P12 D:M5="P2" P13
39 Q
40 ;
41DELLST 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
42 S DIK="^PRC(443.5,",DA=PRCHREC D ^DIK K DIK W !!!,$C(7)," *** LIST DELETED ***"
43 G EXIT^PRCHRPT5
44 ;
45P11 ; REPRINT REQUESTS (2237'S OR 1138'S) IN FISCAL OR A&MM
46 N PPMFLG S PPMFLG=1
47 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
48 Q
49 ;
50P12 ; REPRINT P.O.'S IN FISCAL
51 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
52 Q
53 ;
54P13 ; REPRINT P.O.'S FROM FISCAL TO A&MM AFTER OBLIGATION
55 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
56 Q
57 ;
58P14 ; REPRINT RECEIVING REPORTS IN FISCAL
59 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
60 Q
61 ;
62W 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_"."
63 G DELLST
64 ;
65ST S PRCF("X")="SP" D ^PRCFSITE
66 Q
Note: See TracBrowser for help on using the repository browser.