| [613] | 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
 | 
|---|