source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSP1B.m@ 1710

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1PRCSP1B ;WISC/SAW-CONTROL POINT ACTIVITY ;10-11-91/10:24
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4PROJ ;PROJECT NUMBER REPORT
5 D EN1^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0
6 S PRCSAZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")
7 S L=0,DIC="^PRCS(410,",FLDS="[PRCSPROJ]",DHD="SORT GROUP REPORT - CP: "_PRC("CP"),BY="+49;S1,.01",FR="?,"_PRCSAZ_"-0001",TO="?,"_PRCSAZ_"-9999"
8 D EN1^DIP K L,DIC,FLDS,DHD,BY,FR,TO,PRC("CP"),PRCSAZ Q
9TEMPT ;LIST OF TEMPORARY TRANSACTIONS
10 D EN3^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0
11 S L=0,DIC="^PRCS(410,",FLDS="[PRCSTEMPT]",DHD="TEMPORARY TRANSACTION LISTING - CONTROL POINT "_PRC("CP"),BY="15,5",(FR,TO)=PRC("CP")_",?"
12 S DIS(0)="I $D(^PRCS(410,D0,0)),$P(^(0),U,1)=$P(^(0),U,3),$P(^(0),U,5)=PRC(""SITE"")"
13 D EN1^DIP K BY,DIC,DIS,FLDS,FR,L,TO Q
14SUBCP ;SUB-CONTROL POINT REPORT
15 W !,"Would you like the report printed for a full Fiscal Year"
16 S %=1 D ^PRCFYN G EXIT:%<0 G S2:%=1
17S1 D EN1^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0
18 G:'$D(PRC("CP")) EXIT
19 S PRCSAZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")
20 S DIC="^PRCS(410,",DHD="SUB-CONTROL POINT EXPENDITURES - "_PRC("CP")_" for FY-Q: "_PRC("FY")_"-"_PRC("QTR")
21 S FLDS="[PRCSSBCPT]",BY="16,+.01;S1,@.01",FR="?,"_PRCSAZ_"-0001"
22 S TO="?,"_PRCSAZ_"-9999",L=0 D EN1^DIP
23 K DIS(0),PRC("SCP"),PRC("CP"),PRC("QTR"),PRC("FY"),PRCS(1) G SUBCP
24S2 D STA^PRCSUT G W2:'$D(PRC("SITE")) D FY^PRCSUT Q:'$D(PRC("FY")) Q:PRC("FY")="^" G EXIT:Y<0 D CP^PRCSUT
25 G EXIT:Y<0 ;S DIC="^PRCS(410.4,",DIC(0)="AEMQ" D ^DIC G S2:Y<0
26 S DIC="^PRCS(410," S DHD="SUB-CONTROL POINT EXPENDITURES - "_PRC("CP"),FLDS="[PRCSSBCPT1]"
27 S BY="16,+.01;S1,@.01",FR="?,"_PRC("SITE")_"-"_PRC("FY")_"-1-"_$P(PRC("CP")," ")_"-0001",TO="?,"_PRC("SITE")_"-"_PRC("FY")_"-4-"_$P(PRC("CP")," ")_"-9999",L=0
28 S DIS(0)="I $D(^PRCS(410,D0,0)),$P(^(0),""-"",4)=$P(PRC(""CP""),"" "")"
29 D EN1^DIP K DIS(0),PRC("CP"),PRC("FY"),PRCS(1) G EXIT
30POS ;PURCHASE ORDER STATUS
31 D EN3^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0
32 S DIC="^PRC(442,",DIC(0)="AEQM",DIC("A")="Select PURCHASE ORDER NUMBER: ",DIC("S")="I +^(0)=PRC(""SITE""),+$P(^(0),""^"",3)=+PRC(""CP"")" D ^DIC G EXIT:Y<0 K DIC S D0=+Y,X=$S($D(^PRC(442,+Y,7)):+^(7),1:0)
33 S X=$S($D(^PRCD(442.3,X,0)):^(0),1:"UNKNOWN") W !!,"Purchase Order Status: ",$P(X,"^") I $P(X,"^",2)<10 D EXIT G POS
34POS1 W !!,"Would you like the purchase order display" S %=2 D YN^DICN G POS1:%=0 G:%=2 POS2 D:%=1 ^PRCHDP1 I %=-1 D EXIT,W1 Q:$D(PRCSX) G POS
35POS2 W !!,"Would you like to review the entire purchase order" S %=2 D YN^DICN G POS2:%=0 I %'=1 D EXIT,W1 Q:$D(PRCSX) G POS
36 S PRCHQ="^PRCHFPNT",PRCHQ("DEST")="US" D ^PRCHQUE K IOP D EXIT,W1 K ZTSK Q:$D(PRCSX) G POS
37S S L=0,DIC="^PRCS(410,"
38 D EN1^DIP Q
39DEV K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS Q
40W1 W !!,"Enter information for another report or an uparrow to return to the menu.",! Q
41W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
42NONE W !!,"A status has not yet been reported for this purchase order." G EXIT
43W I (IO=IO(0))&('$D(ZTQUEUED)) W !!,"Press return to continue: " R X:DTIME
44 I (IO'=IO(0))!($D(ZTQUEUED)) D ^%ZISC U IO(0)
45EXIT K %,%DT,BY,C,C0,C2,C3,D,DA,DHD,DIC,DIE,PRCS,FLDS,FR,I,L,N,TO,X,Y,Z,Z1,ZTRTN,ZTSAVE Q
Note: See TracBrowser for help on using the repository browser.