Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCSUTCP

PRCSUTCP.m

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