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