- 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 Feb 18, 2025@23:30:43 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