source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCD1F.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 
1PRCD1F ;WISC/PLT-SUBSTATION ENTER/EDIT ; 08/03/95 2:33 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 substation
7EN N PRCDD,PRCDR,PRCRI,PRCAED,PRCQT,PRCU,A,B,X,Y S PRCU="^"
8 N PRCUQ
9 F D EN^DDIOL($TR($J("",78)," ","-")) D Q:PRCQT=1
10 . S PRCDD=411,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=411
21 S DA="",X("S")="I +Y>1000000"
22 S DA="" D LOOKUP^PRC0B(.X,.Y,PRCDD,"AEMOQLS","Select SUBSTATION: ")
23 I Y<0!(X="") S PRCQT=1 QUIT
24 S DA=+Y,PRCRI(PRCDD)=+Y,PRCAED=$P(Y,"^",3)
25 I PRCAED=1,DA<1000000!($P(Y,"^",2)?3N) D EN^DDIOL("Use option 'Site Parameters' to add new station.") D DELETE S PRCQT=2
26 I PRCAED=1,'$D(^PRC(411,$E($P(Y,"^",2),1,3),0)) D EN^DDIOL("Use option 'Site Parameters' to set up the parent station first.") D DELETE S PRCQT=2
27 QUIT
28 ;
29EDIT ;edit prcdd=411
30 S PRCDR="[PRCD SUBSTATION]",C=PRCDR
31ED1 D EDIT^PRC0B(.X,PRCDD_";;"_PRCRI(PRCDD),C) I X=0 S PRCQT=2 QUIT
32 I X=-1,PRCAED=1 D Q:PRCQT
33 . D YN^PRC0A(.X,.Y,"Delete this NEW entry","","No")
34 . I Y=1 D DELETE I PRCAED=-1 D EN^DDIOL(" **** NEW ENTRY DELETED ****") S PRCQT=3 QUIT
35 . D EN^DDIOL(" **** NEW ENTRY IS NOT DELETED ****")
36 .QUIT
37 ;require fileds check
38 S C="101;"
39EDA K A D PIECE^PRC0B(PRCDD_";;"_PRCRI(PRCDD),C,"I","A")
40 S C="" F A=101 I $G(A(PRCDD,PRCRI(PRCDD),A,"I"))="" S C=C_A_";"
41 K A I C]"" D EN^DDIOL(" **** Missing Required Field(s) ****") S C=C_"S Y=0;"_PRCDR G ED1
42 QUIT
43 ;
44DELETE ;delete prcdd=411
45 D DELETE^PRC0B1(.X,PRCDD_";^PRC(411,;"_PRCRI(PRCDD))
46 S:X=1 PRCAED=-1
47 QUIT
48 ;
49EN1 ;print file 411
50 N L,DIC,FLDS,BY,FR,TO,DHD,PRCDD
51 S PRCDD=411
52 S L=0,DIC=PRCDD,FLDS=".01,.1,.5,19.2"
53 S BY="@.01",FR="@",TO="~"
54 D EN1^DIP
55 QUIT
56 ;
Note: See TracBrowser for help on using the repository browser.