source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSEB.m@ 1226

Last change on this file since 1226 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1PRCSEB ;SF-ISC/LJP/SAW/DXH/DAP - CPA EDITS CON'T ;7.26.99
2V ;;5.1;IFCAP;**81**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4ENRB ;ENTER CP CLERK REQUEST FROM OPTION PRCSENRB
5 D ENF^PRCSUT(1) G W2:'$D(PRC("SITE")) G EXIT:'$D(PRC("QTR"))!(Y<0)
6 D EN1^PRCSUT3 Q:'X S PRCSX1=X D EN2^PRCSUT3 Q:'$D(PRCSX1) S X=PRCSX1,T1=DA D W L +^PRCS(410,DA):15 G ENRB:$T=0 I $D(^PRC(420,PRC("SITE"),1,+PRC("CP"),0)) S:$P(^(0),"^",11)="Y" PRCS2=1
7 ;
8 ;*81 Check site parameter to see if issue books should be allowed
9 D CKPRM
10 W !!,PRCVY,!!
11TYPE ;
12 S PRCDAA=DA,DIC="^PRCS(410.5,",DIC(0)="AEQZ",DIC("A")="FORM TYPE: ",DIC("S")=PRCVX D ^DIC S TYPE=+Y,DA=PRCDAA
13 I TYPE<2 W "?? EXIT NOT ALLOWED" G TYPE
14 K PRCVX,PRCVY
15 S $P(^PRCS(410,DA,0),"^",4)=TYPE S:$G(PRCSIP) $P(^PRCS(410,DA,0),"^",6)=PRCSIP S (DIE,DIC)="^PRCS(410,",X=TYPE
16 ;NOTE THAT THE FOLLOWING LINE OVERWRITES THE USER'S SELECTION OF FORM
17 ;TYPE IF THE FUND CONTROL POINT IS NOT 'AUTOMATED'
18 S:'$D(PRCS2)&(X>2) $P(^PRCS(410,DA,0),"^",4)=2,X=2
19 S (PRCSDR,DR)="["_$S(X=2:"PRCSEN2237B",X=3:"PRCSENPR",X=4:"PRCSENR&NR",1:"PRCSENIB")_"]"
20EN1 K DTOUT,DUOUT,Y S PRCSDAA=DA D ^DIE I $D(Y)!($D(DTOUT)) S DA=PRCSDAA L -^PRCS(410,DA) G EXIT
21 S DA=PRCSDAA D RL^PRCSUT1
22 D ^PRCSCK I $D(PRCSERR),PRCSERR G EN1
23 K PRCSERR
24 I PRCSDR="[PRCSENCOD]" D W7^PRCSEB0 D:$D(PRCSOB) ENOD1^PRCSEB1 K PRCSOB
25 S:$P($G(^PRCS(410,DA,7)),"^")="" $P(^PRCS(410,DA,7),"^")=DUZ
26 D:PRCSDR'="[PRCSENCOD]" W1 I $D(PRCS2),+^PRCS(410,DA,0) D W6
27 S DA=PRCSDAA L -^PRCS(410,DA) D W3 G EXIT:%'=1 W !! K PRCS,PRCS2
28 G ENRB
29W W !!,"This transaction is assigned transaction number: ",X Q
30W1 W !!,"Would you like to review this request" S %=2 D YN^DICN G W1:%=0 Q:%'=1 S (N,PRCSZ)=DA,PRCSF=1 D PRF1^PRCSP1 S DA=PRCSZ K X,PRCSF,PRCSZ Q
31W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
32W3 W !!,"Would you like to enter another request" S %=1 D YN^DICN G W3:%=0 Q
33W5 S:'$D(^PRCS(410,DA,11)) ^(11)="" S $P(^(11),U,3)="" K ^PRCS(410,"F",PRC("SITE")_"-"_+PRC("CP")_"-"_$P($P(^PRCS(410,DA,0),U),"-",5),DA),^PRCS(410,"F1",$P($P(^PRCS(410,DA,0),U),"-",5)_"-"_PRC("SITE")_"-"_+PRC("CP"),DA),^PRCS(410,"AQ",1,DA) Q
34W51 S:'$D(^PRCS(410,DA,11)) ^(11)="" S $P(^(11),U,3)=1,(^PRCS(410,"F",PRC("SITE")_"-"_+PRC("CP")_"-"_$P($P(^PRCS(410,DA,0),U),"-",5),DA),^PRCS(410,"F1",$P($P(^PRCS(410,DA,0),U),"-",5)_"-"_PRC("SITE")_"-"_+PRC("CP"),DA),^PRCS(410,"AQ",1,DA))="" Q
35W6 N JUMP,SKIPRNT,OK,TEST,TEST1,CURQTR,CURQTR1
36W61 ;
37 N REPORT2 I $P($G(^PRC(420,PRC("SITE"),1,+PRC("CP"),1,DUZ,0)),"^",2)'=1 S REPORT2=1 D T1^PRCSAPP1
38 I $P($G(^PRC(420,PRC("SITE"),1,+PRC("CP"),1,DUZ,0)),"^",2)'=1 S %=1 W !,"Is this request ready for approval" D YN^DICN D:%=1 W51 D:%=0 W61 D:%=2 W5 Q
39 S PRCSN=^PRCS(410,DA,0),PRCHQ=$P(PRCSN,"^",4),PRC("FY")=$P(PRCSN,"-",2),PRC("QTR")=$P(PRCSN,"-",3)
40 S (CURQTR,CURQTR1)=PRC("QTR"),(JUMP,TEST,TEST1,OK)=0
41 D T1^PRCSAPP1 I OK=1 S SKIPRNT=1 D FINAL^PRCSAPP2
42 Q
43 ;*81 Site Parameter Check
44CKPRM I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")=1 S PRCVX="I Y>1&(Y<5)",PRCVY="The form types 1358, Issue Book, and NO FORM are no longer used within this option."
45 I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1 S PRCVX="I Y>1",PRCVY="The form types 1358 and NO FORM are no longer used within this option"
46 Q
47 ;
48EXIT K %,C,D,DA,DIC,DIE,DQ,DR,PRCS,PRCS2,PRCSDAA,PRCSDR,PRCSERR,PRCSL,PRCSTT,I,N,T,T1,T2,X,X1,PRCSX3,Y,Z Q
Note: See TracBrowser for help on using the repository browser.