PRCSUTCP ;WISC/RFJ-control point selector ;05 Apr 94
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
CP(STATION,PROMPT,LEVEL,SCREEN,DEFAULT) ; select active control point
; dic("a")=prompt; screen=additional screen (start with ,)
; default=default selection
; level=level of access (0=none, 1=official, 2=clerk, 3=requestor)
; returns ien for selected control point
N %,%Y,C,DIC,X,Y
S DIC="^PRC(420,"_STATION_",1,",DIC(0)="AEMNQZ"
S DIC("A")="Select CONTROL POINT: " I $G(PROMPT)'="" S DIC("A")=PROMPT
S DIC("S")="I '$P(^PRC(420,"_STATION_",1,+Y,0),U,19)"
I $G(LEVEL)>0 S DIC("S")=DIC("S")_",$P($G(^PRC(420,"_STATION_",1,+Y,1,DUZ,0)),U,2)>"_(LEVEL-.1)
I $G(SCREEN)'="" S DIC("S")=DIC("S")_SCREEN
I $G(DEFAULT)'="" S DIC("B")=DEFAULT
D ^DIC
Q +Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSUTCP 839 printed Dec 13, 2024@02:19:14 Page 2
PRCSUTCP ;WISC/RFJ-control point selector ;05 Apr 94
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
CP(STATION,PROMPT,LEVEL,SCREEN,DEFAULT) ; select active control point
+1 ; dic("a")=prompt; screen=additional screen (start with ,)
+2 ; default=default selection
+3 ; level=level of access (0=none, 1=official, 2=clerk, 3=requestor)
+4 ; returns ien for selected control point
+5 NEW %,%Y,C,DIC,X,Y
+6 SET DIC="^PRC(420,"_STATION_",1,"
SET DIC(0)="AEMNQZ"
+7 SET DIC("A")="Select CONTROL POINT: "
IF $GET(PROMPT)'=""
SET DIC("A")=PROMPT
+8 SET DIC("S")="I '$P(^PRC(420,"_STATION_",1,+Y,0),U,19)"
+9 IF $GET(LEVEL)>0
SET DIC("S")=DIC("S")_",$P($G(^PRC(420,"_STATION_",1,+Y,1,DUZ,0)),U,2)>"_(LEVEL-.1)
+10 IF $GET(SCREEN)'=""
SET DIC("S")=DIC("S")_SCREEN
+11 IF $GET(DEFAULT)'=""
SET DIC("B")=DEFAULT
+12 DO ^DIC
+13 QUIT +Y
