source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSUTCP.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 819 bytes
RevLine 
[613]1PRCSUTCP ;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 ;
7CP(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
Note: See TracBrowser for help on using the repository browser.