PRCSUTCP.m

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 ---PRCSUTCP   839     printed  Apr 09, 2024@21:04:17                                                                                                                                                                                                     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