| 1 | PRCFQ1 ;WISC@ALTOONA/CTB-ADDITIONAL UTILITY SUBROUTINES ;4/18/96 11:12 AM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EX ;FINAL EXIT LINE FOR ALL FISCAL MENUS
|
|---|
| 5 | K PRC,PRCF,PRCFA,PRCFB Q
|
|---|
| 6 | INIT ;INITIAL SETUP FOR ALL FISCAL MENUS
|
|---|
| 7 | K DIC S:$D(DTIME)["0" DTIME=300
|
|---|
| 8 | 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
|
|---|
| 9 | Q
|
|---|
| 10 | DRNG ;SELECT RANGE OF DATES
|
|---|
| 11 | 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
|
|---|
| 12 | S FR=+Y S %DT("A")=" Enter Ending Date: " D ^%DT I X["^" K %DT,%H,%I,FR,Y S %=0 Q
|
|---|
| 13 | I Y<0 W "??",!,$C(7) K %DT,FR G DRNG
|
|---|
| 14 | S TO=+Y I TO<FR W !,$C(7),"Illogical range of dates. Try again.",! G DRNG
|
|---|
| 15 | S %=1 K %DT,%H,%I Q
|
|---|
| 16 | RNG ; ALLOW ENTRY OF BEGINNING AND ENDING RANGE
|
|---|
| 17 | 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
|
|---|
| 18 | S:FR="" FR="@" I FR'["@" I $D(PRCFD) S %DT="ET",X=FR D ^%DT G:Y<0 RNG S FR=Y
|
|---|
| 19 | 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
|
|---|
| 20 | I TO'["@" I $D(PRCFD) S X=TO D ^%DT G:Y<0 TO S TO=Y
|
|---|
| 21 | I (FR["@")!(TO["@") S %=1 Q
|
|---|
| 22 | I (+FR=FR)&(+TO=TO) I FR>TO W $C(7),!,"INVALID RANGE" G RNG
|
|---|
| 23 | I (+FR'=FR)!(+TO'=TO) I FR]TO W $C(7),!,"INVALID RANGE" G RNG
|
|---|
| 24 | Q
|
|---|
| 25 | RQ S %=0 K FR,TO,%DT,X,Y Q
|
|---|
| 26 | RQ1 S %=1 K %DT,M,PRCFD,X,Y Q
|
|---|
| 27 | LOCK ;LOCK GLOBAL THAT IS BEING ACCESSED BY ANOTHER USER
|
|---|
| 28 | L @("+"_DIC_DA_"):30") S PRCFL=$T Q:PRCFL W !!,$C(7),"THIS ENTRY IS BEING EDITED BY ANOTHER USER. TRY LATER." Q
|
|---|
| 29 | ;
|
|---|
| 30 | VRQS ;THIS ENTRY POINT WILL INFORM USER THERE ARE VENDOR REQUESTS
|
|---|
| 31 | ;TO REVIEW.
|
|---|
| 32 | ;
|
|---|
| 33 | ; ONLY USERS THAT WILL SEE THIS MESSAGE WILL BE THOSE
|
|---|
| 34 | ; THAT HAVE THE 'PRCFA VENDOR EDIT' SECURITY KEY.
|
|---|
| 35 | ;
|
|---|
| 36 | N COUNT
|
|---|
| 37 | Q:'$D(DUZ) ;YOU ARE UNDEFINED
|
|---|
| 38 | Q:'$D(^XUSEC("PRCFA VENDOR EDIT",DUZ)) ;YOU DO NOT HAVE THE SECURITY KEY
|
|---|
| 39 | S COUNT=$O(^PRCF(422.2,"B","123-VRQ-01",0)) Q:COUNT'>0
|
|---|
| 40 | S COUNT=$P($G(^PRCF(422.2,COUNT,0)),U,2) Q:COUNT'>0
|
|---|
| 41 | W !!,"There are VRQs for you to review."
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | AC ;CROSS-REFERENCE CODE FROM "AC" X-REF OF FIELD 49 (SITE) IN FILE 440.3
|
|---|
| 45 | N PRCX,DIC,X,DLAYGO,Y
|
|---|
| 46 | S PRCX=$O(^PRCF(422.2,"B","123-VRQ-01",0)) D:PRCX=""
|
|---|
| 47 | . ;NEED TO SET UP ENTRY IN COUNTER FILE.
|
|---|
| 48 | . K DD,DO
|
|---|
| 49 | . S DIC="^PRCF(422.2,",DIC(0)="L",X="123-VRQ-01",DLAYGO=422.2
|
|---|
| 50 | . D FILE^DICN S PRCX=+Y
|
|---|
| 51 | S $P(^PRCF(422.2,PRCX,0),U,2)=$P(^PRCF(422.2,PRCX,0),U,2)+1
|
|---|
| 52 | Q
|
|---|
