PRCFQ1 ;WISC@ALTOONA/CTB-ADDITIONAL UTILITY SUBROUTINES ;4/18/96 11:12 AM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
EX ;FINAL EXIT LINE FOR ALL FISCAL MENUS
K PRC,PRCF,PRCFA,PRCFB Q
INIT ;INITIAL SETUP FOR ALL FISCAL MENUS
K DIC S:$D(DTIME)["0" DTIME=300
I $D(DUZ)["0" W !,"I don't seem to be able to identify you. Please log in again.",$C(7) R X:3 Q
Q
DRNG ;SELECT RANGE OF DATES
K %DT W ! S %DT="EAT",%DT("A")="Enter Beginning Date: " D ^%DT I Y<0 K %H,%I,%DT,TO,FR,X,Y S %=0 Q
S FR=+Y S %DT("A")=" Enter Ending Date: " D ^%DT I X["^" K %DT,%H,%I,FR,Y S %=0 Q
I Y<0 W "??",!,$C(7) K %DT,FR G DRNG
S TO=+Y I TO<FR W !,$C(7),"Illogical range of dates. Try again.",! G DRNG
S %=1 K %DT,%H,%I Q
RNG ; ALLOW ENTRY OF BEGINNING AND ENDING RANGE
S %=0,FR="",TO="z" S:'$D(DTIME) DTIME=120 W !!,"Start with "_M_": FIRST// " R FR:DTIME S:$T=0 FR="^" G:FR["^" RQ I FR["?",'$D(PRCFD) G RQ
S:FR="" FR="@" I FR'["@" I $D(PRCFD) S %DT="ET",X=FR D ^%DT G:Y<0 RNG S FR=Y
TO W !,"Go to "_M_": LAST// " R TO:DTIME S:$T=0 TO="^" G:TO["^" RQ G:TO["?"&('$D(PRCFD)) RNG S:TO="" TO="z" I TO="z" G RQ1
I TO'["@" I $D(PRCFD) S X=TO D ^%DT G:Y<0 TO S TO=Y
I (FR["@")!(TO["@") S %=1 Q
I (+FR=FR)&(+TO=TO) I FR>TO W $C(7),!,"INVALID RANGE" G RNG
I (+FR'=FR)!(+TO'=TO) I FR]TO W $C(7),!,"INVALID RANGE" G RNG
Q
RQ S %=0 K FR,TO,%DT,X,Y Q
RQ1 S %=1 K %DT,M,PRCFD,X,Y Q
LOCK ;LOCK GLOBAL THAT IS BEING ACCESSED BY ANOTHER USER
L @("+"_DIC_DA_"):30") S PRCFL=$T Q:PRCFL W !!,$C(7),"THIS ENTRY IS BEING EDITED BY ANOTHER USER. TRY LATER." Q
;
VRQS ;THIS ENTRY POINT WILL INFORM USER THERE ARE VENDOR REQUESTS
;TO REVIEW.
;
; ONLY USERS THAT WILL SEE THIS MESSAGE WILL BE THOSE
; THAT HAVE THE 'PRCFA VENDOR EDIT' SECURITY KEY.
;
N COUNT
Q:'$D(DUZ) ;YOU ARE UNDEFINED
Q:'$D(^XUSEC("PRCFA VENDOR EDIT",DUZ)) ;YOU DO NOT HAVE THE SECURITY KEY
S COUNT=$O(^PRCF(422.2,"B","123-VRQ-01",0)) Q:COUNT'>0
S COUNT=$P($G(^PRCF(422.2,COUNT,0)),U,2) Q:COUNT'>0
W !!,"There are VRQs for you to review."
Q
;
AC ;CROSS-REFERENCE CODE FROM "AC" X-REF OF FIELD 49 (SITE) IN FILE 440.3
N PRCX,DIC,X,DLAYGO,Y
S PRCX=$O(^PRCF(422.2,"B","123-VRQ-01",0)) D:PRCX=""
. ;NEED TO SET UP ENTRY IN COUNTER FILE.
. K DD,DO
. S DIC="^PRCF(422.2,",DIC(0)="L",X="123-VRQ-01",DLAYGO=422.2
. D FILE^DICN S PRCX=+Y
S $P(^PRCF(422.2,PRCX,0),U,2)=$P(^PRCF(422.2,PRCX,0),U,2)+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFQ1 2469 printed Sep 23, 2025@19:40:24 Page 2
PRCFQ1 ;WISC@ALTOONA/CTB-ADDITIONAL UTILITY SUBROUTINES ;4/18/96 11:12 AM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
EX ;FINAL EXIT LINE FOR ALL FISCAL MENUS
+1 KILL PRC,PRCF,PRCFA,PRCFB
QUIT
INIT ;INITIAL SETUP FOR ALL FISCAL MENUS
+1 KILL DIC
if $DATA(DTIME)["0"
SET DTIME=300
+2 IF $DATA(DUZ)["0"
WRITE !,"I don't seem to be able to identify you. Please log in again.",$CHAR(7)
READ X:3
QUIT
+3 QUIT
DRNG ;SELECT RANGE OF DATES
+1 KILL %DT
WRITE !
SET %DT="EAT"
SET %DT("A")="Enter Beginning Date: "
DO ^%DT
IF Y<0
KILL %H,%I,%DT,TO,FR,X,Y
SET %=0
QUIT
+2 SET FR=+Y
SET %DT("A")=" Enter Ending Date: "
DO ^%DT
IF X["^"
KILL %DT,%H,%I,FR,Y
SET %=0
QUIT
+3 IF Y<0
WRITE "??",!,$CHAR(7)
KILL %DT,FR
GOTO DRNG
+4 SET TO=+Y
IF TO<FR
WRITE !,$CHAR(7),"Illogical range of dates. Try again.",!
GOTO DRNG
+5 SET %=1
KILL %DT,%H,%I
QUIT
RNG ; ALLOW ENTRY OF BEGINNING AND ENDING RANGE
+1 SET %=0
SET FR=""
SET TO="z"
if '$DATA(DTIME)
SET DTIME=120
WRITE !!,"Start with "_M_": FIRST// "
READ FR:DTIME
if $TEST=0
SET FR="^"
if FR["^"
GOTO RQ
IF FR["?"
IF '$DATA(PRCFD)
GOTO RQ
+2 if FR=""
SET FR="@"
IF FR'["@"
IF $DATA(PRCFD)
SET %DT="ET"
SET X=FR
DO ^%DT
if Y<0
GOTO RNG
SET FR=Y
TO WRITE !,"Go to "_M_": LAST// "
READ TO:DTIME
if $TEST=0
SET TO="^"
if TO["^"
GOTO RQ
if TO["?"&('$DATA(PRCFD))
GOTO RNG
if TO=""
SET TO="z"
IF TO="z"
GOTO RQ1
+1 IF TO'["@"
IF $DATA(PRCFD)
SET X=TO
DO ^%DT
if Y<0
GOTO TO
SET TO=Y
+2 IF (FR["@")!(TO["@")
SET %=1
QUIT
+3 IF (+FR=FR)&(+TO=TO)
IF FR>TO
WRITE $CHAR(7),!,"INVALID RANGE"
GOTO RNG
+4 IF (+FR'=FR)!(+TO'=TO)
IF FR]TO
WRITE $CHAR(7),!,"INVALID RANGE"
GOTO RNG
+5 QUIT
RQ SET %=0
KILL FR,TO,%DT,X,Y
QUIT
RQ1 SET %=1
KILL %DT,M,PRCFD,X,Y
QUIT
LOCK ;LOCK GLOBAL THAT IS BEING ACCESSED BY ANOTHER USER
+1 LOCK @("+"_DIC_DA_"):30")
SET PRCFL=$TEST
if PRCFL
QUIT
WRITE !!,$CHAR(7),"THIS ENTRY IS BEING EDITED BY ANOTHER USER. TRY LATER."
QUIT
+2 ;
VRQS ;THIS ENTRY POINT WILL INFORM USER THERE ARE VENDOR REQUESTS
+1 ;TO REVIEW.
+2 ;
+3 ; ONLY USERS THAT WILL SEE THIS MESSAGE WILL BE THOSE
+4 ; THAT HAVE THE 'PRCFA VENDOR EDIT' SECURITY KEY.
+5 ;
+6 NEW COUNT
+7 ;YOU ARE UNDEFINED
if '$DATA(DUZ)
QUIT
+8 ;YOU DO NOT HAVE THE SECURITY KEY
if '$DATA(^XUSEC("PRCFA VENDOR EDIT",DUZ))
QUIT
+9 SET COUNT=$ORDER(^PRCF(422.2,"B","123-VRQ-01",0))
if COUNT'>0
QUIT
+10 SET COUNT=$PIECE($GET(^PRCF(422.2,COUNT,0)),U,2)
if COUNT'>0
QUIT
+11 WRITE !!,"There are VRQs for you to review."
+12 QUIT
+13 ;
AC ;CROSS-REFERENCE CODE FROM "AC" X-REF OF FIELD 49 (SITE) IN FILE 440.3
+1 NEW PRCX,DIC,X,DLAYGO,Y
+2 SET PRCX=$ORDER(^PRCF(422.2,"B","123-VRQ-01",0))
if PRCX=""
Begin DoDot:1
+3 ;NEED TO SET UP ENTRY IN COUNTER FILE.
+4 KILL DD,DO
+5 SET DIC="^PRCF(422.2,"
SET DIC(0)="L"
SET X="123-VRQ-01"
SET DLAYGO=422.2
+6 DO FILE^DICN
SET PRCX=+Y
End DoDot:1
+7 SET $PIECE(^PRCF(422.2,PRCX,0),U,2)=$PIECE(^PRCF(422.2,PRCX,0),U,2)+1
+8 QUIT
