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 Oct 16, 2024@18:17:55 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
