- PRCSAPP ;WISC/KMB-NEW 2237 APPROVAL ; 10-27-93 12:00
- V ;;5.1;IFCAP;**165**;Oct 20, 2000;Build 12
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;Patch PRC*5.1*165 adds a check @SETUP to insure station is not only defined
- ; but has a value >0.
- 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(DIRUT)!($D(DUOUT)) K DIRUT,DUOUT Q
- I '$D(PRC("SITE")) W !,$P($T(MESSAGE+1),";;",2) Q
- I +$G(PRC("SITE"))'>0 W !,$P($T(MESSAGE+7),";;",2) G SETUP
- 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
- ;;Please select site
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSAPP 3525 printed Mar 13, 2025@21:21:59 Page 2
- PRCSAPP ;WISC/KMB-NEW 2237 APPROVAL ; 10-27-93 12:00
- V ;;5.1;IFCAP;**165**;Oct 20, 2000;Build 12
- +1 ;Per VHA Directive 2004-038, this routine should not be modified.
- +2 ;Patch PRC*5.1*165 adds a check @SETUP to insure station is not only defined
- +3 ; but has a value >0.
- START ;
- +1 NEW APPREQ,MESSAGE,YY,XY,SPENDCP,ALL,LOOP,FOUND,PRCS1,%,AA,TEST,II,CPARRAY
- +2 NEW FND,CPVAR,STOP1,SLP,PRCSDA,PRCSI,CONT,LINE
- +3 SET (FND,STOP1,TEST,FOUND,ALL,PRC("CP"))=0
- SET XY=""
- SET AA=0
- SET SPENDCP=0
- +4 KILL CPCK
- SET APPREQ=1
- WRITE !!,"Please wait while I check your control points..."
- DO ^PRCSUT1
- +5 IF '$DATA(CPCK)
- WRITE !,"You have no transactions ready for approval."
- QUIT
- SETUP ; set up array of all cps user has access to
- +1 DO STA^PRCSUT
- IF $DATA(DIRUT)!($DATA(DUOUT))
- KILL DIRUT,DUOUT
- QUIT
- +2 IF '$DATA(PRC("SITE"))
- WRITE !,$PIECE($TEXT(MESSAGE+1),";;",2)
- QUIT
- +3 IF +$GET(PRC("SITE"))'>0
- WRITE !,$PIECE($TEXT(MESSAGE+7),";;",2)
- GOTO SETUP
- +4 SET MESSAGE=""
- DO ESIG^PRCUESIG(DUZ,.MESSAGE)
- IF MESSAGE<1
- WRITE !,$PIECE($TEXT(MESSAGE+2),";;",2)
- QUIT
- +5 ;
- +6 SET (AA,PRC("CP"))=0
- FOR
- SET PRC("CP")=$ORDER(^PRC(420,"A",DUZ,PRC("SITE"),PRC("CP")))
- if PRC("CP")=""
- QUIT
- Begin DoDot:1
- +7 if $GET(^PRC(420,PRC("SITE"),1,+PRC("CP"),0))=""
- QUIT
- +8 IF $PIECE($GET(^(0)),"^",19)'=1
- IF $DATA(^PRC(420,"A",DUZ,PRC("SITE"),PRC("CP"),1))
- IF $DATA(CPCK(PRC("CP")))
- SET CPARRAY(AA)=PRC("CP")
- SET AA=AA+1
- End DoDot:1
- +9 DO INQUIRE
- WRITE !!,"***END OF PROCESSING***"
- DO LINE
- KILL CPCK
- QUIT
- INQUIRE ;
- +1 SET %=1
- WRITE !,"Loop thru all control points"
- DO YN^DICN
- if %=-1
- QUIT
- if %=1
- SET ALL=1
- IF %=0
- WRITE !,$PIECE($TEXT(MESSAGE+3),";;",2),!
- HANG 1
- GOTO INQUIRE
- INQUIRE1 ;
- +1 IF %=2
- WRITE @IOF
- DO LINE
- READ !,"Select CONTROL POINT: ",XY:DTIME
- if XY["^"!(XY="")
- QUIT
- IF XY'?1.N
- DO SHOW
- GOTO INQUIRE1
- +2 FOR II=0:1:AA-1
- SET FOUND=0
- if STOP1=-1
- QUIT
- IF $DATA(CPARRAY(II))
- IF (+XY=CPARRAY(II)!ALL=1)
- DO PROCESS
- if STOP1=-1!(ALL=0)
- QUIT
- +3 IF FOUND=0
- SET %=2
- WRITE !,$PIECE($TEXT(MESSAGE+4),";;",2),!
- DO LINE
- HANG 2
- GOTO INQUIRE1
- +4 QUIT
- PROCESS ;
- +1 SET FOUND=1
- SET PRC("CP")=CPARRAY(II)
- SET CONT=0
- +2 WRITE @IOF
- DO LINE
- +3 SET %=1
- WRITE !!,"Loop thru all transactions for CP ",CPARRAY(II)
- DO YN^DICN
- if %=-1
- SET STOP1=-1
- if %=-1
- QUIT
- IF %=0
- WRITE !,$PIECE($TEXT(MESSAGE+5),";;",2),!
- HANG 1
- GOTO PROCESS
- +4 IF %=1
- GOTO PROCESS2
- PROCESS1 ;
- +1 if CONT=1
- QUIT
- DO LOOKUP
- if (CONT=1)
- QUIT
- if $DATA(Y)
- SET YY=+Y
- DO CHECK
- GOTO PROCESS1
- PROCESS2 ;
- +1 ; start here if all transactions selected
- +2 SET CPVAR=PRC("SITE")_"-"_PRC("CP")
- SET SLP="0-0-0"
- +3 FOR PRCSI=0:0
- SET SLP=$ORDER(^PRCS(410,"F",CPVAR_"-"_$PIECE(SLP,"-",3)))
- if $PIECE(CPVAR,"-",1,2)'=$PIECE(SLP,"-",1,2)!(SLP="")
- QUIT
- if STOP1=-1
- QUIT
- SET PRCSDA=$ORDER(^PRCS(410,"F",SLP,0))
- if PRCSDA'>0
- QUIT
- IF $DATA(^PRCS(410,PRCSDA,0))
- DO CHECK
- +4 IF FND=0
- WRITE !,"No transactions found for this control point.",!
- DO LINE
- +5 HANG 2
- SET FND=0
- QUIT
- CHECK ;
- +1 if $DATA(YY)
- SET DA=YY
- if $DATA(PRCSDA)
- SET DA=PRCSDA
- +2 if '$DATA(DA)
- QUIT
- SET FND=1
- DO CHEC^PRCSAPP1
- +3 ; if all checks are passed, go on for final approval
- +4 IF SPENDCP=0
- DO FINAL^PRCSAPP2
- +5 SET SPENDCP=0
- QUIT
- LOOKUP ;
- +1 SET PRCSID=1
- SET PRC("CP")=CPARRAY(II)
- SET DIC="^PRCS(410,"
- SET DIC(0)="AEQ"
- SET D="F"
- +2 SET DIC("S")="I +^(0)=PRC(""SITE""),+$P(^(0),""-"",4)=PRC(""CP""),$D(^PRC(420,""A"",DUZ,PRC(""SITE""),PRC(""CP""),1))"
- +3 WRITE @IOF
- DO LINE
- +4 WRITE !,$PIECE($TEXT(MESSAGE+6),";;",2),!
- +5 SET DIC("A")="Select TRANSACTION: "
- DO ^PRCSDIC
- KILL PRCSID,DIC,DIC("S"),DIC("A")
- +6 if Y<0
- SET CONT=1
- QUIT
- SHOW ;
- +1 WRITE !,"Select from the following control points: ",!
- +2 FOR II=0:1:AA
- IF $DATA(CPARRAY(II))
- WRITE !,?10,$PIECE($GET(^PRC(420,PRC("SITE"),1,CPARRAY(II),0)),"^")
- +3 HANG 4
- +4 QUIT
- LINE ;
- +1 WRITE !
- FOR LINE=1:1:53
- WRITE "_"
- +2 WRITE !!
- QUIT
- MESSAGE ;
- +1 ;;Please contact your ADP Site manager to grant system access.
- +2 ;;Contact your Site Manager for an electronic signature code.
- +3 ;;Enter Yes to loop thru all your CPs, No to select only one.
- +4 ;;Control Point has no transactions for approval!
- +5 ;;Enter yes or no
- +6 ;;Enter the last four digits,i.e.,'0094',of transaction number
- +7 ;;Please select site
