source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCD1A.m@ 619

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PRCD1A ;WISC/PLT-DEFINE/PRINT DEFINED STANDARD DICTIONARY ; 02/16/94 11:30 AM
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 ;define standard dictionary
7EN N PRCDD,PRCDR,PRCRI,PRCAED,PRCQT,PRCU,A,B,X,Y S PRCU="^"
8 F D EN^DDIOL(" ") D Q:PRCQT=1
9 . S PRCDD=420.19,PRCQT=""
10 . D LKUP Q:PRCQT
11 . S PRCLOCK=$$DICGL^PRC0B1(PRCDD)_PRCRI(PRCDD)_",",Y=3 D ICLOCK^PRC0B(PRCLOCK,.Y)
12 . I 'Y D EN^DDIOL("File is in use, please try later!") QUIT
13 . D EDIT
14 . D DCLOCK^PRC0B(PRCLOCK)
15 . QUIT
16 QUIT
17 ;
18LKUP ;lookup prcdd=420.19
19 S DA="" D LOOKUP^PRC0B(.X,.Y,PRCDD,"AEMOQLS","Select Standard Dictionary: ")
20 I Y<0!(X="") S PRCQT=1 QUIT
21 S PRCRI(PRCDD)=+Y,PRCAED=$P(Y,"^",3)
22 QUIT
23 ;
24EDIT ;edit prcdd=420.19
25 S PRCDR=".01:99999999",C=PRCDR
26ED1 D EDIT^PRC0B(.X,PRCDD_";;"_PRCRI(PRCDD),C) I X=0 S PRCQT=2 QUIT
27 I X=-1,PRCAED=1 D Q:PRCQT
28 . D YN^PRC0A(.X,.Y,"Delete this NEW entry","","No")
29 . I Y=1 D DELETE I PRCAED=-1 D EN^DDIOL(" **** NEW ENTRY DELETED ****") S PRCQT=3 QUIT
30 . D EN^DDIOL(" **** NEW ENTRY IS NOT DELETED ****")
31 .QUIT
32 ;require fileds check
33 S C="2;3;4;5;"
34EDA D PIECE^PRC0B(PRCDD_";;"_PRCRI(PRCDD),C,"I","A")
35 S C="" F A=2,3,4,5 I $G(A(PRCDD,PRCRI(PRCDD),A,"I"))="" S C=C_A_";"
36 K A I C]"" D EN^DDIOL(" **** Missing Required Field(s) ****") S C=C_"S Y=0;"_PRCDR G ED1
37 QUIT
38 ;
39DELETE ;delete prcdd=420.19
40 D DELETE^PRC0B1(.X,PRCDD_";^PRCD(420.19,;"_PRCRI(PRCDD))
41 S:X=1 PRCAED=-1
42 QUIT
43 ;
44EN1 ;print defined standard dictionary
45 N L,DIC,FLDS,BY,FR,TO,DHD,PRCDD
46 S PRCDD=420.19
47 S L=0,DIC=PRCDD,FLDS="[PRCD LIST]"
48 S BY="@.01",FR="@",TO="~"
49 D EN1^DIP
50 QUIT
51 ;
52INIDIC ;initial dictionary files
53 N X,Y
54 S (X,Y)=""
55 D YN^PRC0A(.X,.Y,"Initial Standard Dic","No")
56 Q:Y=0
57 F I=420.13,420.131,420.14,420.15,420.16,420.17,420.19 D
58 . S X=^PRCD(I,0) K ^PRCD(I) S $P(X,"^",3,4)="",^PRCD(I,0)=X
59 . QUIT
60 W !,"ALL DONE!"
61 QUIT
62 ;
Note: See TracBrowser for help on using the repository browser.