PRCSAPP ;WISC/KMB-NEW 2237 APPROVAL ; 10-27-93 12:00 V ;;5.1;IFCAP;;Oct 20, 2000 ;Per VHA Directive 10-93-142, this routine should not be modified. START ; N APPREQ,MESSAGE,YY,XY,SPENDCP,ALL,LOOP,FOUND,PRCS1,%,AA,TEST,II,CPARRAY N FND,CPVAR,STOP1,SLP,PRCSDA,PRCSI,CONT,LINE S (FND,STOP1,TEST,FOUND,ALL,PRC("CP"))=0,XY="",AA=0,SPENDCP=0 K CPCK S APPREQ=1 W !!,"Please wait while I check your control points..." D ^PRCSUT1 I '$D(CPCK) W !,"You have no transactions ready for approval." Q SETUP ; set up array of all cps user has access to D STA^PRCSUT I '$D(PRC("SITE")) W !,$P($T(MESSAGE+1),";;",2) Q S MESSAGE="" D ESIG^PRCUESIG(DUZ,.MESSAGE) I MESSAGE<1 W !,$P($T(MESSAGE+2),";;",2) Q ; S (AA,PRC("CP"))=0 F S PRC("CP")=$O(^PRC(420,"A",DUZ,PRC("SITE"),PRC("CP"))) Q:PRC("CP")="" D .Q:$G(^PRC(420,PRC("SITE"),1,+PRC("CP"),0))="" .I $P($G(^(0)),"^",19)'=1,$D(^PRC(420,"A",DUZ,PRC("SITE"),PRC("CP"),1)),$D(CPCK(PRC("CP"))) S CPARRAY(AA)=PRC("CP"),AA=AA+1 D INQUIRE W !!,"***END OF PROCESSING***" D LINE K CPCK Q INQUIRE ; S %=1 W !,"Loop thru all control points" D YN^DICN Q:%=-1 S:%=1 ALL=1 I %=0 W !,$P($T(MESSAGE+3),";;",2),! H 1 G INQUIRE INQUIRE1 ; I %=2 W @IOF D LINE R !,"Select CONTROL POINT: ",XY:DTIME Q:XY["^"!(XY="") I XY'?1.N D SHOW G INQUIRE1 F II=0:1:AA-1 S FOUND=0 Q:STOP1=-1 I $D(CPARRAY(II)) I (+XY=CPARRAY(II)!ALL=1) D PROCESS Q:STOP1=-1!(ALL=0) I FOUND=0 S %=2 W !,$P($T(MESSAGE+4),";;",2),! D LINE H 2 G INQUIRE1 Q PROCESS ; S FOUND=1,PRC("CP")=CPARRAY(II),CONT=0 W @IOF D LINE S %=1 W !!,"Loop thru all transactions for CP ",CPARRAY(II) D YN^DICN S:%=-1 STOP1=-1 Q:%=-1 I %=0 W !,$P($T(MESSAGE+5),";;",2),! H 1 G PROCESS I %=1 G PROCESS2 PROCESS1 ; Q:CONT=1 D LOOKUP Q:(CONT=1) S:$D(Y) YY=+Y D CHECK G PROCESS1 PROCESS2 ; ; start here if all transactions selected S CPVAR=PRC("SITE")_"-"_PRC("CP"),SLP="0-0-0" F PRCSI=0:0 S SLP=$O(^PRCS(410,"F",CPVAR_"-"_$P(SLP,"-",3))) Q:$P(CPVAR,"-",1,2)'=$P(SLP,"-",1,2)!(SLP="") Q:STOP1=-1 S PRCSDA=$O(^PRCS(410,"F",SLP,0)) Q:PRCSDA'>0 I $D(^PRCS(410,PRCSDA,0)) D CHECK I FND=0 W !,"No transactions found for this control point.",! D LINE H 2 S FND=0 Q CHECK ; S:$D(YY) DA=YY S:$D(PRCSDA) DA=PRCSDA Q:'$D(DA) S FND=1 D CHEC^PRCSAPP1 ; if all checks are passed, go on for final approval I SPENDCP=0 D FINAL^PRCSAPP2 S SPENDCP=0 Q LOOKUP ; S PRCSID=1,PRC("CP")=CPARRAY(II),DIC="^PRCS(410,",DIC(0)="AEQ",D="F" S DIC("S")="I +^(0)=PRC(""SITE""),+$P(^(0),""-"",4)=PRC(""CP""),$D(^PRC(420,""A"",DUZ,PRC(""SITE""),PRC(""CP""),1))" W @IOF D LINE W !,$P($T(MESSAGE+6),";;",2),! S DIC("A")="Select TRANSACTION: " D ^PRCSDIC K PRCSID,DIC,DIC("S"),DIC("A") S:Y<0 CONT=1 Q SHOW ; W !,"Select from the following control points: ",! F II=0:1:AA I $D(CPARRAY(II)) W !,?10,$P($G(^PRC(420,PRC("SITE"),1,CPARRAY(II),0)),"^") H 4 Q LINE ; W ! F LINE=1:1:53 W "_" W !! Q MESSAGE ; ;;Please contact your ADP Site manager to grant system access. ;;Contact your Site Manager for an electronic signature code. ;;Enter Yes to loop thru all your CPs, No to select only one. ;;Control Point has no transactions for approval! ;;Enter yes or no ;;Enter the last four digits,i.e.,'0094',of transaction number