| 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 | 
|---|