1 | PRCSUTCP ;WISC/RFJ-control point selector ;05 Apr 94
|
---|
2 | ;;5.1;IFCAP;;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | Q
|
---|
5 | ;
|
---|
6 | ;
|
---|
7 | CP(STATION,PROMPT,LEVEL,SCREEN,DEFAULT) ; select active control point
|
---|
8 | ; dic("a")=prompt; screen=additional screen (start with ,)
|
---|
9 | ; default=default selection
|
---|
10 | ; level=level of access (0=none, 1=official, 2=clerk, 3=requestor)
|
---|
11 | ; returns ien for selected control point
|
---|
12 | N %,%Y,C,DIC,X,Y
|
---|
13 | S DIC="^PRC(420,"_STATION_",1,",DIC(0)="AEMNQZ"
|
---|
14 | S DIC("A")="Select CONTROL POINT: " I $G(PROMPT)'="" S DIC("A")=PROMPT
|
---|
15 | S DIC("S")="I '$P(^PRC(420,"_STATION_",1,+Y,0),U,19)"
|
---|
16 | I $G(LEVEL)>0 S DIC("S")=DIC("S")_",$P($G(^PRC(420,"_STATION_",1,+Y,1,DUZ,0)),U,2)>"_(LEVEL-.1)
|
---|
17 | I $G(SCREEN)'="" S DIC("S")=DIC("S")_SCREEN
|
---|
18 | I $G(DEFAULT)'="" S DIC("B")=DEFAULT
|
---|
19 | D ^DIC
|
---|
20 | Q +Y
|
---|