| 1 | PRCSP1B ;WISC/SAW-CONTROL POINT ACTIVITY ;10-11-91/10:24
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | PROJ ;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
|
|---|
| 9 | TEMPT ;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
|
|---|
| 14 | SUBCP ;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
|
|---|
| 17 | S1 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
|
|---|
| 24 | S2 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
|
|---|
| 30 | POS ;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
|
|---|
| 34 | POS1 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
|
|---|
| 35 | POS2 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
|
|---|
| 37 | S S L=0,DIC="^PRCS(410,"
|
|---|
| 38 | D EN1^DIP Q
|
|---|
| 39 | DEV K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS Q
|
|---|
| 40 | W1 W !!,"Enter information for another report or an uparrow to return to the menu.",! Q
|
|---|
| 41 | W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
|
|---|
| 42 | NONE W !!,"A status has not yet been reported for this purchase order." G EXIT
|
|---|
| 43 | W 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)
|
|---|
| 45 | EXIT 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
|
|---|
