source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCD1E.m@ 1141

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

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1PRCD1E ;WISC/PLT-FUND/APPROPRIATION ENTER/EDIT ; 02/08/94 12:06 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 QUIT ;invalid entry
5 ;
6 ;enter/edit fund/appropriation
7EN N PRCDD,PRCDR,PRCRI,PRCAED,PRCQT,PRCU,A,B,X,Y S PRCU="^"
8 N PRCUQ,PRCK,PRCK01,PRCK2,PRCK3
9 F D EN^DDIOL($TR($J("",78)," ","-")) D Q:PRCQT=1
10 . S PRCDD=420.3,PRCQT=""
11 . S PRCUQ=""
12 . D LKUP Q:PRCQT
13 . S PRCLOCK=$$DICGL^PRC0B1(PRCDD)_PRCRI(PRCDD)_",",Y=3 D ICLOCK^PRC0B(PRCLOCK,.Y)
14 . I 'Y D EN^DDIOL("File is in use, please try later!") QUIT
15 . D EDIT
16 . D DCLOCK^PRC0B(PRCLOCK)
17 . QUIT
18 QUIT
19 ;
20LKUP ;lookup prcdd=420.3
21 S DA="" D LOOKUP^PRC0B(.X,.Y,PRCDD,"AEMOQLS","Select Appropriation's Fund: ")
22 I Y<0!(X="") S PRCQT=1 QUIT
23 S DA=+Y,PRCRI(PRCDD)=+Y,PRCAED=$P(Y,"^",3)
24 QUIT
25 ;
26EDIT ;edit prcdd=420.3
27 S PRCDR=".01;2;7;3;4",C=PRCDR
28ED1 D EDIT^PRC0B(.X,PRCDD_";;"_PRCRI(PRCDD),C) I X=0 S PRCQT=2 QUIT
29 I X=-1,PRCAED=1 D Q:PRCQT
30 . D YN^PRC0A(.X,.Y,"Delete this NEW entry","","No")
31 . I Y=1 D DELETE I PRCAED=-1 D EN^DDIOL(" **** NEW ENTRY DELETED ****") S PRCQT=3 QUIT
32 . D EN^DDIOL(" **** NEW ENTRY IS NOT DELETED ****")
33 .QUIT
34 ;require fileds check
35 S C="2;"
36EDA K A D PIECE^PRC0B(PRCDD_";;"_PRCRI(PRCDD),C,"I","A")
37 S C="" F A=2 I $G(A(PRCDD,PRCRI(PRCDD),A,"I"))="" S C=C_A_";"
38 K A I C]"" D EN^DDIOL(" **** Missing Required Field(s) ****") S C=C_"S Y=0;"_PRCDR G ED1
39 QUIT
40 ;
41DELETE ;delete prcdd=420.3
42 D DELETE^PRC0B1(.X,PRCDD_";^PRCD(420.3,;"_PRCRI(PRCDD))
43 S:X=1 PRCAED=-1
44 QUIT
45 ;
46EN1 ;print fund/appropriation
47 N L,DIC,FLDS,BY,FR,TO,DHD,PRCDD
48 S PRCDD=420.3
49 S L=0,DIC=PRCDD,FLDS="[PRCD FUND/APPROPRIATION]"
50 S BY="@.01",FR="@",TO="~"
51 D EN1^DIP
52 QUIT
53 ;
Note: See TracBrowser for help on using the repository browser.