| [613] | 1 | PRCSP1A2 ;WISC/KMB-PPM STATUS OF TRANSACTIONS ; 7/10/01 2:16pm
|
|---|
| 2 | ;;5.1;IFCAP;**31**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | START ;
|
|---|
| 5 | N ARRAY,ENTRY,ENTRY1,TEST,P,P1,PP,A,B,D0,I,PRCZ,Z1,%
|
|---|
| 6 | D EN1^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0 S PRCZ=Z
|
|---|
| 7 | S (A,Z1,P1)=1,(P,PP)=0 D NOW^%DTC S Y=% D DD^%DT S YY=Y
|
|---|
| 8 | S P1=PRCZ F S P1=$O(^PRCS(410,"B",P1)) Q:$P(P1,"-",1,4)'=PRCZ D
|
|---|
| 9 | .S PP=$O(^PRCS(410,"B",P1,0)) Q:PP="" I $P($G(^PRCS(410,PP,0)),"^",2)="O" S D0=PP D STATUS^PRCSES Q:X?.3N D
|
|---|
| 10 | ..I (X["PPM")!(X["Sig.")!(X["Prop.")!(X["Imprest") S ARRAY(A)=PP_"^"_X,A=A+1
|
|---|
| 11 | I $G(ARRAY(1))="" W !!,"No transactions found.",!! G START
|
|---|
| 12 | S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS Q:POP
|
|---|
| 13 | I $D(IO("Q")) S ZTRTN="PROCESS^PRCSP1A2",ZTDESC="PPM STATUS OF TRANSACTIONS",ZTSAVE("YY")="",ZTSAVE("P")="",ZTSAVE("PRC*")="",ZTSAVE("ARRAY*")="",ZTSAVE("A")="",ZTSAVE("Z1")="" D ^%ZTLOAD G START
|
|---|
| 14 | D PROCESS,END G START
|
|---|
| 15 | PROCESS ;
|
|---|
| 16 | U IO S B=A-1 D HDR F I=1:1:B D WRITE I IOSL-($Y#IOSL)<6 D HOLD Q:Z1[U
|
|---|
| 17 | D ^%ZISC Q
|
|---|
| 18 | WRITE S PP=$P(ARRAY(I),"^"),TEST=$P(ARRAY(I),"^",2) D
|
|---|
| 19 | .W !,$P($G(^PRCS(410,PP,0)),"^"),?20,$P($G(^(4)),"^",5),?30,"$",$P($G(^(4)),"^") I $P($G(^(4)),"^",3)'="" W ?42,"$",$P($G(^(4)),"^",3)
|
|---|
| 20 | .S Y=$P($G(^PRCS(410,PP,1)),"^",4) X:Y ^DD("DD") W ?56,Y
|
|---|
| 21 | .S Y=$P($G(^PRCS(410,PP,4)),"^",4) X:Y ^DD("DD") W ?68,Y
|
|---|
| 22 | .S ENTRY=$P($G(^PRCS(410,PP,7)),"^"),ENTRY1=$P($G(^PRCS(410,PP,11)),"^",2)
|
|---|
| 23 | .W:ENTRY'="" !,$P($G(^VA(200,ENTRY,0)),"^")
|
|---|
| 24 | .W:ENTRY1'="" ?40,$P($G(^VA(200,ENTRY1,0)),"^")
|
|---|
| 25 | .W !,?30,$P(ARRAY(I),"^",2),!
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | END U IO(0) W !!,"END OF REPORT",!!
|
|---|
| 29 | K ARRAY
|
|---|
| 30 | Q
|
|---|
| 31 | HOLD G HDR:IOSL'=24 W !,"Press return to continue, '^' to exit: " R Z1:10 S:'$T Z1=U D:Z1'=U HDR Q
|
|---|
| 32 | HDR S P=P+1 W @IOF,"PPM TRANSACTION STATUS REPORT - CP ",$P(PRC("CP")," "),?50,YY,?73," PAGE ",P,!
|
|---|
| 33 | W !,?20,"PO/OBL#",?30,"COMM.",?42,"OBLIG.",!,"2237#",?30,"(EST) COST",?42,"(ACT) COST",?56,"DATE REQ.",?68,"DATE OBL."
|
|---|
| 34 | W !,"REQUESTOR",?40,"ORIGINATOR OF REQUEST"
|
|---|
| 35 | W !,?30,"STATUS" S L="",$P(L,"-",IOM-1)="-" W !,L S L=" " Q
|
|---|
| 36 | W2 ;
|
|---|
| 37 | W !,"You are not an authorized control point user.",!,"Contact your control point official." R XXZ:5 G EXIT
|
|---|
| 38 | EXIT K %ZIS,L,POP,ZTDESC,ZTRTN,ZTSAVE,YY,Y,X,Z,XXZ,PRC Q
|
|---|
