source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCB1A.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: 3.7 KB
Line 
1PRCB1A ;WISC/PLT-CONTROL POINT ENTER/EDIT ; 12/10/97 1600
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 ;
6EN N PRC,PRCDD,PRCDR,PRCDI,PRCRI,PRCPR,PRCAED,PRCQT,PRCU S PRCU="^"
7 N PRCK,PRCLOCK,PRCNO,PRCST,PRCUNQ
8 N DA,A,B,X,Y
9 N PRCUQ,PRCK1,PRCK26,PRCK28,PRCK29,PRCK25,PRCK25D5,PRCK27
10 N PRCF,PRCFA,PRCFUND,PRCBBFY,PRCRQ
11 S PRCF("X")="AS" D ^PRCFSITE G:$G(PRC("SITE"))="" EXIT
12 I '$D(^PRC(420,PRC("SITE"))) K X S X=PRC("SITE"),Y=""="" D ADD^PRC0B1(.X,.Y,"420;^PRC(420,",X) G:Y<0 EXIT
13 S PRCDD=420,PRCRI(420)=PRC("SITE"),PRCFA("ALL")=""
14 S PRCLOCK=$$DICGL^PRC0B1(PRCDD)_PRCRI(PRCDD)_",",Y=3 D ICLOCK^PRC0B(PRCLOCK,.Y)
15 I 'Y D EN^DDIOL("The station/fund control point data is in use, edit station data is not allowed.") G FCP
16 S PRCDR="2;3;10;11;3.1"
17 D EDIT^PRC0B(.X,PRCDD_";;"_PRCRI(PRCDD),PRCDR)
18 D DCLOCK^PRC0B(PRCLOCK)
19FCP F D EN^DDIOL($TR($J("",78)," ","-")) D Q:PRCQT=1
20 . N PRCDD,PRCAED,PRCDI,PRCLOCK1
21 . S PRCDD=420.01,PRCQT=""
22 . S X("S")="I ^(0)-9999"
23 . D LKUP Q:PRCQT
24 . S PRCLOCK1=PRCLOCK_"1,"_PRCRI(PRCDD)_",",Y=3 D ICLOCK^PRC0B(PRCLOCK1,.Y)
25 . I 'Y D EN^DDIOL("The station/selected fund control point data is in use, please try later!") QUIT
26 . S Y=$$NODE^PRC0B("^PRC(420,PRCRI(420),1,PRCRI(420.01),",0)
27 . S PRCST=$P(Y,PRCU,19),PRCNM=$P(Y,PRCU),PRCNO=$P(PRCNM," "),PRCNM=$P(PRCNM," ",2,999)
28 . D KEY1
29 . D REQ1^PRCB1A1
30 . D EDIT
31 . D TUSER^PRCSEB1(PRCRI(PRCDD))
32 . D DCLOCK^PRC0B(PRCLOCK1)
33 . QUIT
34EXIT QUIT
35 ;
36LKUP ;lookup prcdd=420.01
37 S PRCDI="420;^PRC(420,;"_PRCRI(420)_";1~420.01;^PRC(420,"_PRCRI(420)_",1,"
38 D LOOKUP^PRC0B(.X,.Y,PRCDI,"AEOQLS","Select Fund Control Point: ")
39 I Y<0!(X="") S PRCQT=1 K X QUIT
40 K X S PRCRI(PRCDD)=+Y,PRCAED=$P(Y,"^",3)
41 S PRCDI="420;^PRC(420,;"_PRCRI(420)_"~420.01;^PRC(420,"_PRCRI(420)_",1,;"_PRCRI(420.01)
42 QUIT
43 ;
44EDIT ;edit prcdd=420.01
45 I PRCST=1 D Q:PRCQT
46 . D EDIT^PRC0B(.X,PRCDI,"20Active/Inactive Control Point","") I X=0 S PRCQT=2
47 . K A D PIECE^PRC0B(PRCDI,"1~20","I","A")
48 . S X=$G(A(PRCDD,PRCRI(PRCDD),20,"I")) K A
49 . S X=$S(X=1:"23////^S X=DUZ;24///NOW",1:"23///^S X=""@"";24///^S X=""@""")
50 . D EDIT^PRC0B(.X,PRCDI,X)
51 D FT^PRC0A(.X,.Y,"Control Point Name","^1:25^K:X'?1AN.ANP X",PRCNM)
52 I X?1"^".E S:PRCAED'=1 PRCQT=99 D:PRCAED=1 DELQ^PRCB1A1 Q:PRCQT G EDIT
53 I X]"",X'=PRCNM S PRCNM=X,X=".01///"_PRCNO_" "_PRCNM D EDIT^PRC0B(.X,PRCDI,X)
54 S C=""
55 G ED0^PRCB1A1
56 ;
57KEY ;initial key values/func code/bbfy
58 S:$D(DA(1)) PRCRI(420)=DA(1) S:$D(DA) PRCRI(420.01)=DA
59KEY1 F I=1,26,27,28,29 S @("PRCK"_I_"=""""")
60 S PRCK25D5=""
61 QUIT:'PRCRI(420)!'PRCRI(420.01)
62 S A=$G(^PRC(420,PRCRI(420),1,PRCRI(420.01),0)),PRCK1=$P(A,"^",2)
63 S A=$G(^PRC(420,PRCRI(420),1,PRCRI(420.01),5))
64 S PRCK25D5=$P(A,"^",5),PRCK26=$P(A,"^",2),PRCK27=$P(A,"^",3)
65 S PRCK28=$P(A,"^",4),PRCK29=$P(A,"^",6)
66 F I=26,27,28,29 I @("PRCK"_I_"=""""") S @("PRCK"_I_"="" """)
67 S:PRCK25D5="" PRCK25D5=" "
68 QUIT
69 ;
70UNQCHK(PRCK1,PRCK25D5,PRCK26,PRCK27,PRCK28,PRCK29) ;check uniqeness
71 S PRCUNQ=""
72 S PRCK=","_$G(PRCK1)_","""_$G(PRCK25D5)_""","""_$G(PRCK26)_""","""_$G(PRCK27)_""","""_$G(PRCK28)_""","""_$G(PRCK29)_""","
73 I PRCK'[",," S @("PRCUQ=$O(^PRC(420,PRCRI(420),1,""UNQ"""_PRCK_"0))") I PRCUQ,PRCUQ-PRCRI(420.01) D UNQMES^PRCB1A1
74 QUIT
75 ;
76UNQCRS ;set unique cross reference
77 S PRCK=","_$G(PRCK1)_","""_$G(PRCK25D5)_""","""_$G(PRCK26)_""","""_$G(PRCK27)_""","""_$G(PRCK28)_""","""_$G(PRCK29)_""","
78 I PRCK'[",," S @("^PRC(420,PRCRI(420),1,""UNQ"""_PRCK_"DA)=""""")
79 QUIT
80 ;
81UNQCRK ;kill unique cross reference
82 S PRCK=","_$G(PRCK1)_","""_$G(PRCK25D5)_""","""_$G(PRCK26)_""","""_$G(PRCK27)_""","""_$G(PRCK28)_""","""_$G(PRCK29)_""","
83 I PRCK'[",," K @("^PRC(420,PRCRI(420),1,""UNQ"""_PRCK_"DA)")
84 QUIT
85 ;
86DINU ;call from ^dd(420.01,.01)
87 S DINUM=+X
88 QUIT
89 ;
Note: See TracBrowser for help on using the repository browser.